File Coverage

lib/CGI/Minimal/Misc.pm
Criterion Covered Total %
statement 70 70 100.0
branch 13 14 92.8
condition n/a
subroutine 6 6 100.0
pod n/a
total 89 90 98.8


line stmt bran cond sub pod time code
1             package CGI::Minimal;
2              
3 5     5   31 use strict;
  5         10  
  5         4577  
4              
5             ####
6              
7             sub _internal_calling_parms_table {
8 3     3   5 my $self = shift;
9 3         5 my $pkg = __PACKAGE__;
10 3         8 my $vars = $self->{$pkg};
11              
12 3         5 my $outs = <<"EOF";
13             \n \n \n\n";
14            
Form Fields
15            
Field Value mime Type File Name
16             EOF
17 3         3 foreach my $fname (sort @{$vars->{'field_names'}}) {
  3         10  
18 6         8 my $f_data = $vars->{'field'}->{$fname};
19 6         6 my $sub_field_counter = $#{$f_data->{'value'}};
  6         9  
20 6         12 for (my $fn=0;$fn <= $sub_field_counter;$fn++) {
21 7         9 my $fmime = $f_data->{'mime_type'}->[$fn];
22 7         8 my $ffile = $f_data->{'filename'}->[$fn];
23 7         7 my $fvalue = '[non-text value]';
24 7 100       19 if ($fmime =~ m#^text/#oi) {
25 6         11 $fvalue = $self->htmlize($f_data->{'value'}->[$fn]);
26             }
27 7         27 $outs .= <<"EOF";
28            
29             $fname (#$fn)
30             $fvalue
31             $fmime
32             $ffile
33            
34             EOF
35             }
36             }
37 3         5 $outs .= <<"EOF";
38            
39             Environment Variables
40            
41              
42            
43             Variable
44             Value
45            
46             EOF
47              
48 3         43 foreach my $fname (sort keys (%ENV)) {
49             $outs .= "
$fname" .
50 93         188 $self->htmlize($ENV{$fname}) . "
51             }
52              
53 3         9 $outs .= "
\n";
54              
55 3         15 return $outs;
56             }
57              
58             ####
59              
60             sub _internal_date_rfc1123 {
61 1     1   1 my $self = shift;
62 1         2 my ($tick) = @_;
63 1         25 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime($tick);
64 1         4 my $wkday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$wday];
65 1         1 my $month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
66 1         3 $year += 1900;
67 1         6 my $date = sprintf('%s, %02d %s %s %02d:%02d:%02d GMT',$wkday,$mday,$month,$year,$hour,$min,$sec);
68 1         4 return $date;
69             }
70              
71             ####
72              
73             sub _internal_url_decode {
74 258     258   269 my $self = shift;
75 258         323 my ($s) = @_;
76 258 100       355 return '' if (! defined($s));
77 257         305 $s =~ s/\+/ /gs;
78 257         743 $s =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
79 256 50       701 defined($1)? chr hex($1) : _utf8_chr(hex($2))/ge;
80 257         623 return $s;
81             }
82              
83             ####
84              
85             sub _internal_dehtmlize {
86 2     2   5 my $self = shift;
87              
88 2         3 my($s)=@_;;
89              
90 2 100       6 return ('') if (! defined($s));
91              
92 1         8 $s=~s/\>/>/gs;
93 1         3 $s=~s/\</
94 1         3 $s=~s/\"/\"/gs;
95 1         4 $s=~s/\&/\&/gs;
96              
97 1         13 return $s;
98             }
99              
100             sub _internal_set {
101 129     129   166 my $pkg = __PACKAGE__;
102 129         169 my $vars = shift->{$pkg};
103              
104 129         215 my ($parms) = @_;
105 129         464 foreach my $name (keys %$parms) {
106 129         179 my $value = $parms->{$name};
107 129         180 my $data = [];
108 129         197 my $data_type = ref $value;
109 129 100       199 if (! $data_type) {
    100          
110 127         204 $data = [ $value ];
111              
112             } elsif ($data_type eq 'ARRAY') {
113 1         2 @$data = @$value; # Shallow copy
114              
115             } else {
116 1         3 require Carp;
117 1         143 Carp::croak ("${pkg}::_internal_set() - Parameter '$name' has illegal data type of '$data_type'");
118             }
119              
120 128 100       291 if (! defined ($vars->{'field'}->{$name}->{'count'})) {
121 1         1 push (@{$vars->{'field_names'}},$name);
  1         2  
122             }
123 128         158 my $record = {};
124 128         344 $vars->{'field'}->{$name} = $record;
125 128         183 $record->{'count'} = @$data;
126 128         170 $record->{'value'} = $data;
127 128         143 my $data_entries = @$data;
128 128         225 for (my $f_count=0;$f_count < $data_entries;$f_count++) {
129 129         241 $record->{'filename'}->[$f_count] = '';
130 129         421 $record->{'mime_type'}->[$f_count] = 'text/plain';
131             }
132             }
133             }
134              
135             1;