use Moose;
use HTTP::Headers;
+use Encode;
has [qw/raw_data name size/] => (is=>'ro', required=>1);
handles=>[qw/content_type content_encoding content_type_charset/]);
sub build_from_part_data {
- my ($class, $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},
sub part_data_has_complex_headers {
my ($class, $part_data) = @_;
- return scalar keys %{$part_data->{headers}} > 1 ? 1:0;
+ 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;