File Coverage

lib/CGI/Minimal/Multipart.pm
Criterion Covered Total %
statement 87 87 100.0
branch 39 40 97.5
condition n/a
subroutine 4 4 100.0
pod n/a
total 130 131 99.2


line stmt bran cond sub pod time code
1             package CGI::Minimal;
2              
3             # This program is licensed under the same terms as Perl.
4             # See http://dev.perl.org/licenses/
5             # Copyright 1999-2004 Benjamin Franz. All Rights Reserved.
6              
7             # I don't 'use warnings;' here because it pulls in ~ 20Kbytes of code
8             # and is incompatible with perl's older than 5.6
9              
10 7     7   44 use strict;
  7         13  
  7         12485  
11              
12             ####
13              
14             sub _internal_param_mime {
15 7750     7750   9838 my $pkg = __PACKAGE__;
16 7750         13874 my $vars = shift->{$pkg};
17              
18 7750         10591 my @result = ();
19 7750 100       25708 if ($#_ == -1) {
    100          
20 750         9546 @result = @{$vars->{'field_names'}};
  750         2465  
21             } elsif ($#_ == 0) {
22 6250         9267 my ($fname)=@_;
23 6250 100       18715 if (defined($vars->{'field'}->{$fname})) {
24 4750         5396 @result = @{$vars->{'field'}->{$fname}->{'mime_type'}};
  4750         14998  
25             }
26             } else {
27 750         3909 require Carp;
28 750         148617 Carp::confess($pkg . "::param_mime() - incorrect number of calling parameters (either 1 or no parameters expected)");
29             }
30 7000 100       16714 if (wantarray) {
    100          
31 3000         13812 return @result;
32             } elsif ($#result > -1) {
33 3250         12074 return $result[0];
34             } else {
35 750         2301 return;
36             }
37             }
38              
39             ####
40              
41             sub _internal_param_filename {
42 7750     7750   9339 my $pkg = __PACKAGE__;
43 7750         12286 my $vars = shift->{$pkg};
44              
45 7750         11734 my @result = ();
46 7750 100       21583 if ($#_ == -1) {
    100          
47 750         845 @result = @{$vars->{'field_names'}};
  750         2382  
48             } elsif ($#_ == 0) {
49 6250         9000 my ($fname)=@_;
50 6250 100       18712 if (defined($vars->{'field'}->{$fname})) {
51 4750         5288 @result = @{$vars->{'field'}->{$fname}->{'filename'}};
  4750         14078  
52             }
53             } else {
54 750         3035 require Carp;
55 750         110692 Carp::confess($pkg . "::param_filename() - incorrect number of calling parameters (either 1 or no parameters expected)");
56             }
57              
58 7000 100       25042 if (wantarray) {
    100          
59 3000         11354 return @result;
60             } elsif ($#result > -1) {
61 3250         9380 return $result[0];
62 750         2409 } else { return; }
63             }
64              
65             ####
66              
67             sub _burst_multipart_buffer {
68 1252     1252   1711 my $self = shift;
69 1252         1835 my $pkg = __PACKAGE__;
70              
71 1252         2731 my ($buffer,$bdry)=@_;
72              
73 1252         2555 my $vars = $self->{$pkg};
74              
75             # Special case boundaries causing problems with 'split'
76 1252 100       5501 if ($bdry =~ m#[^A-Za-z0-9',-./:=]#s) {
77 561         717 my $nbdry = $bdry;
78 561         2752 $nbdry =~ s/([^A-Za-z0-9',-.\/:=])/ord($1)/egs;
  561         5063  
79 561         1324 my $quoted_boundary = quotemeta ($nbdry);
80 561         11331 while ($buffer =~ m/$quoted_boundary/s) {
81 6         174 $nbdry .= chr(int(rand(25))+65);
82 6         87 $quoted_boundary = quotemeta ($nbdry);
83             }
84 561         1285 my $old_boundary = quotemeta($bdry);
85 561         10905 $buffer =~ s/$old_boundary/$nbdry/gs;
86 561         1507 $bdry = $nbdry;
87             }
88              
89 1252         10318 $bdry = "--$bdry(--)?\015\012";
90 1252         43165 my @pairs = split(/$bdry/, $buffer);
91              
92 1252         3397 foreach my $pair (@pairs) {
93 12518 100       27243 next if (! defined $pair);
94 7511         9276 chop $pair; # Trailing \015
95 7511         8924 chop $pair; # Trailing \012
96 7511 50       15890 last if ($pair eq "--");
97 7511 100       23000 next if (! $pair);
98              
99 5007         15755 my ($header, $data) = split(/\015\012\015\012/s,$pair,2);
100              
101             # parse the header
102 5007         12784 $header =~ s/\015\012/\012/osg;
103 5007         13553 my @headerlines = split(/\012/so,$header);
104 5007         6915 my $name = '';
105 5007         9514 my $filename = '';
106 5007         5871 my $mime_type = 'text/plain';
107              
108 5007         7176 foreach my $headfield (@headerlines) {
109 7259         23124 my ($fname,$fdata) = split(/: /,$headfield,2);
110 7259 100       23503 if ($fname =~ m/^Content-Type$/io) {
111 2252         4089 $mime_type=$fdata;
112             }
113 7259 100       22808 if ($fname =~ m/^Content-Disposition$/io) {
114 5007         30965 my @dispositionlist = split(/; /,$fdata);
115 5007         14928 foreach my $dispitem (@dispositionlist) {
116 12767 100       26148 next if ($dispitem eq 'form-data');
117 7760         23091 my ($dispfield,$dispdata) = split(/=/,$dispitem,2);
118 7760         25224 $dispdata =~ s/^\"//o;
119 7760         22857 $dispdata =~ s/\"$//o;
120 7760 100       18620 $name = $dispdata if ($dispfield eq 'name');
121 7760 100       32322 $filename = $dispdata if ($dispfield eq 'filename');
122             }
123             }
124             }
125              
126 5007 100       25595 if (! defined ($vars->{'field'}->{$name}->{'count'})) {
127 4506         5511 push (@{$vars->{'field_names'}},$name);
  4506         10072  
128 4506         16837 $vars->{'field'}->{$name}->{'count'} = 0;
129             }
130 5007         12829 my $record = $vars->{'field'}->{$name};
131 5007         7463 my $f_count = $record->{'count'};
132 5007         7251 $record->{'count'}++;
133 5007         11705 $record->{'value'}->[$f_count] = $data;
134 5007         10457 $record->{'filename'}->[$f_count] = $filename;
135 5007         17065 $record->{'mime_type'}->[$f_count] = $mime_type;
136             }
137             }
138              
139             ####
140              
141             1;