#!/usr/bin/perl
package in;
BEGIN
{
$VERSION = '1.1';
use Exporter();
@ISA=qw(Exporter);
@EXPORT=qw(%GET %POST %COOKIE %IN);
use Storable qw(dclone nstore retrieve);
if ($ENV{REQUEST_METHOD} eq "GET") {&ParseGet($ENV{QUERY_STRING});%GET=%{dclone(\%G)};undef %G;}
if ($ENV{REQUEST_METHOD} eq "POST")
{
if ($ENV{CONTENT_TYPE}=~/^application\/x\-www\-form\-urlencoded/i) {&ParsePost;}
if ($ENV{CONTENT_TYPE}=~/^multipart\/form\-data/i) {&ParsePostF;}
}
&ParseCookie;
%IN=(%POST,%GET,%COOKIE);
# переменные окружения
# ParseGet
sub ParseGet(?)
{
($data)=@_;
undef %G;
foreach (split(/&/,$data))
{
($a,$b)=split(/=/,$_);
$a=URLDecode($a);
$b=URLDecode($b);
if (exists($G{$a}))
{
if (!ref $G{$a}) #esli net esho massiva
{
$_=$G{$a};
delete $G{$a};
push @{$G{$a}},$_;
}
push (@{$G{$a}},$b);
}
else {$G{$a}=$b;}
}
return 0;
}
# ParsePost
sub ParsePost
{
sysread(STDIN,$post,$ENV{CONTENT_LENGTH});
&ParseGet($post);
%POST=%{dclone(\%G)};
undef %G;
return 0;
}
# ParsePostF
sub ParsePostF
{
sysread(STDIN,$post,$ENV{CONTENT_LENGTH});
my $boundary_=$ENV{CONTENT_TYPE};
$boundary_=~m/boundary=\-*([\w\/\+\\]+)/;
$boundary_=$1;
@boundary_=split(/-+$boundary_/,$post);
pop @boundary_;
shift @boundary_;
foreach $param_ (@boundary_)
{
$param_=~s/^[\n\r]+//;
($head_,$data_)=split (/[\r\n]{4}/,$param_);
$data_=~s/\r\n$//;
#key
$head_=~m/name="?(\w+)["; \r\n]/m;
$key_=$1;
#data
if ($head_=~m/filename="?([^";\r\n]+)"?/m)
{
# filer to filename
${$POST{$key_}}[0]=$1;
${$POST{$key_}}[1]=$data_;
}
elsif (exists($POST{$key_}))
{
if (!ref $POST{$key_}) #esli net esho massiva
{
$_=$POST{$key_};
delete $POST{$key_};
push @{$POST{$key_}},$_;
}
push (@{$POST{$key_}},$data_);
}
else {$POST{$key_}=$data_;}
}
return 0;
}
# ParseCookie
sub ParseCookie
{
foreach (split(/; /,$ENV{HTTP_COOKIE}))
{
($key_,$value_)=split(/=/,$_);
URLDecode($key_);
URLDecode($value_);
#filters on cookie
$COOKIE{$key_}=$value_;
}
return 0;
}
# unescape URL-encoded data
sub URLDecode($)
{
my $todecode = shift;
$todecode =~ tr/+/ /;
$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
return $todecode;
}
}
1;
вот, но тут нет никаких ограничений
вызываеться в программе так $IN{key} и всё работает тока вот что-то он не до конца принимает всё что нужно:(
|
