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