lib/HTTP/Body/Multipart.pm

   1 package HTTP::Body::Multipart;
   2
   3 use strict;
   4 use base 'HTTP::Body::Multipart::Parser';
   5
   6 use File::Temp 0.14;
   7
   8 sub new {
   9     my $class = shift;
  10
  11     my $self = $class->SUPER::new(@_);
  12     $self->{param}  = {};
  13     $self->{upload} = {};
  14
  15     return $self;
  16 }
  17
  18 sub handler {
  19     my ( $self, $part ) = @_;
  20
  21     if ( $part->{done} && $part->{size} == 0 ) {
  22         return 0;
  23     }
  24
  25     unless ( $self->{seen}->{"$part"}++ ) {
  26
  27         my $disposition = $part->{headers}->{'Content-Disposition'};
  28         my ($name)      = $disposition =~ / name="?([^\";]+)"?"/;
  29         my ($filename)  = $disposition =~ / filename="?([^\"]+)"?/;
  30
  31         $part->{name}     = $name;
  32         $part->{filename} = $filename;
  33
  34         if ($filename) {
  35
  36             my $fh = File::Temp->new( UNLINK => 0 );
  37
  38             $part->{fh}       = $fh;
  39             $part->{tempname} = $fh->filename;
  40         }
  41     }
  42
  43     if ( $part->{filename} ) {
  44         $part->{fh}->write( delete $part->{data} );
  45     }
  46
  47     if ( $part->{done} ) {
  48
  49         if ( $part->{filename} ) {
  50             $self->upload( $part->{name}, $part );
  51         }
  52
  53         else {
  54             $self->param( $part->{name}, $part->{data} );
  55         }
  56     }
  57 }
  58
  59 sub param {
  60     my $self = shift;
  61
  62     if ( @_ == 2 ) {
  63
  64         my ( $name, $value ) = @_;
  65
  66         if ( exists $self->{param}->{$name} ) {
  67             for ( $self->{param}->{$name} ) {
  68                 $_ = [$_] unless ref($_) eq "ARRAY";
  69                 push( @$_, $value );
  70             }
  71         }
  72         else {
  73             $self->{param}->{$name} = $value;
  74         }
  75     }
  76
  77     return $self->{param};
  78 }
  79
  80 sub upload {
  81     my $self = shift;
  82
  83     if ( @_ == 2 ) {
  84
  85         my ( $name, $upload ) = @_;
  86
  87         if ( exists $self->{upload}->{$name} ) {
  88             for ( $self->{upload}->{$name} ) {
  89                 $_ = [$_] unless ref($_) eq "ARRAY";
  90                 push( @$_, $upload );
  91             }
  92         }
  93         else {
  94             $self->{upload}->{$name} = $upload;
  95         }
  96     }
  97
  98     return $self->{upload};
  99 }
 100
 101 1;