Add version 1.11 of HTTP::Body with new param_order functionality

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

diff --git a/lib/HTTP/Body.pm b/lib/HTTP/Body.pm
index 5dd4f32..acecd21 100644 (file)
--- a/lib/HTTP/Body.pm
+++ b/lib/HTTP/Body.pm
@@ -4,8 +4,6 @@ use strict;
 
 use Carp       qw[ ];
 
-our $VERSION = '1.06';
-
 our $TYPES = {
     'application/octet-stream'          => 'HTTP::Body::OctetStream',
     'application/x-www-form-urlencoded' => 'HTTP::Body::UrlEncoded',
@@ -49,9 +47,10 @@ 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
@@ -68,7 +67,8 @@ It is currently used by L<Catalyst> to parse POST bodies.
 
 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.
 
 =head1 METHODS
 
@@ -98,6 +98,7 @@ sub new {
     my $body = $TYPES->{ $type || 'application/octet-stream' };
 
     my $self = {
+        cleanup        => 0,
         buffer         => '',
         chunk_buffer   => '',
         body           => undef,
@@ -106,6 +107,7 @@ sub new {
         content_type   => $content_type,
         length         => 0,
         param          => {},
+        param_order    => [],
         state          => 'buffering',
         upload         => {},
         tmpdir         => File::Spec->tmpdir(),
@@ -116,6 +118,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
@@ -220,6 +236,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.
@@ -318,6 +346,8 @@ sub param {
         else {
             $self->{param}->{$name} = $value;
         }
+
+        push @{$self->{param_order}}, $name;
     }
 
     return $self->{param};
@@ -362,16 +392,50 @@ 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 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 <kentnl@cpan.org>
+
+Christian Walde
+
+Torsten Raudssus <torsten@raudssus.de>
+
 =head1 LICENSE
 
 This library is free software. You can redistribute it and/or modify