r18880 - in /branches/upstream/libcgi-cookie-splitter-perl: ./ current/ current/lib/ current/lib/CGI/ current/lib/CGI/Cookie/ current/t/
yvesago-guest at users.alioth.debian.org
yvesago-guest at users.alioth.debian.org
Sun Apr 20 10:53:01 UTC 2008
Author: yvesago-guest
Date: Sun Apr 20 10:53:00 2008
New Revision: 18880
URL: http://svn.debian.org/wsvn/?sc=1&rev=18880
Log:
[svn-inject] Installing original source of libcgi-cookie-splitter-perl
Added:
branches/upstream/libcgi-cookie-splitter-perl/
branches/upstream/libcgi-cookie-splitter-perl/current/
branches/upstream/libcgi-cookie-splitter-perl/current/Changes
branches/upstream/libcgi-cookie-splitter-perl/current/MANIFEST
branches/upstream/libcgi-cookie-splitter-perl/current/META.yml
branches/upstream/libcgi-cookie-splitter-perl/current/Makefile.PL
branches/upstream/libcgi-cookie-splitter-perl/current/SIGNATURE
branches/upstream/libcgi-cookie-splitter-perl/current/lib/
branches/upstream/libcgi-cookie-splitter-perl/current/lib/CGI/
branches/upstream/libcgi-cookie-splitter-perl/current/lib/CGI/Cookie/
branches/upstream/libcgi-cookie-splitter-perl/current/lib/CGI/Cookie/Splitter.pm
branches/upstream/libcgi-cookie-splitter-perl/current/t/
branches/upstream/libcgi-cookie-splitter-perl/current/t/basic.t
Added: branches/upstream/libcgi-cookie-splitter-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-cookie-splitter-perl/current/Changes?rev=18880&op=file
==============================================================================
--- branches/upstream/libcgi-cookie-splitter-perl/current/Changes (added)
+++ branches/upstream/libcgi-cookie-splitter-perl/current/Changes Sun Apr 20 10:53:00 2008
@@ -1,0 +1,6 @@
+0.02
+ - Change the CGI::Simple prereq so it works better on debian
+ - Increase the serialization overhead futz number
+
+0.01
+ - Initial release
Added: branches/upstream/libcgi-cookie-splitter-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-cookie-splitter-perl/current/MANIFEST?rev=18880&op=file
==============================================================================
--- branches/upstream/libcgi-cookie-splitter-perl/current/MANIFEST (added)
+++ branches/upstream/libcgi-cookie-splitter-perl/current/MANIFEST Sun Apr 20 10:53:00 2008
@@ -1,0 +1,7 @@
+Changes
+lib/CGI/Cookie/Splitter.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+t/basic.t
+SIGNATURE Public-key signature (added by MakeMaker)
Added: branches/upstream/libcgi-cookie-splitter-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-cookie-splitter-perl/current/META.yml?rev=18880&op=file
==============================================================================
--- branches/upstream/libcgi-cookie-splitter-perl/current/META.yml (added)
+++ branches/upstream/libcgi-cookie-splitter-perl/current/META.yml Sun Apr 20 10:53:00 2008
@@ -1,0 +1,13 @@
+--- #YAML:1.0
+name: CGI-Cookie-Splitter
+version: 0.02
+abstract: ~
+license: ~
+generated_by: ExtUtils::MakeMaker version 6.31
+distribution_type: module
+requires:
+ CGI::Simple: 0
+ Test::use::ok: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libcgi-cookie-splitter-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-cookie-splitter-perl/current/Makefile.PL?rev=18880&op=file
==============================================================================
--- branches/upstream/libcgi-cookie-splitter-perl/current/Makefile.PL (added)
+++ branches/upstream/libcgi-cookie-splitter-perl/current/Makefile.PL Sun Apr 20 10:53:00 2008
@@ -1,0 +1,14 @@
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ NAME => 'CGI::Cookie::Splitter',
+ VERSION_FROM => 'lib/CGI/Cookie/Splitter.pm',
+ INSTALLDIRS => 'site',
+ PL_FILE => {},
+ SIGN => 1,
+ PREREQ_PM => {
+ 'CGI::Simple' => '0',
+ 'Test::use::ok' => '0',
+ },
+)
+;
Added: branches/upstream/libcgi-cookie-splitter-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-cookie-splitter-perl/current/SIGNATURE?rev=18880&op=file
==============================================================================
--- branches/upstream/libcgi-cookie-splitter-perl/current/SIGNATURE (added)
+++ branches/upstream/libcgi-cookie-splitter-perl/current/SIGNATURE Sun Apr 20 10:53:00 2008
@@ -1,0 +1,29 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.55.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It will check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 99a155c9e71068e0400c2a9bcd7e2558ab371971 Changes
+SHA1 51c1f8e15be8846610b29221f125abae9ac3f1db MANIFEST
+SHA1 dfeac16a99140b9932f6e1c643f4665ac38700c1 META.yml
+SHA1 45c656a21b65c90777a5b82e657ab592f351e2ac Makefile.PL
+SHA1 a252fbec4634a7fe8e5b3c412ddd5c242e672cb8 lib/CGI/Cookie/Splitter.pm
+SHA1 f1e217abe342e8544c172e30cd520c5138f18f6f t/basic.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.5 (Darwin)
+
+iD8DBQFFvj/TVCwRwOvSdBgRAsUsAJ4/4seg3j1V6027HH6j8tuWTeBTPgCfR+QY
+DT1VzPUubjjL4hIePZiaK0c=
+=OfSm
+-----END PGP SIGNATURE-----
Added: branches/upstream/libcgi-cookie-splitter-perl/current/lib/CGI/Cookie/Splitter.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-cookie-splitter-perl/current/lib/CGI/Cookie/Splitter.pm?rev=18880&op=file
==============================================================================
--- branches/upstream/libcgi-cookie-splitter-perl/current/lib/CGI/Cookie/Splitter.pm (added)
+++ branches/upstream/libcgi-cookie-splitter-perl/current/lib/CGI/Cookie/Splitter.pm Sun Apr 20 10:53:00 2008
@@ -1,0 +1,274 @@
+#!/usr/bin/perl
+
+package CGI::Cookie::Splitter;
+
+use strict;
+use warnings;
+
+use vars qw/$VERSION/;
+$VERSION = "0.02";
+
+use Scalar::Util qw/blessed/;
+use CGI::Simple::Util qw/escape unescape/;
+use Carp qw/croak/;
+
+sub new {
+ my ( $class, %params ) = @_;
+
+ $params{size} = 4096 unless exists $params{size};
+
+ croak "size has to be a positive integer ($params{size} is invalid)"
+ unless $params{size} =~ /^\d+$/ and $params{size} > 1;
+
+ bless \%params, $class;
+}
+
+sub size { $_[0]{size} }
+
+sub split {
+ my ( $self, @cookies ) = @_;
+ map { $self->split_cookie($_) } @cookies;
+}
+
+sub split_cookie {
+ my ( $self, $cookie ) = @_;
+ return $cookie unless $self->should_split( $cookie );
+ return $self->do_split_cookie(
+ $self->new_cookie( $cookie,
+ name => $self->mangle_name( $cookie->name, 0 ),
+ value => CORE::join("&",map { escape($_) } $cookie->value) # simplifies the string splitting
+ )
+ );
+}
+
+sub do_split_cookie {
+ my ( $self, $head ) = @_;
+
+ my $tail = $self->new_cookie( $head, value => '', name => $self->mangle_name_next( $head->name ) );
+
+ my $max_value_size = $self->size - ( $self->cookie_size( $head ) - length( escape($head->value) ) );
+ $max_value_size -= 30; # account for overhead the cookie serializer might add
+
+ die "Internal math error, please file a bug for CGI::Cookie::Splitter: max size should be > 0, but is $max_value_size (perhaps other attrs are too big?)"
+ unless ( $max_value_size > 0 );
+
+ my ( $head_v, $tail_v ) = $self->split_value( $max_value_size, $head->value );
+
+ $head->value( $head_v );
+ $tail->value( $tail_v );
+
+ die "Internal math error, please file a bug for CGI::Cookie::Splitter"
+ unless $self->cookie_size( $head ) <= $self->size; # 10 is not enough overhead
+
+ return $head unless $tail_v;
+ return ( $head, $self->do_split_cookie( $tail ) );
+}
+
+sub split_value {
+ my ( $self, $max_size, $value ) = @_;
+
+ my $adjusted_size = $max_size;
+
+ my ( $head, $tail );
+
+ return ( $value, '' ) if length($value) <= $adjusted_size;
+
+ split_value: {
+ croak "Can't reduce the size of the cookie anymore (adjusted = $adjusted_size, max = $max_size)" unless $adjusted_size > 0;
+
+ $head = substr( $value, 0, $adjusted_size );
+ $tail = substr( $value, $adjusted_size );
+
+ if ( length(my $escaped = escape($head)) > $max_size ) {
+ my $adjustment = int( ( length($escaped) - length($head) ) / 3 ) + 1;
+
+ die "Internal math error, please file a bug for CGI::Cookie::Splitter"
+ unless $adjustment;
+
+ $adjusted_size -= $adjustment;
+ redo split_value;
+ }
+ }
+
+ return ( $head, $tail );
+}
+
+sub cookie_size {
+ my ( $self, $cookie ) = @_;
+ length( $cookie->as_string );
+}
+
+sub new_cookie {
+ my ( $self, $cookie, %params ) = @_;
+
+ for (qw/name secure path domain expires value/) {
+ next if exists $params{$_};
+ $params{"-$_"} = $cookie->$_;
+ }
+
+ blessed($cookie)->new( %params );
+}
+
+sub should_split {
+ my ( $self, $cookie ) = @_;
+ $self->cookie_size( $cookie ) > $self->size;
+}
+
+sub join {
+ my ( $self, @cookies ) = @_;
+
+ my %split;
+ my @ret;
+
+ foreach my $cookie ( @cookies ) {
+ my ( $name, $index ) = $self->demangle_name( $cookie->name );
+ if ( $name ) {
+ $split{$name}[$index] = $cookie;
+ } else {
+ push @ret, $cookie;
+ }
+ }
+
+ foreach my $name ( keys %split ) {
+ my $split_cookie = $split{$name};
+ croak "The cookie $name is missing some chunks" if grep { !defined } @$split_cookie;
+ push @ret, $self->join_cookie( $name => @$split_cookie );
+ }
+
+ return @ret;
+}
+
+sub join_cookie {
+ my ( $self, $name, @cookies ) = @_;
+ $self->new_cookie( $cookies[0], name => $name, value => $self->join_value( map { $_->value } @cookies ) );
+}
+
+sub join_value {
+ my ( $self, @values ) = @_;
+ return [ map { unescape($_) } split('&', CORE::join("", @values)) ];
+}
+
+sub mangle_name_next {
+ my ( $self, $mangled ) = @_;
+ my ( $name, $index ) = $self->demangle_name( $mangled );
+ $self->mangle_name( $name, $index+1 ); # can't trust magic incr because it might overflow and fudge 'chunk'
+}
+
+sub mangle_name {
+ my ( $self, $name, $index ) = @_;
+ return sprintf '_bigcookie_%s_chunk%d', $name, $index;
+}
+
+sub demangle_name {
+ my ( $self, $mangled_name ) = @_;
+ my ( $name, $index ) = ( $mangled_name =~ /^_bigcookie_(.+?)_chunk(\d+)$/ );
+
+ return ( $name, $index );
+}
+
+__PACKAGE__;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+CGI::Cookie::Splitter - Split big cookies into smaller ones.
+
+=head1 SYNOPSIS
+
+ use CGI::Cookie::Splitter;
+
+ my $splitter = CGI::Cookie::Splitter->new(
+ size => 123, # defaults to 4096
+ );
+
+ @small_cookies = $splitter->split( @big_cookies );
+
+ @big_cookies = $splitter->join( @small_cookies );
+
+=head1 DESCRIPTION
+
+RFC 2109 reccomends that the minimal cookie size supported by the client is
+4096 bytes. This has become a pretty standard value, and if your server sends
+larger cookies than that it's considered a no-no.
+
+This module provides a pretty simple interface to generate small cookies that
+are under a certain limit, without wasting too much effort.
+
+=head1 METHODS
+
+=over 4
+
+=item new %params
+
+The only supported parameters right now are C<size>. It defaults to 4096.
+
+=item split @cookies
+
+This method accepts a list of CGI::Cookie objects (or look alikes) and returns
+a list of CGI::Cookies.
+
+Whenever an object with a total size that is bigger than the limit specified at
+construction time is encountered it is replaced in the result list with several
+objects of the same class, which are assigned serial names and have a smaller
+size and the same domain/path/expires/secure parameters.
+
+=item join @cookies
+
+This is the inverse of C<split>.
+
+=item should_split $cookie
+
+Whether or not the cookie should be split
+
+=item mangle_name_next $name
+
+Demangles name, increments the index and remangles.
+
+=item mangle_name $name, $index
+
+=item demangle_name $mangled_name
+
+These methods encapsulate a name mangling scheme for changing the cookie names
+to allo wa 1:n relationship.
+
+The default mangling behavior is not 100% safe because cookies with a safe size
+are not mangled.
+
+As long as your cookie names don't start with the substring C<_bigcookie_> you
+should be OK ;-)
+
+=back
+
+=head1 SUBCLASSING
+
+This module is designed to be easily subclassed... If you need to split cookies
+using a different criteria then you should look into that.
+
+=head1 SEE ALSO
+
+L<CGI::Cookie>, L<CGI::Simple::Cookie>, L<http://www.cookiecutter.com/>,
+L<http://perlcabal.org/~gaal/metapatch/images/copper-moose-cutter.jpg>,
+RFC 2109
+
+=head1 VERSION CONTROL
+
+This module is maintained using Darcs. You can get the latest version from
+L<http://nothingmuch.woobling.org/CGI-Cookie-Splitter/>, and use C<darcs send>
+to commit changes.
+
+=head1 AUTHOR
+
+Yuval Kogman, C<nothingmuch at woobling.org>
+
+=head1 COPYRIGHT & LICENCE
+
+ Copyright (c) 2006 the aforementioned authors. All rights
+ reserved. This program is free software; you can redistribute
+ it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+
Added: branches/upstream/libcgi-cookie-splitter-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-cookie-splitter-perl/current/t/basic.t?rev=18880&op=file
==============================================================================
--- branches/upstream/libcgi-cookie-splitter-perl/current/t/basic.t (added)
+++ branches/upstream/libcgi-cookie-splitter-perl/current/t/basic.t Sun Apr 20 10:53:00 2008
@@ -1,0 +1,126 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use ok "CGI::Cookie::Splitter";
+
+my @cookie_classes = grep { eval "require $_; 1" } qw/CGI::Simple::Cookie CGI::Cookie/;
+
+my @cases = ( # big numbers are used to mask the overhead of the other fields
+ {
+ size_limit => 4096,
+ num_cookies => 1,
+ cookie => {
+ -name => "a",
+ -value => [ qw/foo bar gorch baz/ ],
+ -damain => "www.example.com",
+ -path => "/foo",
+ -secure => 0,
+ },
+ },
+ {
+ size_limit => 1000,
+ num_cookies => 11,
+ cookie => {
+ -name => "b",
+ -value => ("a" x 10_000),
+ },
+ },
+ {
+ size_limit => 10_000,
+ num_cookies => 1,
+ cookie => {
+ -name => "c",
+ -value => "this is a simple value",
+ }
+ },
+ {
+ size_limit => 1000,
+ num_cookies => 11,
+ cookie => {
+ -name => "d",
+ -domain => ".foo.com",
+ -value => [ ("a" x 1000) x 10 ],
+ },
+ },
+ {
+ size_limit => 1000,
+ num_cookies => 15, # feck
+ cookie => {
+ -name => "e",
+ -path => "/bar/gorch",
+ -value => [ ("a" x 10) x 1000 ],
+ },
+ },
+ {
+ size_limit => 1000,
+ num_cookies => 3,
+ cookie => {
+ -name => "f",
+ secure => 1,
+ -value => { foo => ("a" x 1000), bar => ("b" x 1000) },
+ },
+ },
+);
+
+foreach my $class ( @cookie_classes ) {
+ foreach my $case ( @cases ) {
+ my ( $size_limit, $num_cookies ) = @{ $case }{qw/size_limit num_cookies/};
+
+ my $big = $class->new(%{ $case->{cookie} });
+
+ can_ok( "CGI::Cookie::Splitter", "new" );
+
+ my $splitter = CGI::Cookie::Splitter->new( size => $size_limit ); # 50 is padding for the other attrs
+
+ isa_ok( $splitter, "CGI::Cookie::Splitter" );
+
+ can_ok( $splitter, "split" );
+
+ my @small = $splitter->split( $big );
+
+ is( scalar(@small), $num_cookies, "returned several smaller cookies" );
+
+ my $i = 0;
+ foreach my $cookie ( @small ) {
+ cmp_ok( length($cookie->as_string), "<=", $size_limit, "cookie size is under specified limit" );
+
+ if ( $splitter->should_split($big) ) {
+ is_deeply( [ $splitter->demangle_name($cookie->name) ], [ $big->name => $i++ ], "name mangling looks good (" . $cookie->name . ")" );
+ }
+ }
+
+ my @big = $splitter->join( @small );
+
+ is( scalar(@big), 1, "one big cookie from small cookies" );
+
+ foreach my $field ( qw/name value domain path secure/ ) {
+ is_deeply( [ $big[0]->$field ], [ $big->$field ], "'$field' is the same" );
+ }
+ }
+
+ my @all_cookies = map { $class->new( %{ $_->{cookie} } ) } @cases;
+
+ my $splitter = CGI::Cookie::Splitter->new;
+
+ my @split = $splitter->split( @all_cookies );
+
+ foreach my $cookie ( @split ) {
+ cmp_ok( length($cookie->as_string), "<=", 4096, "cookie size is under specified limit" );
+ };
+
+ my @all_joined = $splitter->join( @split );
+
+ is( scalar(@all_joined), scalar(@all_cookies), "count is the same after join" );
+
+ @all_joined = sort { $a->name cmp $b->name } @all_joined;
+
+ while( @all_joined and my($joined, $orig) = ( shift @all_joined, shift @all_cookies ) ) {
+ foreach my $field ( qw/name value domain path secure/ ) {
+ is_deeply( eval { [ $joined->$field ] }, eval { [ $orig->$field ] }, "'$field' is the same" );
+ }
+ }
+}
More information about the Pkg-perl-cvs-commits
mailing list