Changing default behavior of upload handling to stop taking over the upload extension...
[catagits/HTTP-Body.git] / lib / HTTP / Body.pm
index 12216d6..bc83c13 100644 (file)
@@ -4,14 +4,13 @@ use strict;
 
 use Carp       qw[ ];
 
-our $VERSION = '1.04';
-
 our $TYPES = {
     'application/octet-stream'          => 'HTTP::Body::OctetStream',
     'application/x-www-form-urlencoded' => 'HTTP::Body::UrlEncoded',
     'multipart/form-data'               => 'HTTP::Body::MultiPart',
     'multipart/related'                 => 'HTTP::Body::XFormsMultipart',
-    'application/xml'                   => 'HTTP::Body::XForms'
+    'application/xml'                   => 'HTTP::Body::XForms',
+    'application/json'                  => 'HTTP::Body::OctetStream',
 };
 
 require HTTP::Body::OctetStream;
@@ -49,26 +48,60 @@ HTTP::Body - HTTP Body Parser
             $body->add($buffer);
         }
         
-        my $uploads = $body->upload; # hashref
-        my $params  = $body->param;  # hashref
-        my $body    = $body->body;   # IO::Handle
+        my $uploads     = $body->upload;     # hashref
+        my $params      = $body->param;      # hashref
+        my $param_order = $body->param_order # arrayref
+        my $body        = $body->body;       # IO::Handle
     }
 
 =head1 DESCRIPTION
 
-HTTP::Body parses chunks of HTTP POST data and supports 
-application/octet-stream, application/x-www-form-urlencoded, and
-multipart/form-data.
+HTTP::Body parses chunks of HTTP POST data and supports
+application/octet-stream, application/json, application/x-www-form-urlencoded,
+and multipart/form-data.
 
 Chunked bodies are supported by not passing a length value to new().
 
-It is currently used by L<Catalyst> to parse POST bodies.
+It is currently used by L<Catalyst>, L<Dancer>, L<Maypole>, L<Web::Simple> and
+L<Jedi>.
 
 =head1 NOTES
 
 When parsing multipart bodies, temporary files are created to store any
 uploaded files.  You must delete these temporary files yourself after
-processing them.
+processing them, or set $body->cleanup(1) to automatically delete them at
+DESTROY-time.
+
+With version 1.23, we have changed the basic behavior of how temporary files
+are prepared for uploads.  The extension of the file is no longer transferred
+to the temporary file, the extension will always be C<.upload>.  We have also
+introduced variables that make it possible to set the behavior as required.
+
+=over 4
+
+=item $HTTP::Body::MultiPart::file_temp_suffix
+
+This is the extension that is given to all multipart files. The default
+setting here is C<.upload>.  If you want the old behavior from before version
+1.23, simply undefine the value here.
+
+=item $HTTP::Body::MultiPart::basename_regexp
+
+This is the regexp used to determine out the file extension.  This is of
+course no longer necessary, unless you undefine
+C<HTTP::Body::MultiPart::file_temp_suffix>.
+
+=item $HTTP::Body::MultiPart::file_temp_template
+
+This gets passed through to the L<File::Temp> TEMPLATE parameter.  There is no
+special default in our module.
+
+=item %HTTP::Body::MultiPart::file_temp_parameters
+
+In this hash you can add up custom settings for the L<File::Temp> invokation.
+Those override every other setting.
+
+=back
 
 =head1 METHODS
 
@@ -89,21 +122,19 @@ sub new {
     }
 
     my $type;
+    my $earliest_index;
     foreach my $supported ( keys %{$TYPES} ) {
-        if ( index( lc($content_type), $supported ) >= 0 ) {
-            $type = $supported;
+        my $index = index( lc($content_type), $supported );
+        if ($index >= 0 && (!defined $earliest_index || $index < $earliest_index)) {
+            $type           = $supported;
+            $earliest_index = $index;
         }
     }
 
     my $body = $TYPES->{ $type || 'application/octet-stream' };
 
-    eval "require $body";
-
-    if ($@) {
-        die $@;
-    }
-
     my $self = {
+        cleanup        => 0,
         buffer         => '',
         chunk_buffer   => '',
         body           => undef,
@@ -112,8 +143,10 @@ sub new {
         content_type   => $content_type,
         length         => 0,
         param          => {},
+        param_order    => [],
         state          => 'buffering',
         upload         => {},
+        part_data      => {},
         tmpdir         => File::Spec->tmpdir(),
     };
 
@@ -122,6 +155,20 @@ sub new {
     return $self->init;
 }
 
+sub DESTROY {
+    my $self = shift;
+    
+    if ( $self->{cleanup} ) {
+        my @temps = ();
+        for my $upload ( values %{ $self->{upload} } ) {
+            push @temps, map { $_->{tempname} || () }
+                ( ref $upload eq 'ARRAY' ? @{$upload} : $upload );
+        }
+        
+        unlink map { $_ } grep { -e $_ } @temps;
+    }
+}
+
 =item add
 
 Add string to internal buffer. Will call spin unless done. returns
@@ -226,6 +273,18 @@ sub chunked {
     return shift->{chunked};
 }
 
+=item cleanup
+
+Set to 1 to enable automatic deletion of temporary files at DESTROY-time.
+
+=cut
+
+sub cleanup {
+    my $self = shift;
+    $self->{cleanup} = shift if @_;
+    return $self->{cleanup};
+}
+
 =item content_length
 
 Returns the content-length for the body data if known.
@@ -324,6 +383,8 @@ sub param {
         else {
             $self->{param}->{$name} = $value;
         }
+
+        push @{$self->{param_order}}, $name;
     }
 
     return $self->{param};
@@ -356,6 +417,45 @@ sub upload {
     return $self->{upload};
 }
 
+=item part_data
+
+Just like 'param' but gives you a hash of the full data associated with the
+part in a multipart type POST/PUT.  Example:
+
+    {
+      data => "test",
+      done => 1,
+      headers => {
+        "Content-Disposition" => "form-data; name=\"arg2\"",
+        "Content-Type" => "text/plain"
+      },
+      name => "arg2",
+      size => 4
+    }
+
+=cut
+
+sub part_data {
+    my $self = shift;
+
+    if ( @_ == 2 ) {
+
+        my ( $name, $data ) = @_;
+
+        if ( exists $self->{part_data}->{$name} ) {
+            for ( $self->{part_data}->{$name} ) {
+                $_ = [$_] unless ref($_) eq "ARRAY";
+                push( @$_, $data );
+            }
+        }
+        else {
+            $self->{part_data}->{$name} = $data;
+        }
+    }
+
+    return $self->{part_data};
+}
+
 =item tmpdir 
 
 Specify a different path for temporary files.  Defaults to the system temporary path.
@@ -368,16 +468,60 @@ sub tmpdir {
     return $self->{tmpdir};
 }
 
+=item param_order
+
+Returns the array ref of the param keys in the order how they appeared on the body
+
+=cut
+
+sub param_order {
+    return shift->{param_order};
+}
+
 =back
 
+=head1 SUPPORT
+
+Since its original creation this module has been taken over by the Catalyst
+development team. If you need general support using this module:
+
+IRC:
+
+    Join #catalyst on irc.perl.org.
+
+Mailing Lists:
+
+    http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
+
+If you want to contribute patches, these will be your
+primary contact points:
+
+IRC:
+
+    Join #catalyst-dev on irc.perl.org.
+
+Mailing Lists:
+
+    http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
+
 =head1 AUTHOR
 
-Christian Hansen, C<ch@ngmedia.com>
+Christian Hansen, C<chansen@cpan.org>
 
 Sebastian Riedel, C<sri@cpan.org>
 
 Andy Grundman, C<andy@hybridized.org>
 
+=head1 CONTRIBUTORS
+
+Simon Elliott C<cpan@papercreatures.com>
+
+Kent Fredric C<kentnl@cpan.org>
+
+Christian Walde C<walde.christian@gmail.com>
+
+Torsten Raudssus C<torsten@raudssus.de>
+
 =head1 LICENSE
 
 This library is free software. You can redistribute it and/or modify