package Catalyst::Request::PartData; use Moose; use HTTP::Headers; use Encode; has [qw/raw_data name size/] => (is=>'ro', required=>1); has headers => ( is=>'ro', required=>1, handles=>[qw/content_type content_encoding content_type_charset/]); sub build_from_part_data { my ($class, $c, $part_data) = @_; # If the headers are complex, we need to work harder to figure out what to do if(my $hdrs = $class->part_data_has_complex_headers($part_data)) { # Ok so its one of two possibilities. If I can inspect the headers and # Figure out what to do, the I will return data. Otherwise I will return # a PartData object and expect you do deal with it. # For now if I can find a charset in the content type I will just decode and # assume I got it right (patches and bug reports welcomed). # Any of these headers means I can't decode if( $hdrs->content_encoding ) { return $class->new( raw_data => $part_data->{data}, name => $part_data->{name}, size => $part_data->{size}, headers => HTTP::Headers->new(%{ $part_data->{headers} })); } my ($ct, $charset) = $hdrs->content_type_charset; if($ct) { # Good news, we probably have data we can return. If there is a charset # then use that to decode otherwise use the default decoding. if($charset) { return Encode::decode($charset, $part_data->{data}) } else { if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) { return $c->_handle_param_unicode_decoding($part_data->{data}); } else { return $part_data->{data} } } } else { # I have no idea what to do with this now.. return $class->new( raw_data => $part_data->{data}, name => $part_data->{name}, size => $part_data->{size}, headers => HTTP::Headers->new(%{ $part_data->{headers} })); } } else { if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) { return $c->_handle_param_unicode_decoding($part_data->{data}); } else { return $part_data->{data} } } return $part_data->{data} unless $class->part_data_has_complex_headers($part_data); return $class->new( raw_data => $part_data->{data}, name => $part_data->{name}, size => $part_data->{size}, headers => HTTP::Headers->new(%{ $part_data->{headers} })); } sub part_data_has_complex_headers { my ($class, $part_data) = @_; my %h = %{$part_data->{headers}}; my $hdrs = HTTP::Headers->new(%h); # Remove non threatening headers. $hdrs->remove_header('Content-Length', 'Expires', 'Last-Modified', 'Content-Language'); # If we still have more than one (Content-Disposition) header we need to understand # that and deal with it. return $hdrs->header_field_names > 1 ? $hdrs :0; } __PACKAGE__->meta->make_immutable; =head1 NAME Catalyst::Request::Upload - handles file upload requests =head1 SYNOPSIS my $data_part = To specify where Catalyst should put the temporary files, set the 'uploadtmp' option in the Catalyst config. If unset, Catalyst will use the system temp dir. __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' ); See also L. =head1 DESCRIPTION =head1 ATTRIBUTES This class defines the following immutable attributes =head2 raw_data The raw data as returned via L. =head2 name The part name that gets extracted from the content-disposition header. =head2 size The raw byte count (over http) of the data. This is not the same as the character length =head2 headers An L object that represents the submitted headers of the POST. This object will handle the following methods: =head3 content_type =head3 content_encoding =head3 content_type_charset These three methods are the same as methods described in L. =head1 METHODS =head2 build_from_part_data Factory method to build an object from part data returned by L =head2 part_data_has_complex_headers Returns true if there more than one header (indicates the part data is complex and contains content type and encoding information.). =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut