File Coverage

blib/lib/Catalyst/Request/PartData.pm
Criterion Covered Total %
statement 24 35 68.5
branch 8 16 50.0
condition 2 12 16.6
subroutine 5 5 100.0
pod 2 2 100.0
total 41 70 58.5


line stmt bran cond sub pod time code
1             package Catalyst::Request::PartData;
2              
3 168     168   2171 use Moose;
  168         529  
  168         2839  
4 168     168   1260010 use HTTP::Headers;
  168         538  
  168         4988  
5 168     168   94734 use Encode;
  168         2379588  
  168         91113  
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 22     22 1 101 my ($class, $c, $part_data) = @_;
16              
17             # If the headers are complex, we need to work harder to figure out what to do
18 22 100       86 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 4 50       60 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 0         0 headers => HTTP::Headers->new(%{ $part_data->{headers} }));
  0         0  
36             }
37              
38 4         104 my ($ct, $charset) = $hdrs->content_type_charset;
39              
40 4 50       360 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 4 50       10 if($charset) {
44             return Encode::decode($charset, $part_data->{data})
45 4         28 } else {
46 0 0 0     0 if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
      0        
47 0         0 return $c->_handle_param_unicode_decoding($part_data->{data});
48             } else {
49             return $part_data->{data}
50 0         0 }
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 0         0 headers => HTTP::Headers->new(%{ $part_data->{headers} }));
  0         0  
59             }
60             } else {
61 18 50 33     355 if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
      33        
62 18         88 return $c->_handle_param_unicode_decoding($part_data->{data});
63             } else {
64             return $part_data->{data}
65 0         0 }
66             }
67              
68 0 0       0 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 0         0 headers => HTTP::Headers->new(%{ $part_data->{headers} }));
  0         0  
74             }
75              
76             sub part_data_has_complex_headers {
77 22     22 1 56 my ($class, $part_data) = @_;
78 22         45 my %h = %{$part_data->{headers}};
  22         126  
79 22         129 my $hdrs = HTTP::Headers->new(%h);
80              
81             # Remove non threatening headers.
82 22         1711 $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 22 100       683 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