lib/Catalyst/Request/PartData.pm

   1 package Catalyst::Request::PartData;
   2
   3 use Moose;
   4 use HTTP::Headers;
   5 use Encode;
   6
   7 has [qw/raw_data name size/] => (is=>'ro', required=>1);
   8
   9 has headers => (
  10   is=>'ro',
  11   required=>1,
  12   handles=>[qw/content_type content_encoding content_type_charset/]);
  13
  14 sub build_from_part_data {
  15   my ($class, $c, $part_data) = @_;
  16
  17   # If the headers are complex, we need to work harder to figure out what to do
  18   if(my $hdrs = $class->part_data_has_complex_headers($part_data)) {
  19
  20     # Ok so its one of two possibilities.  If I can inspect the headers and
  21     # Figure out what to do, the I will return data.  Otherwise I will return
  22     # a PartData object and expect you do deal with it.
  23     # For now if I can find a charset in the content type I will just decode and
  24     # assume I got it right (patches and bug reports welcomed).
  25
  26     # Any of these headers means I can't decode
  27
  28     if(
  29         $hdrs->content_encoding
  30     ) {
  31       return $class->new(
  32         raw_data => $part_data->{data},
  33         name => $part_data->{name},
  34         size => $part_data->{size},
  35         headers => HTTP::Headers->new(%{ $part_data->{headers} }));
  36     }
  37
  38     my ($ct, $charset) = $hdrs->content_type_charset;
  39
  40     if($ct) {
  41       # Good news, we probably have data we can return.  If there is a charset
  42       # then use that to decode otherwise use the default decoding.
  43       if($charset) {
  44         return  Encode::decode($charset, $part_data->{data})
  45       } else {
  46         if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
  47           return $c->_handle_param_unicode_decoding($part_data->{data});
  48         } else {
  49           return $part_data->{data}
  50         }
  51       }
  52     } else {
  53       # I have no idea what to do with this now..
  54       return $class->new(
  55         raw_data => $part_data->{data},
  56         name => $part_data->{name},
  57         size => $part_data->{size},
  58         headers => HTTP::Headers->new(%{ $part_data->{headers} }));
  59     }
  60   } else {
  61     if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
  62       return $c->_handle_param_unicode_decoding($part_data->{data});
  63     } else {
  64       return $part_data->{data}
  65     }
  66   }
  67
  68   return $part_data->{data} unless $class->part_data_has_complex_headers($part_data);
  69   return $class->new(
  70     raw_data => $part_data->{data},
  71     name => $part_data->{name},
  72     size => $part_data->{size},
  73     headers => HTTP::Headers->new(%{ $part_data->{headers} }));
  74 }
  75
  76 sub part_data_has_complex_headers {
  77   my ($class, $part_data) = @_;
  78   my %h = %{$part_data->{headers}};
  79   my $hdrs = HTTP::Headers->new(%h);
  80
  81   # Remove non threatening headers.
  82   $hdrs->remove_header('Content-Length', 'Expires', 'Last-Modified', 'Content-Language');
  83
  84   # If we still have more than one (Content-Disposition) header we need to understand
  85   # that and deal with it.
  86
  87   return $hdrs->header_field_names > 1 ? $hdrs :0;
  88 }
  89
  90 __PACKAGE__->meta->make_immutable;
  91
  92 =head1 NAME
  93
  94 Catalyst::Request::Upload - handles file upload requests
  95
  96 =head1 SYNOPSIS
  97
  98     my $data_part =
  99
 100 To specify where Catalyst should put the temporary files, set the 'uploadtmp'
 101 option in the Catalyst config. If unset, Catalyst will use the system temp dir.
 102
 103     __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
 104
 105 See also L<Catalyst>.
 106
 107 =head1 DESCRIPTION
 108
 109 =head1 ATTRIBUTES
 110
 111 This class defines the following immutable attributes
 112
 113 =head2 raw_data
 114
 115 The raw data as returned via L<HTTP::Body>.
 116
 117 =head2 name
 118
 119 The part name that gets extracted from the content-disposition header.
 120
 121 =head2 size
 122
 123 The raw byte count (over http) of the data.  This is not the same as the character
 124 length
 125
 126 =head2 headers
 127
 128 An L<HTTP::Headers> object that represents the submitted headers of the POST.  This
 129 object will handle the following methods:
 130
 131 =head3 content_type
 132
 133 =head3 content_encoding
 134
 135 =head3 content_type_charset
 136
 137 These three methods are the same as methods described in L<HTTP::Headers>.
 138
 139 =head1 METHODS
 140
 141 =head2 build_from_part_data
 142
 143 Factory method to build an object from part data returned by L<HTTP::Body>
 144
 145 =head2 part_data_has_complex_headers
 146
 147 Returns true if there more than one header (indicates the part data is complex and
 148 contains content type and encoding information.).
 149
 150 =head1 AUTHORS
 151
 152 Catalyst Contributors, see Catalyst.pm
 153
 154 =head1 COPYRIGHT
 155
 156 This library is free software. You can redistribute it and/or modify
 157 it under the same terms as Perl itself.
 158
 159 =cut