Нет, нет и еще раз нет! Изобретение "велосипедов" не преследуется по закону, но и не особо приветствуется. Просто иногда хочется понять механизм работы некоторых элементов, к которым давно привык, и не обращаешь на них внимание. Для обработки данных, получаемых из формы, существует много модулей: CGI, CGI::Simple, CGI::Lite, CGI::WebIn, это из тех, которые знаю я. Наверняка их еще больше. А что я вижу в скриптах "неизвестного производства"?
$buffer = $ENV{'QUERY_STRING'};

if ($ENV{'REQUEST_METHOD'} eq 'POST') {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'})
}

@pairs = split(/&/, $buffer);

foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/<!--(.| )*-->/<br>/g;
$value =~ s/</</g;
$value =~ s/>/>/g;
$value =~ s/cM/<br>/g;
$value =~ s/ / /g;
$value =~ s/|/ /g;
$value =~ s/|/ /g;
$value =~ s/<([^>]| )*>/<br>/g;
$FORM{$name} = $value;
}

После чего, начинающие специалисты копируют этот код в свои скрипты и начинают "флудить" на форумах (каюсь: сам таким был и так делал). Но это не самое интересное, проблемы начинаются после того, как потребуется "фильтровать" данные, но не все и не так; потом, иногда форма отправляет несколько значений для одного параметра, а мы получаем только одно; про upload вообще помолчу. В итоге, этот код начинает "обрастать" дополнительными "фишками". А требований все больше и больше:
...выносим этот код в отдельную внешнюю процедуру, так как при доработках постоянно при ходится править кучу скриптов...
...старые доработки и фильтры удалять нельзя, из используют некоторые скрипты, приходится делать дополнительные...
...upload - черт с ним, цепляем модуль CGI, но не везде...
...некоторые параметры надо получить в виде массива, заносим эти параметры отдельно...
и так далее... в общем полный улет... А когда это все надоедает, начинаем писать use CGI в скриптах, и не морочим себе голову.

Но, с использованием, CGI и альтернативных модулей, начинаешь "лениться" и про механизм обработки полученных данных - забываешь. В данной статье мы рассмотрим принцип обработки данных и в процессе напишем небольшой модуль, "без претензий" на первенство.
1. Какие данные мы получаем

В основном (если не всегда), данные передаются только двумя методами:

* GET;
* POST;

Но во время отправки данных методом POST мы можем передать дополнительные данные в URI.

А так же, данные предаются практически всегда (если не всегда) двумя типами данных:

* text/plain (text/html);
* multipart/form-data (только для метода POST);

Формат передаваемых данных можно посмотреть здесь. Но особо не вдаваясь в подробности можно сказать так:

если тип данных text/... данные передаются в виде:

param1=value1¶m2=value2

Где "&" - разделитель параметров, а "=" - разделитель между параметром и значением. При этом можно не волноваться по поводу того, что в имени или значении параметра могут быть эти символы, так как браузер автоматически конвертирует эти символы (и некоторые другие) в шестнадцатеричный формат.

если тип данных multipart/form-data:
-----------------------------7d513a1b160308
Content-Disposition: form-data; name="param1"

value1
-----------------------------7d513a1b160308
Content-Disposition: form-data; name="file"; filename="D:param2.txt"
Content-Type: text/plain

blablablablablablablablabla
blablablablablablablabla
blablablablablablabla
blablablablablabla
blablablablabla
blablablabla;
blablabla?
blabla;

bla
blabla
bla
blablabla

blablablablablabla
-----------------------------7d513a1b160308--

При этом мы видим, что предварительного ковертирования символов - нет, то есть данные передаются "как есть". Отправной точкой для нас является только уникальный разделитель, в нашем случае - "-----------------------------7d513a1b160308" (естественно, что он каждый раз новый).

Какие данные передает нам Cookies:

Данные передаются в переменной окружения $ENV{'HTTP_COOKIE'} ($ENV{'COOKIE'}), формат:

param1=value1; param2=value2; param3 = value3;

В общем, ничего сложного, итак:
2. Начало модуля и объявление объекта:

Ничего нового, все как по учебнику:
package My::CGI;
# Без него никак нельзя
use strict;
# С помощью этого модуля, будем определять FILEHANDLE
# Модуль выбран первый попавшийся, если кому нравится другой - пожалуйста
use IO::File;
# Версия, что бы потом не запутаться
our $VERSION = '1.0.0';

# Процедура объявления объекта
sub new {
# %common - дополнительные сведения, в нашем случае, максимальный объем принимаемых данных
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;
}

Сама собой выплыла следующая процедура (_parse_common_data) - разбор полученных данных.
3. Разбор полученных данных

В этой процедуре мы должны обработать три вида данных, точнее не обработать а указать последовательность обработки следующих данных:

* данные переданные методом GET или в URI (QUERY_STRING);
* данные переданные методом POST (CONTENT_LENGTH + STDIN) при этом определить какого они типа;
* данные Cookies (HTTP_COOKIE);

Код:
sub _parse_common_data {

my $self = shift;

# Проверяем наличие QUERY_STRING, при этом не имеет значение метод передачи
# данных, так при методе GET у нас в этой переменной передаются значения формы,
# при методе POST, дополнительные даные в URI, а может просто быть запрос с
# какими-либо параметрами
if ($ENV{'QUERY_STRING'}) {
# и если у нас есть значение, то обрабатываем данные, при этом отдельно указывая
# метод, так для метода POST - 'POST', остальные - GET;
$self = &_parse_QUERY_STRING($self, 'GET')
}

# Проверяем метод передачи данных, для обработки POST
if (uc($ENV{'REQUEST_METHOD'}) eq 'POST') {
# Если тип данных multipart, то передаем обработку в соответсвующую процедуру
if (exists($ENV{'CONTENT_TYPE'}) && $ENV{'CONTENT_TYPE'} =~m |^s*multipart/form-data|i) {
$self = &_parse_MultiPart($self)
# иначе стандартная обработка, с указанием, что обрабатываются данные метода POST
} else {
$self = &_parse_QUERY_STRING($self, 'POST')
}
}

# Проверяем наличие переданных Cookies
if ($ENV{'HTTP_COOKIE'} || $ENV{'COOKIE'}) {
# Если есть, то обрабатываем
$self = &_parse_COOKIES($self)
}
# Возвращаем заполненый данными массив
return $self
}

Процедура небольшая, и несложная, пора переходить к самому интересному:
4. Разбор данных типа text

Что нам нужно, собственно алгоритм:

* разобрать по отдельности все параметры;
* разобрать имя параметра и его значение;
* обработать эти данные (так как некоторые символы при отправке конвертируются в шестнадцатеричный код);
* положить результат в наш хеш (который в последствии станет объектом), но мы должны учесть, что параметр может быть один, а значений несколько;

Код:
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'}
}
# Разделяем отдельно параметры. В общем, по сути, достаточно было бы и одного
# символа "&", в качестве разделителя, но иногда проявляется символ "?", а в
# модуле CGI еще используется символ ";", но впрочем, хуже не будет если мы укажем
# все символы, тем более как сказано выше, боятся того, что в имени параметра или
# его значении может проскочить этот символ - не стоит, так что:
my @pairs = split(/[?&;]/,$data);
foreach (@pairs) {
# Отделяем имя параметра от его значения, цифра 2 говорит о том, что переменная $_
# разбивается только на 2 части, хотя это лишнее, но тоже не помешает
my ($param, $value) = split('=', $_, 2);
# Если какого-либо значения нет, то данный параметр пропускаем
next unless $param && $value;
# Декодируем полученные значения из шестнадцатеричного формата отдельной
# Хотя, отдельно процедуру выносить не обязательно, только для удобства
$param = &URLDecode($param);
$value = &URLDecode($value);
# Внедряем в наш хеш полученные данные, так как данная функция пригодится нам и
# при обработке данных типа multipart, то выносим её отдельно
$self = &_include_data($self, $param, $value);
}

return $self
}

Быстро обрисуем процедуру URLDecode, она взята как есть у Дмитрия Котерова (CGI::WebIn), и сложного в ней ничего нет:
sub URLDecode {my $s = shift; $s =~tr /+/ /; $s =~s /%([0-9A-Fa-f]{2})/chr(hex($1))/esg; return $s}

А вот на внедрении данных заострим внимание:
5. Заполнение объекта данными

В общем случае мы должны учитывать, что переданный параметр может содержать как одно значение, так и их массив,
sub _include_data {
# Получаем переданные в процедуру данные (вместе с объектом)
my ($self, $param, $value) = @_;
# В данных параметра подменяем на
$value =~s /(x0dx0a)|(x0ax0d)/ /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
}
6. Разбор данных типа multipart/form-data

Сразу хочу оговорится, что изначально не предусматриваю загрузку нескольких файлов под одним именем параметра, не от лени, а от того, что в своей практике такого никогда не делал, чего и Вам не советую.

Каков алгоритм обработки данных:

* проверить максимальный объем переданных данных (а то нам никакого хостинга не хватит);
* определить уникальный разделитель данных;
* определить тип переноса строк ( , , или ) для разных платформ они могут быть разными;
* обработать в цикле данные как при обработке текстового типа, но с оговоркой:
o если данные обычный текст - обрабатывать как обычно;
o если данные загружаемый файл - специальная обработка;

Код:
sub _parse_MultiPart {
# Получаем массив, объект
my $self = shift;
# Проверяем объем полученных данных
if ($ENV{'CONTENT_LENGTH'} > $self->{'max_upload'}) {return}
# Включаем режим бинарного чтения входного потока
binmode STDIN;
# Считываем входящие данные
read(STDIN, $data, $ENV{'CONTENT_LENGTH'});
# Определяем в полученных данных уникальный разделитель, перенос строки и
# непосредственно все данные, по схеме:
# [гр. 1: уникальный разделитель][гр. 2: перенос строки][гр. 3: данные]->
# [гр. 2][гр. 1]--[гр. 2]
# Обращаю внимание, что мы сразу же начинаем использовать группы символов (1,2)
# в регулярном выражении для определения окончания данных (21--2$)
my ($spliter, $end, $data) = $data =~m /^([^ ]+)([ ]+)(.*?)21--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);
# если имя описания - name, то это имя параметра
if ($name eq 'name') {
($param) = $value =~/^"(.*)"$/
}
# если имя описания - filename, то это имя загружаемого файла и, соответственно,
# текстовое значение параметра
if ($name eq 'filename') {
($data) = $value =~/^"(.*)"$/
}
}
# если у нас инициализировано(!) значение параметра, то значит этот параметр,
# является загружаемым файлом, соответственно, для него своя обработка
if ($data) {
# Заносим тектовые данные параметра в объект
$self->{'data'}->{$param} = $data;
# Определяем имя временного файла, я, по привычке, использую случайное число,
# можно использовать pid процесса, в общем кому как нравится
my $temp_file = './COME_'.int(rand 100000).'.tmp';
# Открываем файл для записи, создастся он сам, при этом не мешало бы
# использовать flock, но что-то я подумал, блокировать случайный файл - лишняя
# операция, при том что если такой прецедент возникнет, все равно будет ошибка,
# так как, какой-то загруженный, но не "обработанный" файл будет "затерт". Так
# же папка, где расположен скрипт должна быть "разрешена" для записи, хотя
# обратное - исключение из правил, но все же...
open (UPL, '>', $temp_file) || die 'Error create temp files!!!';
# Определяем режим, как бинарный
binmode UPL;
# Записываем в него данные
print UPL $content;
# Закрываем файл
close UPL;
# Записываем имя временного файла в наш объект, ключ - имя параметра
$self->{'tmp'}->{$param} = $temp_file;
} else {
# Иначе, если обрабатываемые данные не файл, то обычная обработка как текста. Но
# В данной обработке мы не используем процедуру URLDecode, потому как при типе
# данных multipart/form-data, управляющие символы не декодируются
$self = &_include_data($self, $param, $content);
}
}
# возвращаем заполненный массив, объект
return $self
}

В итоге у нас формируется два хеша в основном объекте: хеш параметров и текстовых значений, и хеш параметров с именами на временные файлы. Почему временные файлы? Да потому, что у нас и так входной поток забит данными, то бы его еще дублировать в массиве - не рационально.
7. Разбор данных cookies

Процедура обработки cookies такая же, как обычных текстовых данных, даже проще, так как управляющие символы не декодируются.

Код:
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

}

Отмечу, что не включил возможность получения массива значений, так как ни разу такого не требовалось, но расширить данную процедуру будет не сложно.

На этом обработка данных заканчивается, остается только описать методы объекта позволяющие эти данные возвращать в скрипт.
8. Методы получения данных

Всего определим 3 метода:

* получение текстового значения параметра в виде массива и нет;
* получение FILEHANDLE закруженного файла (параметра);
* получение текстового значения cookies;

Код:
# Метод (процедура) возврата текстового значения параметра
sub param {
# Получаем объект и имя параметра
my ($self, $param) = @_;
# Если данного параметра нет, возвращаем 0
unless ($self->{'data'}->{$param}) {return 0}
# Иначе получаем значение параметра
my $data = $self->{'data'}->{$param};
# Возврат, практически такой же как у модуля CGI:
# Если вернуть требуется массив:
# Если значение - ссылка на массив - разыменовываем и возвращаем
# Иначе возвращаем массив в 1 элемент
# Иначе:
# Если значение - ссылка на массив - возвращаем первый элемент массива
# Иначе - возвращаем значение
# то есть возврат зависит от того, что требуется вернуть:
# @param = $query->param('param'); - требуется вернуть массив
# $param = $query->param('param'); - требуется вернуть одно значение
return wantarray ? (ref $data ? @$data : ($data)) : (ref $data ? $data->[0] : $data)
}

# Метод (процедура) FILEHANDLE параметра
sub file {
# Получаем объект и имя параметра
my ($self, $param) = @_;
# Если данного параметра во временных файлах нет, возвращаем 0
unless ($self->{'tmp'}->{$param}) {return 0}
# Иначе создаем объект IO::File и возвращаем его
my $data = IO::File->new($self->{'tmp'}->{$param});
return $data
}

# Метод (процедура) возврата текстового значения cookies
sub cookies {
# Получаем объект и имя параметра
my ($self, $param) = @_;
# Просто возвращаем значение или 0 при его отсутсвии
return $self->{'cookies'}->{$param} || 0;
}

Вызов методов осуществляется:
...
use My::CGI;

my $query = new My::CGI (MAX_UPLOAD => 128000);

my $param = $query->('param_name');
my @param = $query->('param_name');

my $file_name = $query->param('file');
my $file_handle = $query->file('file');

my $cookie = $query->cookies('cookie_name');
...

И все, осталось только почистить "хвосты".
9. Метод DESTROY

В процессе загрузки файлов, у нас создаются временные файлы на сервере, которые после работы скрипта, становятся не нужными. Можно создать отдельный метод, "подчищающий" эти файлы, и вызывать его после обработки и получения данных в скрипте, а можно воспользоваться предопределенным методом DESTROY класса.

Код:
sub DESTROY {
my $self = shift;
foreach (values %{$self->{'tmp'}}) {unlink $_}
return 1
}

Теперь все, со спокойной душой ставим в конце 1; и сохраняем файл.
Заключение

Как было сказано ранее, данная статья носит более информативный характер и не является "руководством к действию", несмотря на то, что все основные функции наш модуль все-таки выполняет. Возможно, какие-то тонкости я не учел, что может привести к некорректной работе.