Хочется узнать мнение остальных специалистов о новом "велосипеде" на тему обработки данных из формы (+ URI и Cookies)
Модуль получился на редкость небольшой, но при этом не проиграл в функциональности:
package My::CGI;
use strict;
use IO::File;
our $VERSION = \'1.1.0\';
sub new {
my ($self, %common) = @_;
$self = {
max_upload => 262144, # Default 256 Kb
data => {},
cookies => {},
tmp => {},
};
$self->{\'max_upload\'} = $common{\'MAX_UPLOAD\'} if $common{\'MAX_UPLOAD\'};
$self = &_parse_common_data($self);
bless $self;
return $self;
}
sub param {
my ($self, $param) = @_;
unless ($self->{\'data\'}->{$param}) {return undef}
my $data = $self->{\'data\'}->{$param};
return wantarray ? (ref $data ? @$data : ($data)) : (ref $data ? $data->[0] : $data)
}
sub file {
my ($self, $param) = @_;
my $data;
unless ($self->{\'tmp\'}->{$param}) {return undef}
$data = IO::File->new($self->{\'tmp\'}->{$param});
return $data
}
sub cookies {
my ($self, $param) = @_;
return $self->{\'cookies\'}->{$param} || undef;
}
sub _parse_common_data {
my $self = shift;
if ($ENV{\'QUERY_STRING\'}) {$self = &_parse_QUERY_STRING($self, \'GET\')}
if (uc($ENV{\'REQUEST_METHOD\'}) eq \'POST\') {
if(exists($ENV{\'CONTENT_TYPE\'}) && $ENV{\'CONTENT_TYPE\'}=~m|^\\s*multipart/form-data|i) {$self = &_parse_MultiPart($self)}
else {$self = &_parse_QUERY_STRING($self, \'POST\')}
}
if ($ENV{\'HTTP_COOKIE\'} || $ENV{\'COOKIE\'}) {$self = &_parse_COOKIES($self)}
return $self
}
sub _parse_QUERY_STRING {
my ($self, $type) = @_;
my $data;
if ($type && $type eq \'POST\') {read(STDIN, $data, $ENV{\'CONTENT_LENGTH\'})}
else {$data = $ENV{\'QUERY_STRING\'};}
my @pairs = split(/[\\?\\&]/,$data);
foreach (@pairs) {
my ($param, $value) = split(\'=\',$_,2);
next unless $param && $value;
$param = URLDecode($param);
$value = URLDecode($value);
$self = &_include_data($self, $param, $value);
}
return $self
}
sub _parse_MultiPart {
my $self = shift;
if ($ENV{\'CONTENT_LENGTH\'} > $self->{\'max_upload\'}) {return}
binmode STDIN; my ($spliter, $end, $data);
read(STDIN, $data, $ENV{\'CONTENT_LENGTH\'});
($spliter, $end, $data) = $data =~m /^([^\\r\\n]+)([\\n\\r]+)(.*?)\\2\\1\\-\\-\\2*$/s;
srand;
foreach my $block (split($end.$spliter.$end, $data)) {
my ($header, $content) = split($end.$end, $block, 2);
my ($param, $data);
foreach my $line (split(/($end)|(\\s*\\;\\s*)/,$header)) {
my ($name, $value) = split(/\\=|\\:\\s/,$line, 2);
if ($name eq \'name\') {($param) = $value =~/^\\"(.*)\\"$/}
if ($name eq \'filename\') {($data) = $value =~/^\\"(.*)\\"$/}
}
if ($data) {
$self->{\'data\'}->{$param} = $data;
my $temp_file = \'./COME_\'.int(rand 100000).\'.tmp\';
open (UPL, \'>\', $temp_file);
binmode UPL;
print UPL $content;
close UPL;
$self->{\'tmp\'}->{$param} = $temp_file;
} else {
$self = &_include_data($self, $param, $content);
}
}
return $self
}
sub _parse_COOKIES {
my $self = shift;
my $cookies = $ENV{\'HTTP_COOKIE\'} || $ENV{\'COOKIE\'};
foreach my $line (split(/\\;\\s*/,$cookies)) {
my ($param, $value) = split(\'=\',$line, 2);
next unless $param && $value;
$self->{\'cookies\'}->{$param} = $value;
}
return $self
}
sub _include_data {
my ($self, $param, $value) = @_;
$value =~s /(\\x0d\\x0a)|(\\x0a\\x0d)/\\n/sg;
if (exists $self->{\'data\'}->{$param}) {
if (ref $self->{\'data\'}->{$param}) {push @{$self->{\'data\'}->{$param}}, $value}
else {$self->{\'data\'}->{$param} = [$self->{\'data\'}->{$param}, $value]}
} else {
$self->{\'data\'}->{$param} = $value
}
return $self
}
sub URLDecode {my $s = shift; $s =~tr /+/ /; $s =~s /%([0-9A-Fa-f]{2})/chr(hex($1))/esg; return $s }
sub DESTROY {
my $self = shift;
foreach (values %{$self->{\'tmp\'}}) {unlink $_}
return 1
}
1;
Работа с ним, практически как с CGI:
use My::CGI;
my $query = new CGI;
my $value = $query->param(\'param\');
my $filehandle = $query->file(\'param\');
my $cookies = $query->cookies(\'name\');
Что скажете?
