Permalink
Browse files

Made mulitipart/form-data posts work and clean up STDIN vs file input…

… handling
  • Loading branch information...
1 parent 3e6bf09 commit c1bcbdae23d1b82d044aa6fb70da655d7a0982d3 @NachoMan committed May 28, 2009
Showing with 69 additions and 101 deletions.
  1. +1 −0 MANIFEST
  2. +19 −14 lib/CGI/Simple.pm
  3. +47 −0 t/041.multipart.t
  4. +1 −47 t/050.simple.t
  5. +1 −40 t/070.standard.t
View
@@ -13,6 +13,7 @@ t/000.load.t
t/020.cookie.t
t/030.function.t
t/040.request.t
+t/041.multipart.t
t/050.simple.t
t/060.slow_post.t
t/070.standard.t
View
@@ -282,7 +282,7 @@ sub _initialize {
# chromatic's blessed GLOB patch
# elsif ( (ref $init) =~ m/GLOB/i ) { # initialize from a file
elsif ( UNIVERSAL::isa( $init, 'GLOB' ) ) { # initialize from a file
- $self->_init_from_file( $init );
+ $self->_read_parse($init);
}
elsif ( ( ref $init ) eq 'CGI::Simple' ) {
@@ -304,20 +304,22 @@ sub _initialize {
}
}
-sub _internal_read($\$;$) {
- my ( $self, $buffer, $len ) = @_;
+sub _internal_read($*\$;$) {
+ my ( $self, $glob, $buffer, $len ) = @_;
$len = 4096 if !defined $len;
if ( $self->{'.mod_perl'} ) {
my $r = $self->_mod_perl_request();
$r->read( $$buffer, $len );
}
else {
- read( STDIN, $$buffer, $len );
+ read( $glob, $$buffer, $len );
}
}
sub _read_parse {
my $self = shift;
+ my $handle = shift || \*STDIN;
+
my $data = '';
my $type = $ENV{'CONTENT_TYPE'} || 'No CONTENT_TYPE received';
my $length = $ENV{'CONTENT_LENGTH'} || 0;
@@ -333,15 +335,15 @@ sub _read_parse {
# silently discard data ??? better to just close the socket ???
while ( $length > 0 ) {
- last unless _internal_read( $self, my $buffer );
+ last unless _internal_read( $self, $handle, my $buffer );
$length -= length( $buffer );
}
return;
}
if ( $length and $type =~ m|^multipart/form-data|i ) {
- my $got_length = $self->_parse_multipart;
+ my $got_length = $self->_parse_multipart($handle);
if ( $length != $got_length ) {
$self->cgi_error(
"500 Bad read on multipart/form-data! wanted $length, got $got_length"
@@ -356,9 +358,9 @@ sub _read_parse {
# we may not get all the data we want with a single read on large
# POSTs as it may not be here yet! Credit Jason Luther for patch
# CGI.pm < 2.99 suffers from same bug
- _internal_read( $self, $data, $length );
+ _internal_read( $self, $handle, $data, $length );
while ( length( $data ) < $length ) {
- last unless _internal_read( $self, my $buffer );
+ last unless _internal_read( $self, $handle, my $buffer );
$data .= $buffer;
}
@@ -467,6 +469,7 @@ sub _massage_boundary {
sub _parse_multipart {
my $self = shift;
+ my $handle = shift or die "NEED A HANDLE!?";
my ( $boundary )
= $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/;
@@ -481,7 +484,7 @@ sub _parse_multipart {
READ:
while ( $got_data < $length ) {
- last READ unless _internal_read( $self, my $buffer );
+ last READ unless _internal_read( $self, $handle, my $buffer );
$data .= $buffer;
$got_data += length $buffer;
@@ -518,8 +521,8 @@ sub _parse_multipart {
my ( $mime ) = $unfold =~ m/Content-Type:\s+([-\w\/]+)/io;
$data =~ s/^\Q$header\E//;
( $got_data, $data, my $fh, my $size )
- = $self->_save_tmpfile( $boundary, $filename, $got_data,
- $data );
+ = $self->_save_tmpfile( $handle, $boundary, $filename, $got_data,
+ $data);
$self->_add_param( $param, $filename );
$self->{'.upload_fields'}->{$param} = $filename;
$self->{'.filehandles'}->{$filename} = $fh if $fh;
@@ -548,7 +551,7 @@ sub _parse_multipart {
}
sub _save_tmpfile {
- my ( $self, $boundary, $filename, $got_data, $data ) = @_;
+ my ( $self, $handle, $boundary, $filename, $got_data, $data ) = @_;
my $fh;
my $CRLF = $self->crlf;
my $length = $ENV{'CONTENT_LENGTH'} || 0;
@@ -574,7 +577,7 @@ sub _save_tmpfile {
while ( $got_data < $length ) {
my $buffer = $data;
- last unless _internal_read( $self, $data );
+ last unless _internal_read( $self, \*STDIN, $data );
# fixed hanging bug if browser terminates upload part way through
# thanks to Brandon Black
unless ( $data ) {
@@ -863,6 +866,8 @@ sub parse_query_string {
################ Save and Restore params from file ###############
sub _init_from_file {
+ use Carp qw(confess);
+ confess "INIT_FROM_FILE called, stupid fucker!";
my ( $self, $fh ) = @_;
local $/ = "\n";
while ( my $pair = <$fh> ) {
@@ -1432,7 +1437,7 @@ sub url {
$url .= $script_name;
}
elsif ( $relative ) {
- ( $url ) = $script_name =~ m!([^/]+)$!;
+ ( $url ) = $script_name =~ m#([^/]+)$#;
}
elsif ( $absolute ) {
$url = $script_name;
View
@@ -0,0 +1,47 @@
+use Test::More tests => 5;
+use strict;
+use warnings;
+use Config;
+use Data::Dumper;
+use IO::Scalar;
+
+use CGI::Simple ( -default );
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD} = 'POST';
+$ENV{QUERY_STRING} = '';
+$ENV{PATH_INFO} = '/somewhere/else';
+$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME} = '/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+$ENV{CONTENT_TYPE} = q{multipart/form-data; boundary=---------------------------10263292819275730631136676268};
+$ENV{REQUEST_URI}
+ = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
+$ENV{HTTP_LOVE} = 'true';
+
+my $body = <<EOF;
+-----------------------------10263292819275730631136676268\r
+Content-Disposition: form-data; name="action"\r
+\r
+reply\r
+-----------------------------10263292819275730631136676268\r
+Content-Disposition: form-data; name="body"\r
+\r
+asdfasdf\r
+-----------------------------10263292819275730631136676268\r
+Content-Disposition: form-data; name="send_action"\r
+\r
+Reply\r
+-----------------------------10263292819275730631136676268--\r
+EOF
+$ENV{CONTENT_LENGTH} = length $body;
+
+my $h = IO::Scalar->new(\$body);
+my $q = new CGI::Simple($h);
+ok( $q, "CGI::Simple::new()" );
+is_deeply( [$q->param], [qw(action body send_action)], 'list of params' );
+is( $q->param('action'), 'reply', 'reply param' );
+is( $q->param('body'), 'asdfasdf', 'body param' );
+is( $q->param('send_action'), 'Reply', 'send_action param' );
View
@@ -1,4 +1,4 @@
-use Test::More tests => 332;
+use Test::More tests => 318;
use Carp;
use strict;
use vars qw(%field %in);
@@ -224,52 +224,6 @@ open FH, ">>$tmpfile", or carp "Can't append $tmpfile $!\n";
$q->save_parameters( \*FH );
close FH;
-# new() file constructor
-open FH, $tmpfile, or carp "Can't open temp file\n";
-is(
- join( '', <FH> ),
- "foo=1\nbar=2\nbar=3\nbar=4\n=\nfoo=5\nbar=6\nbar=7\nbar=8\n=\n",
- 'new() file constructor, 1'
-);
-close FH;
-open FH, $tmpfile, or carp "Can't open temp file\n";
-$q = new CGI::Simple( \*FH );
-close FH;
-@av = $q->param;
-is( join( ' ', @av ), 'foo bar', 'new() file constructor, 2' );
-is( $q->param( 'foo' ), 1, 'new() file constructor, 3' );
-is( $q->param( 'bar' ), 2, 'new() file constructor, 4' );
-@av = $q->param( 'bar' );
-is( join( '', @av ), 234, 'new() file constructor, 5' );
-
-# call new twice to read two sections of file
-open FH, $tmpfile, or carp "Can't open temp file\n";
-$q = new CGI::Simple( \*FH );
-@av = $q->param;
-is( join( ' ', @av ), 'foo bar', 'new() file constructor, 6' );
-is( $q->param( 'foo' ), 1, 'new() file constructor, 7' );
-is( $q->param( 'bar' ), 2, 'new() file constructor, 8' );
-@av = $q->param( 'bar' );
-is( join( '', @av ), 234, 'new() file constructor, 9' );
-
-# call new again
-$q = new CGI::Simple( \*FH );
-close FH;
-@av = $q->param;
-is( join( ' ', @av ), 'foo bar', 'new() file constructor, 10' );
-is( $q->param( 'foo' ), 5, 'new() file constructor, 11' );
-is( $q->param( 'bar' ), 6, 'new() file constructor, 12' );
-@av = $q->param( 'bar' );
-is( join( '', @av ), 678, 'new() file constructor, 13' );
-
-# call new with a blessed glob ( test chromatic's patch with chromatic's test!)
-open FH, $tmpfile, or carp "Can't open temp file\n";
-my $fh = bless \*FH, 'Some::Class';
-$q = new CGI::Simple( $fh );
-close FH;
-@av = $q->param;
-is( join( ' ', @av ), 'foo bar', 'new() file constructor, 14' );
-
# new() CGI::Simple object constructor
my $q_old = new CGI::Simple( 'foo=1&bar=2&bar=3&bar=4' );
View
@@ -1,4 +1,4 @@
-use Test::More tests => 301;
+use Test::More tests => 288;
use Carp;
use strict;
use vars qw(%field %in);
@@ -247,45 +247,6 @@ open FH, ">>$tmpfile", or carp "Can't append $tmpfile $!\n";
save_parameters( \*FH );
close FH;
-# new() file constructor
-
-open FH, $tmpfile, or carp "Can't open temp file\n";
-is(
- join( '', <FH> ),
- "foo=1\nbar=2\nbar=3\nbar=4\n=\nfoo=5\nbar=6\nbar=7\nbar=8\n=\n",
- 'new() file constructor, 1'
-);
-close FH;
-open FH, $tmpfile, or carp "Can't open temp file\n";
-restore_parameters( \*FH );
-close FH;
-@av = param();
-is( join( ' ', @av ), 'foo bar', 'new() file constructor, 2' );
-is( param( 'foo' ), 1, 'new() file constructor, 3' );
-is( param( 'bar' ), 2, 'new() file constructor, 4' );
-@av = param( 'bar' );
-is( join( '', @av ), 234, 'new() file constructor, 5' );
-
-# call new twice to read two sections of file
-open FH, $tmpfile, or carp "Can't open temp file\n";
-restore_parameters( \*FH );
-@av = param();
-is( join( ' ', @av ), 'foo bar', 'new() file constructor, 6' );
-is( param( 'foo' ), 1, 'new() file constructor, 7' );
-is( param( 'bar' ), 2, 'new() file constructor, 8' );
-@av = param( 'bar' );
-is( join( '', @av ), 234, 'new() file constructor, 9' );
-
-# call new again
-restore_parameters( \*FH );
-close FH;
-@av = param();
-is( join( ' ', @av ), 'foo bar', 'new() file constructor, 10' );
-is( param( 'foo' ), 5, 'new() file constructor, 11' );
-is( param( 'bar' ), 6, 'new() file constructor, 12' );
-@av = param( 'bar' );
-is( join( '', @av ), 678, 'new() file constructor, 13' );
-
# new() \@ARGV constructor
$ENV{'REQUEST_METHOD'} = '';

0 comments on commit c1bcbda

Please sign in to comment.