|
ru.cgi.perl
- RU.CGI.PERL ------------------------------------------------------------------
From : Denis Poznyakov 2:5020/400 19 May 2004 13:15:41
To : Andrei Protasovitski
Subject : Re: Разобрать форму (нюанс)
--------------------------------------------------------------------------------
> Поделитесь деталями для нового велика!
старое но рабочее
=============
sub _load_params {
my @pairs=();
my ($buffer,$boundary,$lenpairs,$i,$pair);
my ($temp,$pozition,$header,$cd,$name,$fname,$value);
if ($ENV{'CONTENT_TYPE'} and $ENV{'CONTENT_TYPE'} =~
m(^multipart\/form-data)i) {
if ($ENV{'REQUEST_METHOD'} ne 'POST') {
print "Content-type: text/html;\n\nInvalid request method for
multipart/form-data !\n"; exit;
}
binmode(STDIN); seek(STDIN,0,0);
read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary="([^"]+)"/;
($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=(\S+)/ unless
$boundary;
$temp="--$boundary--\x0D\x0A";
$boundary = "--" . $boundary . "\x0D\x0A";
$buffer = substr($buffer,0,index($buffer,$temp));
@pairs = split(/$boundary/, $buffer);
$lenpairs=@pairs;
for ($i=1;$i<$lenpairs;$i++) {
$pairs[$i] = substr($pairs[$i], 0, length($pairs[$i])-2);
$pozition = index($pairs[$i],"\r\n\r\n");
$header = substr($pairs[$i], 0, $pozition);
($cd) = grep (/^\s*Content-Disposition:/i, $header);
($name) = $cd =~ /\bname="([^"]+)"/i;
($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;
($fname) = $cd =~ /\bfilename="([^"]*)"/i;
($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined
$fname;
$fname= substr($fname,rindex($fname,"\\")+1);
$value= substr($pairs[$i], $pozition+4);
if ($fname or $header =~ /Content-Type:/i) {
if ($header =~ /Content-Type:/i and $fname) {
$in_params{$name}=$fname;
$in_params{"src$name"}=$value;
} else {$in_params{$name}=''}
} else {
$value = unescape($value);
if ($in_params{$name}) {
if (ref($in_params{$name}) eq 'ARRAY') {
push(@{$in_params{$name}},$value);
} else {
my @arr=();
push @arr, $in_params{$name}, $value;
$in_params{$name}=\@arr;
}
} else {$in_params{$name}=$value}
}
}
}
else {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}||0);
if (!$buffer) {$buffer=$ENV{'QUERY_STRING'}}
if ($buffer) {
foreach $pair (split(/&/, $buffer)) {
($name, $value) = split(/=/, $pair);
$value = unescape($value);
if ($in_params{$name}) {
if (ref($in_params{$name}) eq 'ARRAY') {
push(@{$in_params{$name}},$value);
} else {
my @arr=();
push @arr, $in_params{$name}, $value;
$in_params{$name}=\@arr;
}
} else {$in_params{$name}=$value}
}
}
}
return %in_params;
}
=============
--- ifmail v.2.15dev5.3
* Origin: Demos online service (2:5020/400)
Вернуться к списку тем, сортированных по:
|
