package CGI::Minimal; # This program is licensed under the same terms as Perl. # See http://dev.perl.org/licenses/ # Copyright 1999-2004 Benjamin Franz. All Rights Reserved. # I don't 'use warnings;' here because it pulls in ~ 20Kbytes of code # and is incompatible with perl's older than 5.6 use strict; #### sub _internal_param_mime { my $pkg = __PACKAGE__; my $vars = shift->{$pkg}; my @result = (); if ($#_ == -1) { @result = @{$vars->{'field_names'}}; } elsif ($#_ == 0) { my ($fname)=@_; if (defined($vars->{'field'}->{$fname})) { @result = @{$vars->{'field'}->{$fname}->{'mime_type'}}; } } else { require Carp; Carp::confess($pkg . "::param_mime() - incorrect number of calling parameters (either 1 or no parameters expected)"); } if (wantarray) { return @result; } elsif ($#result > -1) { return $result[0]; } else { return; } } #### sub _internal_param_filename { my $pkg = __PACKAGE__; my $vars = shift->{$pkg}; my @result = (); if ($#_ == -1) { @result = @{$vars->{'field_names'}}; } elsif ($#_ == 0) { my ($fname)=@_; if (defined($vars->{'field'}->{$fname})) { @result = @{$vars->{'field'}->{$fname}->{'filename'}}; } } else { require Carp; Carp::confess($pkg . "::param_filename() - incorrect number of calling parameters (either 1 or no parameters expected)"); } if (wantarray) { return @result; } elsif ($#result > -1) { return $result[0]; } else { return; } } #### sub _burst_multipart_buffer { my $self = shift; my $pkg = __PACKAGE__; my ($buffer,$bdry)=@_; my $vars = $self->{$pkg}; # Special case boundaries causing problems with 'split' if ($bdry =~ m#[^A-Za-z0-9',-./:=]#s) { my $nbdry = $bdry; $nbdry =~ s/([^A-Za-z0-9',-.\/:=])/ord($1)/egs; my $quoted_boundary = quotemeta ($nbdry); while ($buffer =~ m/$quoted_boundary/s) { $nbdry .= chr(int(rand(25))+65); $quoted_boundary = quotemeta ($nbdry); } my $old_boundary = quotemeta($bdry); $buffer =~ s/$old_boundary/$nbdry/gs; $bdry = $nbdry; } $bdry = "--$bdry(--)?\015\012"; my @pairs = split(/$bdry/, $buffer); foreach my $pair (@pairs) { next if (! defined $pair); chop $pair; # Trailing \015 chop $pair; # Trailing \012 last if ($pair eq "--"); next if (! $pair); my ($header, $data) = split(/\015\012\015\012/s,$pair,2); # parse the header $header =~ s/\015\012/\012/osg; my @headerlines = split(/\012/so,$header); my $name = ''; my $filename = ''; my $mime_type = 'text/plain'; foreach my $headfield (@headerlines) { my ($fname,$fdata) = split(/: /,$headfield,2); if ($fname =~ m/^Content-Type$/io) { $mime_type=$fdata; } if ($fname =~ m/^Content-Disposition$/io) { my @dispositionlist = split(/; /,$fdata); foreach my $dispitem (@dispositionlist) { next if ($dispitem eq 'form-data'); my ($dispfield,$dispdata) = split(/=/,$dispitem,2); $dispdata =~ s/^\"//o; $dispdata =~ s/\"$//o; $name = $dispdata if ($dispfield eq 'name'); $filename = $dispdata if ($dispfield eq 'filename'); } } } if (! defined ($vars->{'field'}->{$name}->{'count'})) { push (@{$vars->{'field_names'}},$name); $vars->{'field'}->{$name}->{'count'} = 0; } my $record = $vars->{'field'}->{$name}; my $f_count = $record->{'count'}; $record->{'count'}++; $record->{'value'}->[$f_count] = $data; $record->{'filename'}->[$f_count] = $filename; $record->{'mime_type'}->[$f_count] = $mime_type; } } #### 1;