From: Christian Hansen <chansen@cpan.org>
Date: Tue, 19 Jul 2005 17:43:38 +0000 (+0000)
Subject: created HTTP::Body::Urlencoded
X-Git-Tag: v0.01~14
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FHTTP-Body.git;a=commitdiff_plain;h=7e2df1d983ce37b8cce78b1b27035f375d7173e0

created HTTP::Body::Urlencoded
---

diff --git a/lib/HTTP/Body.pm b/lib/HTTP/Body.pm
index b8d2c92..e89cb20 100644
--- a/lib/HTTP/Body.pm
+++ b/lib/HTTP/Body.pm
@@ -5,7 +5,7 @@ use strict;
 use Carp       qw[ ];
 use List::Util qw[ first ];
 
-our $PARSERS = {
+our $TYPES = {
     'application/octet-stream'          => 'HTTP::Body::Octetstream',
     'application/x-www-form-urlencoded' => 'HTTP::Body::Urlencoded',
     'multipart/form-data'               => 'HTTP::Body::Multipart'
@@ -17,40 +17,43 @@ sub new {
     unless ( @_ == 3 ) {
         Carp::croak( $class, '->new( $content_type, $content_length )' );
     }
-    
-    my $type = first { index( lc($content_type), $_ ) >= 0 } keys %{ $PARSERS };
-    my $body = $PARSERS->{ $type || 'application/octet-stream' };
-    
+
+    my $type = first { index( lc($content_type), $_ ) >= 0 } keys %{$TYPES};
+    my $body = $TYPES->{ $type || 'application/octet-stream' };
+
     eval "require $body";
-    
-    if ( $@ ) {
+
+    if ($@) {
         die $@;
     }
-    
+
     my $self = {
         buffer         => '',
         content_length => $content_length,
         content_type   => $content_type,
         length         => 0,
-        param          => { },
-        upload         => { }
+        param          => {},
+        state          => 'buffering',
+        upload         => {}
     };
 
     bless( $self, $body );
-    
+
     return $self->init;
 }
 
 sub add {
     my $self = shift;
-    
+
     if ( defined $_[0] ) {
         $self->{buffer} .= $_[0];
-        $self->{length} += length($_[0]);
+        $self->{length} += length( $_[0] );
     }
     
-    $self->spin;
-    
+    unless ( $self->state eq 'done' ) {
+        $self->spin;
+    }
+
     return ( $self->length - $self->content_length );
 }
 
@@ -84,6 +87,12 @@ sub spin {
     Carp::croak('Define abstract method spin() in implementation');
 }
 
+sub state {
+    my $self = shift;
+    $self->{state} = shift if @_;
+    return $self->{state};    
+}
+
 sub param {
     my $self = shift;
 
diff --git a/lib/HTTP/Body/Multipart.pm b/lib/HTTP/Body/Multipart.pm
index c042903..63b8d86 100644
--- a/lib/HTTP/Body/Multipart.pm
+++ b/lib/HTTP/Body/Multipart.pm
@@ -25,11 +25,7 @@ sub spin {
 
     while (1) {
 
-        if ( $self->{state} eq 'done' ) {
-            return 0;
-        }
-
-        elsif ( $self->{state} =~ /^(preamble|boundary|header|body)$/ ) {
+        if ( $self->{state} =~ /^(preamble|boundary|header|body)$/ ) {
             my $method = "parse_$1";
             return unless $self->$method;
         }
@@ -192,6 +188,7 @@ sub parse_body {
 sub handler {
     my ( $self, $part ) = @_;
 
+    # skip parts without content
     if ( $part->{done} && $part->{size} == 0 ) {
         return 0;
     }
diff --git a/lib/HTTP/Body/Octetstream.pm b/lib/HTTP/Body/Octetstream.pm
index 8f14f85..f277c62 100644
--- a/lib/HTTP/Body/Octetstream.pm
+++ b/lib/HTTP/Body/Octetstream.pm
@@ -8,7 +8,7 @@ use File::Temp 0.14;
 
 sub spin {
     my $self = shift;
-    
+
     unless ( $self->body ) {
         $self->body( File::Temp->new );
     }
@@ -19,6 +19,7 @@ sub spin {
     
     if ( $self->length == $self->content_length ) {
         seek( $self->body, 0, 0 );
+        $self->state('done');
     }
 }
 
diff --git a/lib/HTTP/Body/Urlencoded.pm b/lib/HTTP/Body/Urlencoded.pm
index c01b9b2..db72930 100644
--- a/lib/HTTP/Body/Urlencoded.pm
+++ b/lib/HTTP/Body/Urlencoded.pm
@@ -4,10 +4,30 @@ use strict;
 use base 'HTTP::Body';
 use bytes;
 
+our $DECODE = qr/%(u?[0-9a-fA-F]{2,4})/;
+
 sub spin {
     my $self = shift;
     
+    return unless $self->length == $self->content_length;
+
+    for my $pair ( split( /[&;]/, $self->{buffer} ) ) {
+        
+        my ( $name, $value ) = split( /=/, $pair );
+        
+        next unless defined $name;
+        next unless defined $value;
+        
+        $name  =~ s/$DECODE/chr(hex($1))/eg;
+        $name  =~ tr/+/ /;
+        $value =~ s/$DECODE/chr(hex($1))/eg;
+        $value =~ tr/+/ /;
+        
+        $self->param( $name, $value );
+    }
     
+    $self->{state}  = 'done';
+    $self->{buffer} = ''
 }
 
 1;
diff --git a/test.pl b/test.pl
index 2142c6a..6f3027b 100644
--- a/test.pl
+++ b/test.pl
@@ -9,10 +9,12 @@ use HTTP::Body;
 use IO::File;
 use YAML qw[LoadFile];
 
-my $test = shift(@ARGV) || 1;
+my $number = $ARGV[0] || 1;
+my $test   = $ARGV[1] || 'multipart';
 
-my $headers = LoadFile( sprintf( "t/data/multipart/%.3d-headers.yml", $test ) );
-my $content = IO::File->new( sprintf( "t/data/multipart/%.3d-content.dat", $test ), O_RDONLY );
+
+my $headers = LoadFile( sprintf( "t/data/%s/%.3d-headers.yml", $test, $number ) );
+my $content = IO::File->new( sprintf( "t/data/%s/%.3d-content.dat", $test, $number ), O_RDONLY );
 my $body    = HTTP::Body->new( $headers->{'Content-Type'}, $headers->{'Content-Length'} );
 
 binmode $content;
@@ -25,7 +27,8 @@ warn Dumper( $body->param  );
 warn Dumper( $body->upload );
 warn Dumper( $body->body   );
 
+warn "state          : " . $body->state;
 warn "length         : " . $body->length;
 warn "content length : " . $body->content_length;
-warn "state          : " . $body->{state};
-warn "buffer         : " . $body->buffer;
+warn "body length    : " . ( $body->body->stat )[7] if $body->body;
+warn "buffer         : " . $body->buffer if $body->buffer;