HTTP::Body 1.04, patch from jgoulah for tmpdir() accessor

[catagits/HTTP-Body.git] / lib / HTTP / Body / MultiPart.pm

diff --git a/lib/HTTP/Body/MultiPart.pm b/lib/HTTP/Body/MultiPart.pm
index 63b8d86..78212cf 100644 (file)
--- a/lib/HTTP/Body/MultiPart.pm
+++ b/lib/HTTP/Body/MultiPart.pm
@@ -1,17 +1,38 @@
-package HTTP::Body::Multipart;
+package HTTP::Body::MultiPart;
 
 use strict;
 use base 'HTTP::Body';
 use bytes;
 
+use IO::File;
 use File::Temp 0.14;
 
+=head1 NAME
+
+HTTP::Body::MultiPart - HTTP Body Multipart Parser
+
+=head1 SYNOPSIS
+
+    use HTTP::Body::Multipart;
+
+=head1 DESCRIPTION
+
+HTTP Body Multipart Parser.
+
+=head1 METHODS
+
+=over 4
+
+=item init
+
+=cut
+
 sub init {
     my $self = shift;
 
     unless ( $self->content_type =~ /boundary=\"?([^\";,]+)\"?/ ) {
         my $content_type = $self->content_type;
-        Carp::croak("Invalid boudrary in content_type: '$content_type'");
+        Carp::croak("Invalid boundary in content_type: '$content_type'");
     }
 
     $self->{boundary} = $1;
@@ -20,6 +41,10 @@ sub init {
     return $self;
 }
 
+=item spin
+
+=cut
+
 sub spin {
     my $self = shift;
 
@@ -36,32 +61,60 @@ sub spin {
     }
 }
 
+=item boundary
+
+=cut
+
 sub boundary {
     return shift->{boundary};
 }
 
+=item boundary_begin
+
+=cut
+
 sub boundary_begin {
     return "--" . shift->boundary;
 }
 
+=item boundary_end
+
+=cut
+
 sub boundary_end {
     return shift->boundary_begin . "--";
 }
 
-sub crlf {
+=item crlf
+
+=cut
+
+sub crlf () {
     return "\x0d\x0a";
 }
 
+=item delimiter_begin
+
+=cut
+
 sub delimiter_begin {
     my $self = shift;
     return $self->crlf . $self->boundary_begin;
 }
 
+=item delimiter_end
+
+=cut
+
 sub delimiter_end {
     my $self = shift;
     return $self->crlf . $self->boundary_end;
 }
 
+=item parse_preamble
+
+=cut
+
 sub parse_preamble {
     my $self = shift;
 
@@ -79,6 +132,10 @@ sub parse_preamble {
     return 1;
 }
 
+=item parse_boundary
+
+=cut
+
 sub parse_boundary {
     my $self = shift;
 
@@ -92,17 +149,21 @@ sub parse_boundary {
     }
 
     if ( index( $self->{buffer}, $self->delimiter_end . $self->crlf ) == 0 ) {
-        
+
         substr( $self->{buffer}, 0, length( $self->delimiter_end ) + 2, '' );
         $self->{part}  = {};
         $self->{state} = 'done';
-        
+
         return 0;
     }
 
     return 0;
 }
 
+=item parse_header
+
+=cut
+
 sub parse_header {
     my $self = shift;
 
@@ -151,6 +212,10 @@ sub parse_header {
     return 1;
 }
 
+=item parse_body
+
+=cut
+
 sub parse_body {
     my $self = shift;
 
@@ -167,7 +232,7 @@ sub parse_body {
 
         $self->{part}->{data} .= substr( $self->{buffer}, 0, $length, '' );
         $self->{part}->{size} += $length;
-        $self->{part}->{done}  = 0;
+        $self->{part}->{done} = 0;
 
         $self->handler( $self->{part} );
 
@@ -176,7 +241,7 @@ sub parse_body {
 
     $self->{part}->{data} .= substr( $self->{buffer}, 0, $index, '' );
     $self->{part}->{size} += $index;
-    $self->{part}->{done}  = 1;
+    $self->{part}->{done} = 1;
 
     $self->handler( $self->{part} );
 
@@ -185,51 +250,66 @@ sub parse_body {
     return 1;
 }
 
+=item handler
+
+=cut
+
 sub handler {
     my ( $self, $part ) = @_;
 
-    # skip parts without content
-    if ( $part->{done} && $part->{size} == 0 ) {
-        return 0;
-    }
-
-    unless ( $self->{seen}->{"$part"}++ ) {
+    unless ( exists $part->{name} ) {
 
         my $disposition = $part->{headers}->{'Content-Disposition'};
-        my ($name)      = $disposition =~ / name="?([^\";]+)"?"/;
-        my ($filename)  = $disposition =~ / filename="?([^\"]+)"?/;
+        my ($name)      = $disposition =~ / name="?([^\";]+)"?/;
+        my ($filename)  = $disposition =~ / filename="?([^\"]*)"?/;
+        # Need to match empty filenames above, so this part is flagged as an upload type
 
-        $part->{name}     = $name;
-        $part->{filename} = $filename;
+        $part->{name} = $name;
 
-        if ($filename) {
+        if ( defined $filename ) {
+            $part->{filename} = $filename;
 
-            my $fh = File::Temp->new( UNLINK => 0 );
+            if ( $filename ne "" ) {
+                my $fh = File::Temp->new( UNLINK => 0, DIR => $self->tmpdir );
 
-            $part->{fh}       = $fh;
-            $part->{tempname} = $fh->filename;
+                $part->{fh}       = $fh;
+                $part->{tempname} = $fh->filename;
+            }
         }
     }
 
-    if ( $part->{filename} ) {
-        $part->{fh}->write( delete $part->{data} );
+    if ( $part->{fh} && ( my $length = length( $part->{data} ) ) ) {
+        $part->{fh}->write( substr( $part->{data}, 0, $length, '' ), $length );
     }
 
     if ( $part->{done} ) {
 
-        if ( $part->{filename} ) {
-            
-            $part->{fh}->close;
-            
-            delete @{ $part }{ qw[ done fh ] };
-            
-            $self->upload( $part->{name}, $part );
-        }
+        if ( exists $part->{filename} ) {
+            if ( $part->{filename} ne "" ) {
+                $part->{fh}->close if defined $part->{fh};
 
+                delete @{$part}{qw[ data done fh ]};
+
+                $self->upload( $part->{name}, $part );
+            }
+        }
         else {
             $self->param( $part->{name}, $part->{data} );
         }
     }
 }
 
+=back
+
+=head1 AUTHOR
+
+Christian Hansen, C<ch@ngmedia.com>
+
+=head1 LICENSE
+
+This library is free software . You can redistribute it and/or modify 
+it under the same terms as perl itself.
+
+=cut
+
 1;