First stab at refactoring HTTP::Body

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

diff --git a/lib/HTTP/Body/MultiPart.pm b/lib/HTTP/Body/Parser/MultiPart.pm
similarity index 69%
rename from lib/HTTP/Body/MultiPart.pm
rename to lib/HTTP/Body/Parser/MultiPart.pm
index 45569c3..cce6585 100644 (file)
--- a/lib/HTTP/Body/MultiPart.pm
+++ b/lib/HTTP/Body/Parser/MultiPart.pm
@@ -1,52 +1,34 @@
-package HTTP::Body::MultiPart;
+package HTTP::Body::Parser::MultiPart;
 
 use strict;
-use base 'HTTP::Body';
 use bytes;
+use base 'HTTP::Body::Parser';
 
-use IO::File;
-use File::Temp 0.14;
+use Carp       qw[];
+use Errno      qw[];
+use File::Temp qw[];
 
-=head1 NAME
+__PACKAGE__->mk_accessors( qw[ boundary status state ] );
 
-HTTP::Body::MultiPart - HTTP Body Multipart Parser
+sub initialize {
+    my ( $self, $params ) = @_;
 
-=head1 SYNOPSIS
+    my $content_type = $params->{context}->header('Content-Type');
 
-    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 boundary in content_type: '$content_type'");
+    unless ( $content_type =~ /boundary=\"?([^\";,]+)\"?/ ) {
+        Carp::croak qq/Invalid boundary in content_type: '$content_type'/;
     }
 
-    $self->{boundary} = $1;
-    $self->{state}    = 'preamble';
+    $params->{boundary} = $1;
+    $params->{state}    = 'preamble';
 
-    return $self;
+    return $self->SUPER::initialize($params);
 }
 
-=item spin
-
-=cut
-
-sub spin {
+sub parse {
     my $self = shift;
+    
+    return if $self->state eq 'done';
 
     while (1) {
 
@@ -56,65 +38,31 @@ sub spin {
         }
 
         else {
-            Carp::croak('Unknown state');
+            Carp::croak qq/Unknown state: '$self->{state}'/;
         }
     }
 }
 
-=item boundary
-
-=cut
-
-sub boundary {
-    return shift->{boundary};
-}
-
-=item boundary_begin
-
-=cut
-
 sub boundary_begin {
-    return "--" . shift->boundary;
+    return "--" . $_[0]->boundary;
 }
 
-=item boundary_end
-
-=cut
-
 sub boundary_end {
-    return shift->boundary_begin . "--";
+    return $_[0]->boundary_begin . "--";
 }
 
-=item crlf
-
-=cut
-
 sub crlf {
     return "\x0d\x0a";
 }
 
-=item delimiter_begin
-
-=cut
-
 sub delimiter_begin {
-    my $self = shift;
-    return $self->crlf . $self->boundary_begin;
+    return $_[0]->crlf . $_[0]->boundary_begin;
 }
 
-=item delimiter_end
-
-=cut
-
 sub delimiter_end {
-    my $self = shift;
-    return $self->crlf . $self->boundary_end;
+    return $_[0]->crlf . $_[0]->boundary_end;
 }
 
-=item parse_preamble
-
-=cut
-
 sub parse_preamble {
     my $self = shift;
 
@@ -132,10 +80,6 @@ sub parse_preamble {
     return 1;
 }
 
-=item parse_boundary
-
-=cut
-
 sub parse_boundary {
     my $self = shift;
 
@@ -160,10 +104,6 @@ sub parse_boundary {
     return 0;
 }
 
-=item parse_header
-
-=cut
-
 sub parse_header {
     my $self = shift;
 
@@ -212,10 +152,6 @@ sub parse_header {
     return 1;
 }
 
-=item parse_body
-
-=cut
-
 sub parse_body {
     my $self = shift;
 
@@ -250,10 +186,6 @@ sub parse_body {
     return 1;
 }
 
-=item handler
-
-=cut
-
 sub handler {
     my ( $self, $part ) = @_;
 
@@ -280,8 +212,22 @@ sub handler {
         }
     }
 
-    if ( $part->{filename} && ( my $length = length( $part->{data} ) ) ) {
-        $part->{fh}->write( substr( $part->{data}, 0, $length, '' ), $length );
+    if ( $part->{filename} && length $part->{data} ) {
+        
+        if ( $part->{done} || length $part->{data} >= $self->bufsize ) {
+            
+            my ( $r, $w, $s ) = ( length $part->{data}, 0, 0 );
+
+            for ( $w = 0; $w < $r; $w += $s || 0 ) {
+
+                $s = $part->{fh}->syswrite( $part->{data}, $r - $w, $w );
+
+                Carp::croak qq/Failed to syswrite buffer to temporary file. Reason: $!./
+                  unless defined $s || $! == Errno::EINTR;
+            }
+
+            $part->{data} = '';
+        }
     }
 
     if ( $part->{done} ) {
@@ -290,28 +236,15 @@ sub handler {
 
             $part->{fh}->close;
 
-            delete @{$part}{qw[ data done fh ]};
+            delete @{ $part }{qw[ data done fh ]};
 
-            $self->upload( $part->{name}, $part );
+            $self->context->upload->add( $part->{name} => $part );
         }
 
         else {
-            $self->param( $part->{name}, $part->{data} );
+            $self->context->param->add( $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;