Перед Web-разработчиками часто стоит задача изготовления cgi-скриптов для обработки данных из форм, закодированных в статическом html-файле. Для облегчения разработки таких программ могут использоваться различные визуальные построители, но мы также можем воспользоваться мощью самого Perl.

Для получения информации из HTML файла нам надо его разобрать. Для этих целей мы можем воспользоваться разными модулями, например модулями для работы с SGML. Но HTML часто не является правильным SGML документом, поэтому для HTML существует свой набор парсеров, например HTML::Parser, HTML::PullParser или HTML::SimpleParse.

В нашей программе мы будем использовать HTML::Parser, поскольку он знает о том, какие элементы могут располагаться внутри других. HTML::Parser является парсером, управляемым событиями. Это означает, что при срабатывании какого либо из условий -- обнаружении открывающего или закрывающего тагов, текста или другого события, происходит вызов процедуры-обработчика (callback). Пользовательские процедуры могу быть зарегистрированы для конкретного класса событий. Регистрация процедур может осуществляться как при создании парсера, так и в ходе выполнения программы. Процедуры-обработчики должны быть определенны в пакете, унаследованном от HTML::Parser.

Общая схема работы с парсером состоит из таких этапов:

• создание парсера: как правило эта операция выполняется с помощью команды HTML::Parser->new(...), при этом в качестве параметров могут быть заданны различные опции настройки и зарегистрированы функции-обработчики различных событий. При успешном создании объекта возвращается ссылка на созданный объект.
• регистрация процедур-обработчиков, если это не было сделано при создании парсера.
• настройка парсера (по необходимости).
• выполнение разбора файла, во время которого вызываются функции обработчики.

Использование HTML::Parser в нашей программе

Для нашей программы нужно создать парсер (строка 11) и зарегистрировать процедуры обработки событий обнаружения открывающих и закрывающих тагов. По умолчанию процедуры-обработчики берутся из текущего пакета, который должен быть унаследован от пакета HTML::Parser (строки 6-10):

 package ParseForm; use strict; use vars qw(@ISA $inrecord $inform); @ISA = qw(HTML::Parser); require HTML::Parser; 

Затем нам необходимо создать экземляр класса ParseForm (строка 11). А сам разбор файла производится функцией parse_file (строка 12), которой передается имя файла, заданное в командной строке.

 11	my $form = new ParseForm; 12	$form->parse_file($ARGV[0] die "Usage: generate_forms.pl filename.html\n") die $!; 

При разборе файла производится вызов функций-обработчиков start и end, которые формируют хеш с информацией о формах html-файла:

$VAR1 = bless( { 'Input' => { 'type' => 'reset' }, '_hparser_xs_state' => \135125016, 'Forms' => { '/?action=post-news1' => { 'inputs' => [ { 'type' => 'textarea', 'name' => 'title' }, { 'type' => 'textarea', 'name' => 'news' }, { 'type' => 'hidden', 'name' => 'poster' } ], 'method' => 'post' } }, 'name' => '' }, 'ParseForm' ); 

Остановимся подробнее на обработчиках событий. Вся основная работа выполняется обработчиком start (строки 57-80).

 57	sub start() { 58	 my($self,$tag,$attr,$attrseq,$orig) = @_; 59	 if (lc($tag) eq 'form') { 60	 $self->{'name'} = $attr->{'action'}; 61	 $self->{'Forms'}{$self->{'name'}} = {}; 62	 $self->{'Forms'}{$self->{'name'}}->{'method'} = $attr->{'method'}; 63	 $self->{'Forms'}{$self->{'name'}}->{'inputs'} = (); 64	 } 65	 if ( lc($tag) eq 'input' ) { 66	 $self->{'Input'} = {}; 67	 $self->{'Input'}->{'type'} = $attr->{'type'}; 68	 if ((lc($attr->{'type'}) ne 'submit') && (lc($attr->{'type'}) ne 'reset') ) 69	 { 70		$self->{'Input'}->{'name'} = $attr->{'name'}; 71		push @{$self->{'Forms'}{$self->{'name'}}->{'inputs'}},\%{$self->{'Input'}}; 72	 } 73	 } 74	 if ( lc($tag) eq 'textarea' ) { 75	 $self->{'Input'} = {}; 76	 $self->{'Input'}->{'type'} = 'textarea'; 77	 $self->{'Input'}->{'name'} = $attr->{'name'}; 78	 push @{$self->{'Forms'}{$self->{'name'}}->{'inputs'}},\%{$self->{'Input'}}; 79	 } 80	} 

Он вызывается когда парсер встречает открывающий таг. При этом функции передается 5 параметров (строка 58): ссылка на сам объект-парсер (параметр $self), имя тага (параметр $tag), ссылка на хеш атрибутов данного тага (параметр $attr), ссылка на массив имен атрибутов тага (параметр $attrseq) и исходный текст тага (параметр $orig).

Затем в зависимости от имени тага, выполняются разные действия:

• Если открывается таг form, то мы задаем полю хеша name значение полученное из атрибута action (это имя мы будем использовать для генерации имени файла с cgi-скриптом), и инициализируем поля для хранения данных о полях формы (строки 61-63).
• Если открывается таг input, то мы определяем из хеша атрибутов тип тага, заполняем поле name для данного тага (строка 70) и помещаем эту информацию в общий хеш. Заметьте, что в строке 68 выполняется проверка, чтобы в результат не попали кнопки submit и reset.
• Если встречается таг textarea, то выполняются те же действия, как и в предыдущем пункте, за тем исключением, что тип поля задается явно.

Функция-обработчик end (строки 81-86) вызывается когда парсер встречает закрывающий таг. Когда встречается закрывающий таг для формы, то мы задаем имя текущей формы равным пустой строке:

 81	sub end() { 82	 my($self,$tag) = @_; 83	 if ($tag eq 'form') { 84	 $self->{'name'} = ''; 85	 } 86	} 

Результаты работы

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

Эту информацию мы и будем использовать для генерации скелета скрипта для обработки формы. Это производится в строках 13-56.

 13	foreach my $a ( keys %{$form->{'Forms'}} ) { 14		if($a ne '') 15		{ 16		 my $fname=$a; 17		 $fname=~s/.*\/(.*?)/${1}/; 18		 $fname=~s/\?//g; 19		 open OUT, ">${fname}.pl" die $!; 20		 print OUT <<"EOF"; 21	#!/usr/bin/perl -w  22	use strict; 23	use CGI; 24	my \$has_error=undef; 25	my \$q=new CGI; 26	print \$q->header(); 27	print \$q->start_html(\'\'); 28	if(\$q->param()) 29	{ #form from file $ARGV[0]  30	EOF 31			my $t=$form->{'Forms'}->{$a}; 32			my $ar=$t->{'inputs'}; 33			print "Creating file $fname\n"; 34			foreach (@{$ar}) 35			{ 36				my $name = $_->{'name'}; 37				print OUT <<"EOF"; 38		my \$p$name=undef; 39		if(!defined(\$p$name=\$q->param(\'$name\'))) 40		{ 41			print \"parameter $name is undefined!\\n\"; 42			\$has_error=1; 43		} 44	EOF 45			} 46			print OUT <<'EOF'; 47	} 48	else 49	{ 50		print "<p>Can\'t run this script without paramaters"; 51	} 52	print $q->end_html(); 53	EOF 54			close OUT die $!; 55		} 56	} 

Цикл foreach пробегает по всем формам, определенным в указанном файле. При этом каждый из скелетов обработчиков форм выводится в отдельный файл, поскольку в одном html-файле может быть несколько форм.

Строки 20-30 формируют заголовок cgi-скрипта, а строки 45-56 заключительную часть скрипта. Создание скелетов для обработки полей входящих в форму производится в строках 31-44. Для генерации постоянных частей скриптов используются так называемые "внутренние документы" (here documents), которые начинаются со строки print OUT <<"EOF"; и заканчиваются словом EOF, которое должно располагаться на отдельной строке.

Заключение

Ну вот и все -- полный текст программы может быть приведен ниже. Данная программа не претендует на законченность, в нее можно вносить обработку таких тагов, как например select.

Примечание: Полный список всех опций настройки и функций пакета HTML::Parser, может быть найден в справочной странице этого пакета.

Полный текст программы:

#!/usr/bin/perl -w # # Description: Generates code for handling forms from given html-file # # Author: Alex Ott (ottalex@narod.ru) package ParseForm; use strict; use vars qw(@ISA $inrecord $inform); @ISA = qw(HTML::Parser); require HTML::Parser; my $form = new ParseForm; $form->parse_file($ARGV[0] die "Usage: generate_forms.pl filename.html\n") die $!; foreach my $a ( keys %{$form->{'Forms'}} ) { 	if($a ne '') 	{ 	 my $fname=$a; 	 $fname=~s/.*\/(.*?)/${1}/; 	 $fname=~s/\?//g; 	 open OUT, ">${fname}.pl" die $!; 	 print OUT <<"EOF"; #!/usr/bin/perl -w use strict; use CGI; my \$has_error=undef; my \$q=new CGI; print \$q->header(); print \$q->start_html(\'\'); if(\$q->param()) { #form from file $ARGV[0] EOF 		my $t=$form->{'Forms'}->{$a}; 		my $ar=$t->{'inputs'}; 		print "Creating file $fname\n"; 		foreach (@{$ar}) 		{ 			my $name = $_->{'name'}; 			print OUT <<"EOF"; 	my \$p$name=undef; 	if(!defined(\$p$name=\$q->param(\'$name\'))) 	{ 		print \"parameter $name is undefined!\\n\"; 		\$has_error=1; 	} EOF 		} 		print OUT <<'EOF'; } else { 	print "