Библиотека 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

# # Александр Симаков, <xdr (тчк) box на Google Mail> # 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:

Ссылки

Домашняя страница проекта GTK+

Домашняя страница проекта Gtk2-perl

ActivePerl от ActiveState

Домашняя страница Camelbox

Gtk2-perl FAQ

Gtk2-perl tutorial by Dirk van der Walt

Gtk2-perl tutorial by Dov Grobgeld

Gtk2-perl tutorial by Emmanuele Bassi

Статья: Subclassing Widgets In Perl

Установка в 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+: отметить сильные и слабые стороны, предупредить о возможных сложностях и проблемах.

и красиво. Проект 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 на переносы, которые поймет браузер (тег <BR>):

$msg =~ s/\n/<br>/g;

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

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

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

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

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

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

print OUT $to_base;

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

close (OUT); }

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

sub view {

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

open (BASE, "

Читаем содержимое файла в массив @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):<br>$msg<br><br>"; }

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

print " <form action=$html_file method=get>

Nick: <input name=nick><br>

Message: <TEXTAREA ROWS=15 COLS=50 name=msg></TEXTAREA><br>

<input name=action value=post type=hidden>

<input type=submit value=Отправить>

</form>

"; }

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



Называем файл так, как указано в переменной $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=<cache_list>; # 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=<cache>;

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 "<center><form style='margin: 0.1px' action='book.cgi' method=post><font size=\"2\" face=\"Arial, Helvetica, sans-serif\"><strong>Искать по названию:</strong></font> <input type=text name=text value='$phrase' size=30><input type=submit value='Искать'></form><br>";

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%<small class="micro">Книгопечатная продукция</small><br>%%ig; # убираем лишнюю информацию

136     $basic_html =~ s%<big class="BIG2">Результаты поиска</big><br><b><small>Найдено (\d+)</small></b>%%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%<small style="color:FFFFFF"><b>(.*)</b>%){

159       $td->replace_with(' ');

160     }

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

163      if($td->as_HTML("<>%") =~ m%<td class="paddleft"><small style="color:FFFFFF"><b>(.*)</b></small>%){

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 "<center><h1><font color=red>Sorry, Server is too busy. Please visit later.</font></h1></center>";

178        exit;

179       }

180     }

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

183  {

184    my $handle=shift;

185    flock($handle,8);

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

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

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

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

Наконец, рассмотрим последний вариант. Иногда хочется (или приходится) работать с сервером напрямую, без промежуточных программ. Тогда можно применить способ, описанный ниже.

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

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

Вторая строка создает объект соккета, т. е. соединение с компьютером, IP-адрес которого 127.0.0.1, на 25-й порт. Третьей строкой мы проверяем, установлено ли соединение. Если соединение не установлено, происходит аварийное завершение скрипта.

Теперь - самое главное. В предыдущих примерах мы не формировали заголовок письма - это автоматически делала программа sendmail. Но здесь придется все прописывать собственноручно, в том числе и заголовок.

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

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

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

From:John Doe <jd\@domain.com>\n To:Frank Smith <fs\@domain.com>\n Subject:Test.\n\n It's just test!!!1512

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

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

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

* * *

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

document.write('');

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

02.08 - 02.08 - 02.08 - 02.08 - 02.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 31.07 - 31.07 - 31.07 - 31.07 - 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, знают, что написание на этом мощном языке программирования скрипта для создания и отправки писем - для начинающего дело достаточно сложное. Мы рассмотрим три варианта таких скриптов

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

Итак, первый вариант такого скрипта, самый простой:

На первый взгляд, ничего сложного. Но давайте присмотримся повнимательнее.

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

В третьей строке мы передаем в sendmail строку "From: your\@email.com\n". Что это значит? Давайте разбирать по порядку. Данная строка содержит информацию, сообщающую почтовому серверу, от кого получено данное письмо. При формировании письма почтовый сервер поместит в поле От: имя и адрес, взятые из этой строки.

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

Седьмая строка скрипта содержит тело сообщения - собственно содержание письма. Таких строк может быть несколько.

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

Обратите внимание на то, что перед символом @ обязательно должна стоять обратная косая черта (\). Иначе знак @ будет ошибочно принят за признак массива, что вызовет аварийное завершение скрипта.

Вот и все - письмо отослано. Но вот вопрос: что за \n стоит в конце каждой строки, а в шестой строке - даже дважды? Эта последовательность обозначает перевод строки в Unix-подобных системах. В данном же случае она представляет собой ни что иное как конец команды. В шестой она повторяется дважды, чтобы сообщить серверу, что команды закончились и дальше идет тело письма.

Вариант второй

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

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

Скачав и установив MIME::Lite, приступаем к разбору скрипта:

Первая строка подключает необходимый нам модуль 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/<A HREF=\"(.*?)\"/g ) { print "$1\n"; }

При запуске она начинает выдавать что-то вроде этого:

MIRRORING.FROM RECENT RECENT.html authors/00whois.html authors/01mailrc.txt.gz authors/id/A/AA/AASSAD/CHECKSUMS ...

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

while( $html =~ m/<A HREF=\"(.*?)\"/g ) { print URI->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.

Ссылки

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

LWP::Simple: простые функции для скачивание, рабора заговков и зеркалирования адресов.

LWP: Обзор модулей libwww-perl.

LWP::UserAgent: Класс для объектов, которые исполняют роль "виртуальных броузеров".

HTTP::Response: Класс объектов, которые представляют "ответ", такой как в

$response = $browser->get(...).

HTTP::Message

и HTTP::Headers: Классы для предоставление большего количества методов для HTTP::Response.

URI: Класс для объектов, которые представляют собой абсолютные или относительные URLы.

URI::Escape: Функции для работы с escape-последовательностями в адресах (например преобразование туда и обратно из "this & that" в "this%20%26%20that").

HTML::Entities: Функции для работы с escape-последовательностями в HTML (например преобразование туда и обратно из "C. & E. Brontë" в "C. & E. Brontë").

HTML::TokeParser

и HTML::TreeBuilder: Классы для грамматического разбора("парсинга") HTML.

HTML::LinkExtor: Класс для нахождения ссылок в документах.

И последнее, но не наименьшее, моя книга Perl & LWP.

You can redistribute this document and/or modify it, but only under the same terms as Perl itself.

Включение 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 обратно на диск.

это очень популярная группа модулей

LWP (сокращение от "Library for WWW in Perl") это очень популярная группа модулей языка Perl для доступа к данным в сети Internet. Как и большинство модулей языка Perl, на каждый модуль из состава LWP присутствует документация с полным описанием его интерфейса. Однако, в LWP есть множество модулей, для которых довольно сложно найти документацию по, казалось бы, простейшим вещам.
Введение в использование LWP, очевидно, должно занять целую книгу, -- книгу, которая только вышла из печати, и названную: Perl& LWP. Эта статья предлагает Вам несколько примеров, которые помогут Вам в организации обычных вещей с LWP.

Web Основы с LWP

Автор: Sean M. Burke

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

Август 20, 2002,

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

В этой статье мы рассмотрим процесс создания пакетов и модулей и в качестве примера создадим один простейший модуль и пакет.

Intro
Защищенность и модульность - два великих принципа программирования. Perl обеспечивает их выполнение, предоставляя возможность разбивать программу на полуавтономные фрагменты так, что программисту не надо беспокоиться о конфликтах между ними и остальной частью программы. Для деления программы на независимые фрагменты используются пакеты Perl, которые создают непересекающиеся области имен (namespaces). Что такое область имен? Это часть программы со своей собственное областью видимости глобальных идентификаторов - другими словами, она функционирует как частная территория программиста.
На самом деле в Perl нет такой вещи, как "область видимости глобальных идентификаторов", - любая такая область ограничивается неким пакетом. Создавая пакет, вы получаете некую гарантию того, что ваш код не смешается с переменными и подпрограммами другого фрагмента. Это позволяет организовывать код, предназначенный для многократного использования, в виде пакетов.
Кроме пакетов существуют также модули Perl. Моудли - это пакеты, организованные специальным образом. Их можно загружать и интегрировать с конкретной программой. В этой статье пойдет речь о создании модулей и пакетов.

Пакеты
Пакет можно представить в виде юнита Delphi. Код, помещаемый в пакет, может размещаться во внешнем файле, в нескольких файлах, хотя несколько пакетов могут размещаться в одном файле (что невозможно сделать в дельфийском юните). Переключаться между различными пакетами внутри файла нужно с помощью команды package. Давайте создадим простой пакет и сохраним его как package1.pl:

package package1;
BEGIN { }
sub subroutine1 {print "Hello!\n";}
return 1;
END { }

Команда package начинает новый пакет package1. Обратите внимание на подпрограммы BEGIN и END. Первая подпрограмма выполняется сразу же после загрузки пакета. Поэтому в неё обычно помещают инициализирующий код. Хотя вернее было бы утверждать, что подпрограмма BEGIN выполняется как только интерпретатор доходит до неё, т.е. до окончания загрузки пакета. А подпрограмма END выполняется при завершении работы интерпретатора и может содержать код, выполняющий заключительные оперпации (например закрытие открытых файлов. Подпрограммы BEGIN и END вызываются неявным образом (более того, вам никогда не удастся явно вызвать BEGIN: интерпретатор уничтожает её сразу же после использования). Именно поэтому эти подпрограммы состоят из заглавных букв, и ключевое слово sub для них можно не указывать.
Обратите внимание на подпрограмму subroutine1. Её можно вызывать в пределах кода, использующего пакет. Кроме того, стоит обратить внимание на команду return, расположенную вне каких либо подпрограмм, - она возвращает значение "истина" после загрузки пакета, показывая таким образом, что пакет готов к работе (на самом деле возвращается последнее значение, вычисленное в теле пакета, поэтому часто вместо строки return 1 ставится просто единица).
Что бы использовать в программе код пакета, необходимо поместить в сценарий команду require:
require "package1.pl";
Теперь можно ссылаться на идентификаторы пакета package1, отделив его имя от идентификатора двумя двоеточиями "::". Раньше в роли разделителя был апостроф (будьте внимательны, потому что этот разделитель используется и сейчас). Но теперь Perl следует стилю C++ и использует "::". Вот пример вызова подпрограммы subroutine1 из пакета package1:
require "package1.pl";
package1::subroutine1();
Как результат работы этой программы будет выведена надпись "Hello!". Можно также в пакеты помещать другие идентификаторы, например переменные:
package package1;
BEGIN { }
$var1=1;
sub subroutine1 {print "Hello!\n";}
return 1;
END { }
Использовать эту переменную легко. Достаточно подставить символ "$" перед конструкцией вызова. Пример:
require "package1.pl";
$package1::var1;
Обратите внимание, что символ "$" ставится перед именем пакета, но НЕ ставится после :: перед var1. Однако таким способом невозможно добраться до переменных, описанных с ключевым словом my: они обладают лексической областью видимости и доступны только внутри модуля.
При обращении к идентификаторам можно опускать имя пакета, и тогда будет использован пакет main (строка $::var1 эквивалентна $main:var1).
Если в программе нужно довольно часто обращаться к идентификаторам из пакетов, то код становится большим и малопонятным. Что бы решить эту проблему нужно использовать модули. При использовании модулей можно экспортировать имена, указанные в модуле в текущюю область имен.

Модули
Модули - это пакеты, оформленные в отдельных файлах, у которых имена последних совпадают с именами модулей и имеют расширение pm. По соглашению Perl определяет, что имя модуля начинается с заглавной буквы. Код, содержащийся в модуле, в отличие от "пакетного" кода, может экспортировать глобальные имена в текущюю область глобальных имен. Это означает, что при обращении к идентификатору не нужно указывать имя пакета.
Рассмотрим пример. Создайте модуль с именем Module1 и cохраните его в файле Module1.pm. В коде подпрограммы BEGIN, выполняемом при загрузке модуля, будем использовать стандартный модуль Exporter, что бы экспортировать имя подпрограммы subroutine1:
package Module1;
BEGIN {
use Exporter ();
@ISA = "Exporter";
@EXPORT = "&subroutine1";
}
sub subroutine1 {print "Hello!\n";}
return1;
END { }
Для использования модуля в программе нужно подключить его с помощью команды "use" (он будет включен в момент компиляции). Если же подключить модуль командой require то модуль подключится в момент исполнения сценария. Пример:
use Module1;
subroutine1();
В результате выполнения этого кода будет выведена строка "Hello!".

Outro
Эта статья не пертендует на полноту описания модулей и пакетов. Существует ещё много, чего вы не узнали из этой статьи: пакеты можно вкладывать друг в друга, разрешать экспортировать определенные имена и не экспортировать их по умолчанию и даже вызываь несуществующие подпрограммы. Но это тема огромной главы книги, если не всей книги.
При подготовке статьи были использованы материалы из книги "Perl. Специальный справочник" (автор Стивен Холзнер, издательство "Питер", 2001 г.)

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

Вы можете задать несколько альтернативных шаблонов, используя символ | как разделитель. Альтернативные шаблоны позволяют превратить процедуру поиска из однонаправленного процесса в разветвленный: если не подходит один шаблон 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 совпадений.

Например квантификатор + соответствует фразе "один или несколько" и является жадным. Расмотрим пошагово принцип перебора с возвратом на примере квантификатора +:

'aaabc' =~/a+abc/;

a+ сразу в силу жадности совпадает с тремя а:

(aaa)bc

но после aaa не следует строка "abc", а следует "bc". Поэтому результат - failed поэтому анализатор должен откатиться назад и вернуть с помощью a+ два a:

(aa)abc

т.е. на втором шаге шаблон найдет совпадение.

Рассмотрим пример работы еще одного жадного квантификатора *(ноль или несколько совпадений):

amxdemxg /.*m/

Сначала будет найдена вся строка abcdebfg в силу жадности .*, потом квантификатору нужно будет найти сравнение с буквой m, произойдет ошибка. Квантификатор .* отдаст одну букву и его содержимое будет уже amxdemx. На конце снова нет буквы m. Будет отдана еще одна буква и снова не будет найдено совпадение со всем шаблоном и наконец квантификатор .* будет содержать подстроку amxde, за которой уже стоит символ m. И поиск на этом и закончится не смотря на то, что в строке amxdemxg содержится не одна буква m. Потому и говорят, что квантификаторы обладают жадностью, т.е. находят максимально возможное совпадение.

Допустим нужно найти совпадение:

$uu="How are you? Thanks! I'm fine, you are ok??"; $uu=~s/.*you//; print $uu;

Квантификатор .* оставит текст " are ok??", а вовсе не "? Thanks! I'm fine, you are ok??". Если же поставить ограничитель ?, который вместе со знаком квантификатора означает максимально возможное совпадение

$uu="How are you? Thanks! I'm fine, you are ok??"; $uu=~s/.*you//; print $uu;

то переменная $uu будет содержать текст "? Thanks! I'm fine, you are ok??".

Предположим нужно найти совпадения типа network workshop, т.е. перекрытия.

$u='network'; $m='workshop'; print "перекрытие $2 найдено: $1$2$3\n" if("$u $m" =~/^(\w+)(\w+) \2(\w+)$/);

$1 сразу берет все слово в $u, но дальше идет еще один максимальный квантификатор (\w+), которому тоже чего-то надо и он забирает из переменной \1 букву k(причем только одну):

#!/usr/bin/perl $uu="asdfg asdf"; $uu=/(\w+)(\w+)\s(\w+)(\w+)/; print "$1 $2##$3 $4"; asdf g##asd f

далее пошаговая работа regex выглядит примерно так:

1: 'networ''k'=> '\sk' совпадает ли с '\sworkshop' falure 2: 'netwo''rk'=> '\srk' совпадает ли с '\sworkshop' falure 3: 'netw''ork'=> '\sork' совпадает ли с '\sworkshop' falure 4: 'net''work'=> '\swork' совпадает ли с '\sworkshop' ok

и в результате программа выдаст: перекрытие work найдено: networkshop

Данный регексп не сработает, если

$u='networkwork'; $m='workshop';

шаблон найдет перекрытия workwork, а не work. Чтобы этого избежать, нужно сделать минимальным \1: /^(\w+?)(\w+) \2(\w+)$/

Квантификатор действует только на предшествующий ему элемент шаблона. Например, конструкция \d{2}[a-z]+ будет соответствовать последовательности из одной или нескольких строчных латинских букв, начинающейся с двух цифр, а не последовательности, составленной из чередующихся цифр и букв. Для выделения группы элементов, на которую действует квантификатор, используются круглые скобки: (\d{2}(a-z])+

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

Символы могут быть сгруппированы в классы. Указанный в шаблоне класс символов сопоставляется с любым из символов, входящим в этот класс. Класс - это совокупность символов, заключенный в квадратные скобки [ и ]. Можно указывать как отдельные символы, так и их диапазон (диапазон задается двумя крайними символами, соединенными тире). Наример, следующий код производит поиск гласных: $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+ интерпретируется как слово, перед которым имеется пробельный символ (в отличие от заглядывания вперед, заглядывание назад может работать только с фиксированным числом проверяемых символов).

(?<!шаблон) - отрицание предыдущего условия. Перед текущей точкой не должно быть текста, соотносимого с заданным шаблоном. Соответственно, от команды /(?<!\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-документ, в котором произвольное число вложенных таблиц [<table>.*</table>]. Требуется "вырезать" по очереди самые вложенные таблицы (не содержащие внутри [<table>.*</table>]), и, соответственно, выводить. И так - рекурсивно до конца вырезать изнутри всю таблицу. Ниже представлена программа, реализующая эту задачу при помощи логического оператора (?!...):

#!/usr/bin/perl -wT

$file=qq|s<table>aaa bbb <table>cc<table>ccc <table> 2<table>bb</table> <table>cc</table> </table></table>cc </table> ddd</table>d |;

print $file; &req($file); sub req { if($file=~m%(<table>((?!.*<table>).*?)</table>)%igs){ $file=~s%(<table>((?!.*<table>).*?)</table>)%%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|(?<!Mary\+)Tom|){ print "Tom is without Mary!\n"; } else{ print "Tom is busy...\n"; }

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). В качестве текста для подстановки используется возвращаемое значение - возможно, после процесса интерполяции

Особенности работы команд m/.../ и s/.../.../

До сих пор мы рассматривали регулярные выражения, используемые в качестве шаблонов для команд m/.../ и s/.../.../, и не особо интересовались, как работают эти команды. Настало время восполнить пробелы.

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

Команда s/.../.../ ищет прототип, соответствующий шаблону, и, если поиск оказывается успешным, заменяет его на новый текст. Без модификатора замена производится только для первого найденного совпадения, с модификатором g выполняются замены для всех, совпадений во входном тексте. Команда возвращает в качестве результата число успешных замен или пустую строку (условие ложь false), если ни одной замены сделано не было. В качестве анализируемого текста используется $_ (режим по умолчанию) или выражение, присоединенное к шаблону с помощью оператора =~ или !~. В случае поиска (команда m/.../) конструкция, расположенная слева от операторов =~ или !~, может и не быть переменной. В случае замены (команда s/.../.../) в левой части должна стоять скалярная переменная, или элемент массива, или элемент хэша, или же команда присвоения одному из указанных объектов.

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

$text="ABC-abc"; $text =~ s#B#xxx#ig; print $text; AxxxC-axxxc

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

while (defined($text = <>)) { if ($text =~/^exit$/i) {exit;} }

Если в качестве ограничителя для команды m/.../ используется вопросительный знак, то букву m также можно опустить. Однако шаблоны, ограниченные символом ?, в случае поиска работают особым образом (независимо от наличия или отсутствия начальной m). А именно, они ведут себя как триггеры, которые срабатывают один раз и потом выдают состояние ложь (false), пока их не взведут снова, вызвав функцию reset (она очищает статус блокировки сразу всех конструкций ?...?, локальных для данного пакета). Например, следующий фрагмент сценария проверяет, есть ли в файле пустые строки: while (<>) if (?^$?) {print ."There is an empty line nere.\n";} continue { reset if eof; #очистить для следующего файла }

Диагностическое сообщение будет напечатано только один раз, даже если в файле присутствует несколько пустых строк. Команда поиска с вопросительным знаком относится к подозрительным командам, а потому может не войти в новые версии perl. 1 В качестве ограничителей можно также использовать различные (парные) койструкции скобок: while (<>){ if(m/^quit$/i){exit;} if(m(^stop$)i){exit;} if(m[^end$]i) {exit;} if(m{^bye$}i) {exit;} if (!1)<^ехit$>i) {exit;} }

В случае команды s/.../.../ и использования скобок как ограничителей для первого аргумента, ограничители второго аргумента могут выбираться независимо: $text =~ "Perl is wonderful"; $text =~ s/is/is very/; $text =~ s[wonderful]{beautiful}; $text =~ s(\.)/!/; print $text; Perl is very beautiful!

Предварительная обработка регулярных выражений

Аргументами команд m/.../ и s/.../.../ являются регулярные выражения, которые перед началом работы интерполируются подобно строкам, заключенным в двойные кавычки В отличие от текстовых строк, для шаблона не выполняется интерполяция имен типа $), $| и одиночного $ - perl считает, что такие конструкции соответствуют метасимволу конца строки, а не специальной переменной. Если же в результате интерполяции шаблон поиска оказался пустой строкой, perl использует последний шаблон, который применялся им для поиска или замены.

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

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

Команда замены s/.../.../ использует регулярное выражение, указанное в качестве второго аргумента, для замены текста. Поскольку оно обрабатывается (интерполируется) после того, как выполнена очередная операция поиска, в нем можно, в частности, использовать временные переменные, созданные на этапе поиска. В следующем примере мы последовательно заменим местами пары слов, заданных во входном тексте, оставив между ними по одному пробелу: $text = "One Two Three Four Five Six"; $text =- s/(\w+)\s*(\w+)/$2$1/g; Two One Four Three Six Five

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

Работа команды m/.../ в режиме однократного поиска

В скалярном контексте и без модификатора g команда m/.../ возвращает логическое значение - целое число 1 (истина (true)), если поиск оказался успешным, и пустую строку "" (ложь (false)), если нужный фрагмент текста найти не удалось. Если внутри шаблона имеются группы элементов, заключенные в круглые скобки, то после операции поиска создаются нумерованные переменные $1, $2, ..., в которых содержится текст, соответствующий круглым скобкам. В частности, если весь шаблон заключить в круглые скобки, то в случае успешного поиска переменная $1 будет содержать текст, соотнесенный с шаблоном. После успешного поиска можно также использовать специальные переменные $&, $', $' и $+

$text = "---one---two---three---"; $scalar = ($text =' m/(\w+)/); print "Result: $scalar ($1)."; Result: 1 (one).

Если вы используете команду m/.../ в списковом контексте, то возвращаемое значение сильно зависит от того, есть ли группы из круглых скобок в вашем шаблоне. Если они есть (то есть если создаются нумерованные переменные), то после успешного поиска в качестве результата будет получен список, составленный из нумерованных переменных ($1, $2,...):

$text = "---one, two, three---"; array = ($text ='m/(\w+),\s+(\w+),\s+(\w+)/); print join "=", array; one=two=three.

В отличие от ранних версий, perl 5 присваивает значения нумерованным переменным, даже если команда поиска работает в списковом контексте:

$text = "---one, two, three--- "; ($Fa, $Fb, $Fc) = ($text=-m/(\w+),\s+(\w+),\s+(\w+)/); print "/$Fa/$Fb/$Fc/\n"; print "$1=$2=$3.\n"; /one/two/three/ one=two::three.

Если же в шаблоне нет групп, выделенных круглыми скобками, то в случае успешного поиска возвращается список, состоящий из одного элемента - числа 1. При неудачном поиске независимо от того, были ли в шаблоне круглые скобки, возвращается пустой список: $text = "---one, two, three--- "; @array = ($text=~ m/z\w+/); print "Result: /", @array, "/\n"; print "Size: ", $#array+1, ".\n"; Result:// Size: 0. Обратите внимание на разницу между пустым и неопределенным списками.

Работа команды m/.../ в режиме глобального поиска

Команда m/.../ работает иначе, если указан модификатор g, задающий глобальный поиск всех вхождений шаблона по всему тексту. Если оператор используется в списковом контексте и в шаблоне есть группы круглых скобок, то в случае удачного поиска возвращается список, состоящий из всех найденных групп, расположенных друг за другом:

$text = "---one---two-~-three---"; @array = ($text =~m/(-(\w+))/); print "Single: [", join(", ", array),"].\n"; @array = ($text =~m/(-(\w+))/g); print "Global: [", join(", ", array),"].\n"; Single: [-one, one]. Global: [-one, one, -two, two, -three, three].

Если же в шаблоне нет групп круглых скобок, то оператор поиска возвращает список всех найденных прототипов шаблона, то есть ведет себя так, как если бы весь шаблон был заключен в круглые скобки: $text = "---one---two---three--"; @array = ($text =~m/\w+/); print "Result: (", join(", ", @array), ").\n"; Result: (one, two, three).

В случае неудачного поиска, как и в предыдущих вариантах, возвращается пустой список. В скалярном контексте и с модификатором g комaндa m/.../ ведет себя сивершенно особым образом. Специальная переменная $_ или переменная, стоящая слева от оператора =~ или !~, при поиске с модификатором g получает дополнительные свойства - в нее записывается последнее состояние. При каждом последующем обращении к данному фрагменту кода поиск будет продолжаться с того места, на котором он остановился в последний раз. Например, следующая команда подсчитывает количество букв х в заданной строке текста:

$text = "Here is texxxxxt."; $counter = O; while ($text =~ m/x/g){ print "Found another x.\n"; $conter++; print "Total amount = $counter.\n"; Found another х. Found another х. Found another x. Found another x. Found another x. Total amount = 5.

Состoяние (точнее, позиция) поиска сохраняется даже в случае перехода к следующему оператору поиска, имеющему модификатор g. Неудачный поиск сбрасывает значение в исходное состояние, если только для команды m/.../ не указан модификатор с (то есть команда должна иметь вид m/.../gc). Изменение текстового буфера, для которого выполняется поиск, также сбрасывает позицию поиска в исходное состояние. В следующем примере из текстовой строки последовательно извлекаются и выводятся пары имя/значение до тех пор, пока строка не закончится:

$text = "X=5; z117e=3.14l6; temp=lQ24;"; $docycle = 1; $counter = 0; while ($docycle) { undef $name; undef $value; if ($text =~ m/(\w+)\s*=\s*/g) {$name = $1;} if ($text =~ m/([\d\.\*\-]*)\s*;/g) {$value = $1;} if (defined($name) and defined($value)) { print "Name=$name, Value=$value.\n"; $counter++, }else{ $docycle = 0; } } print "I have found $conter values.\n"; Name=X, Value=5. Name=z117e, Value=3.1416. Name=temp, Value=1024. I have found 3 values.

Позиция, на которой остановился поиск, может быть прочитана и даже переустановлена с помощью встроенной функции perl pos. В шаблоне на текущую позицию поиска можно ссылаться с помощью метасимвола \G. В следующем примере из строки последовательно извлекаются буквы p, o и q и выводится текущая позиция поиска:

$index = 0; $_ = "ppooqppqq"; while ($index++ < 2) { print "1: '"; print $1 while /(o)/gc; print "', pos=", pos, "\n"; print "2: '"; print $1 if /\G(q)/gc; print "', pos=";' pos, "\n"; print "3: '"; print while /(p)/gc; print "', pos=",pos, "\n"; }

1: 'oo', pos=4; 2: 'q', pos=7; 3: 'pp', pos=4; 1: '', pos=7; 2: 'q', pos=8; 3: '', pos=8;

В документации perl приводится основанный на этом механизме интересный пример последовательного лексического разбора текста. В нем каждая последующая команда поиска очередной лексической единицы начинает выполнятьсяс того места, где завершила свою работу предыдущая. Советую внимательно разобраться с этим примером (страница руководства perlop, раздел "Regexp Quote-Uke Operators", описание команды m/PATTERN/), если вы хотите расширить доступный вам инструментарий perl!

Замена строк с помощью команды tr/.../.../

Кроме команд m/.../ и s/.../.../ строки можно обрабатывать с помощью команды tr/.../.../ (она же - команда у/.../.../):

tr/список1/список2/модификаторы; у/список1/список2/модификаторы;

В отличие от m/.../ и s/.../.../, эта команда не использует шаблоны и регулярные выражения, а выполняет посимвольную замену, подставляя в текст вместо литер из первого списка соответствующие им литеры из второго списка. Например, в следующем случае производится замена литер "i" на "о":

$text = "My name is Tim."; $text =~ tr/i/o/; print $text; My name is Tom.

В качестве списков используются идущие друг за другом символы, не разделяемые запятыми (то есть это скорее строки, чем списки). В отличие от шаблонов команд m/.../ и s/.../.../, аргументы команды tr/.../.../ не интерполируются (то есть подстановки значений вместо имен переменных не происходит), хотя escape-последовательности, указанные внутри аргументов, обрабатываются правильно. Подобно m/.../ и s/.../.../, команда tr/.../.../ пo умолчанию работает с переменной $_: while (<>){ tr/iI/jJ/; print;

В качестве списков можно указывать диапазоны символов - как, например в следующем фрагменте кода, заменяющем строчные буквы на заглавные: $text = "Here is the text."; $text =~ tr/a-z/A-Z/; print $text; HERE IS THE TEXT.

Как и в случае m/.../ u s/.../.../, команда tr/.../.../ не требует использовать именно знаки косой черты в качестве ограничителей. Можно использовать практически любой символ, отличный от "пробельных", букв и цифр, а также парные скобочные конструкции.

Команда tr/.../.../ возвращает число успешных замен. В частности, если не было сделано никаких замен, она возвращает число ноль. Это позволяет, например, подсчитать с помощью команды tr/.../.../ количество вхождений буквы х в строку $text, не меняя содержимого этой переменной: $text = "Here is the text."; $xcount = ($text =~tr/x/x/); print $xcount; 1

Если у команды tr/.../.../ нет модификаторов (см. далее раздел "Модификаторы команды tr/.../.../"), то ее аргументы при обычных условиях должны быть одинаковой длины. Если второй аргумент длиннее первого, то он усекается до длины первого аргумента - так, команда tr/abc/0-9/ эквивалентна команде tr/abc/012/. Если первый аргумент длиннее второго и второй не пуст, то для второго аргумента необходимое число раз повторяется его последний символ - так, команда tr/O-9/abc/ эквивалентна команде tr/0123456789/abcccccccc/. Если же второй, аргумент пуст, то команда tr/.../.../ подставляет вместо него первый аргумент.

Как легко заметить, если второй аргумент пуст, то (при отсутствии модификаторов) команда tr/.../.../ не производит никаких действий, а возвращаемое ею значение равно числу совпадений между первым аргументом и обрабатываемым текстом. Например, следующая команда подсчитывает количество цифр в строке: $text = "Pi=3.1415926536, е=2.7182"; $digit_counter=($text =~ tr/0-9//); print $digit_counter; 16

Команда tr/.../.../ работает без рекурсии, просто последовательно заменяет символы входного текста. Например, для замены заглавных букв на строчные, и на-оборот, достаточно выполнить команду: $text = "MS Windows 95/98/NT"; $text =" tr/A-Za-z/a-zA-Z/; print $text; ms WINDOWS 95/98/nt

Если в списке, указанном в качестве первого аргумента, есть повторяющиеся символы, то для замены используется первое вхождение символа: $text = "Billy Gates"; $text =~ tr/ttt/mvd/; print $text; Billy Games Модификаторы команды tr/.../.../

Команда tr/.../.../ допускает использование следующих модификаторов:

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

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

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

Если указан модификатор d, a первый аргумент команды длиннее второго, то все символы из первого списка, не имеющие соответствия со вторым списком, удаляются из обрабатываемого текста. Пример: удаляем строчные латинские буквы и заменяем пробелы на слэши: $text = "Here is the text."; $text =~ tr[ a-z][/]d; print $text; H///.

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

Если указан модификатор с, то в качестве первого аргумента рассматриваются все символы, кроме указанных. Например, заменим на звездочки все символы, кроме строчных латинских букв: $text = "Here is the text,"; $text =' tr/a-z/*/c; print $text; *ere*is*the*text*

Если указан модификатор s, то в случае если замещаемые символы образуют цепочки из одинаковых символов, они сокращаются до одного. Например, заменим слова, состоящие из латинских букв, на однократные символы косой черты: $text = "Here is the text."; $text ="tr(A-Za-z)(/)s; print $text; / / / /. Без модификатора s результат был бы другим: $text = "Here is the text."; $text =' tr(A-Za-z)(/); print $text; //// // /// ////.

Примеры:

1. Заменить множественные пробелы и нетекстовые символы на одиночные пробелы: $text = "Here is the text." $text =~ tr[\000-\040\177\377][\040]s; print $text; Here is the text.

2. Сократить удвоенные, утроенные и т.д. буквы; $text = "Here is the texxxxxxt."; $text =~ tr/a-zA-Z/s; print $text; Here is the text.

3. Пересчитать количество небуквенных символов: $xcount=($text =~ tr/A-Za-z//c);

4. Обнулить восьмой бит символов, удалить нетекстовые символы: $text =- tr{\200-\377}{\000-\l77}; $text =~ tr[\000-\037\177][]d;

5. Заменить нетекстовые и 8-битные символы на одиночный пробел: $text =~ tr/\021-\176/ /cs;

Поиск отдельных слов

Чтобы выделить слово, можно использовать метасимвол \S соответствующий символам, отличным от "пробельных": $text = "Now is the time."; $text =- /(\S+)/; print $1; Now

Однако метасимвол \S соответствует также и символам, обычно не используемым для идентификаторов. Чтобы отобрать слова, составленные из латинских букв, цифр и символов подчеркивания, нужно использовать метасимвол \w: $text = "Now is the time."; $text =~ /(\w+)/; print $1; Now

Если требуется включить в поиск только латинские буквы, надо использовать класс символов: $text = "Now is the time."; $text =~ /([A-Za-z]+)/; print $1; Now

Более безопасный метод состоит в том, чтобы включить в шаблон мнимые символы границы слова: $text = "How is the time."; $text=~/\b([A-Za-z]+)\b/; print $1; Now

Привязка к началу строки

Началу строки соответствует метасимвол (мнимый символ) ^. Чтобы шаблон к началу строки, надо задать этот символ в начале регулярного выражения. Например, вот так можно проверить, что текст не начинается с точки: $line = ".Hello!"; if($line=~m/^\./){ print "Shouldn't start a sentence with a period!\n"; } Shouldn't start a sentence with a period!

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

Привязка к концу строки

Чтобы привязать шаблон к концу строки, используется метасимвол (мнимый символ) $. В нашем примере мы используем привязку шаблона к началу и к концу строки, чтобы убедиться, что пользователь ввел только слово "exit": while(<>){ if(m/"exlt$/) {exit;} }

Поиск чисел

Для проверки того, действительно ли пользователь ввел число, можно использо-вать метасимволы \d и \D. Метасимвол \D соответствует любому символу, кроме цифр. Например, следующий код проверяет, действительно ли введенный текст представляет собой целое значение без знака и паразитных пробелов: $test = "Hello!"; if($text =~ /\D/){ print "It is not a number.\n"; } It is not a number. To же самое можно проделать, использовав метасимвол \d: $text = "333"; if($text =~ /^\d+$/){ print "It is a number.\n"; } It is a number.

Вы можете потребовать, чтобы число соответствовало привычному формату. То есть число может содержать десятичную точку, перед которой стоит по краййей мере одна цифра и, возможно, какие-то цифры после нее: $text= "3,1415926"; if($text =~ /^(\d+\.\d*|\d+)$/){ print "It is a number.\n"; } It is a number.

Кроме того, при проверке можно учитывать тот факт, что перед числом может стоять как плюс, так и минус (или пустое место): $text = "-2.7182"; if ($text =~ /^([+-]*\d+)(\.\d*|)$/) { print "It is a number.\n";

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

$text = "+0.142857142857142857"; if ($text =~ /^(+|-|)\d+(\.\d*\)$/) { print "It is a number.\n"; } It is a number.

Альтернативные шаблоны, если они присутствуют, проверяются слева направо. Перебор вариантов обрывается, как только найдено соответствие между текстом и шаблоном. Поэтому, например, порядок альтернатив в шаблоне (\.\d*|) мог бы стать критичным, если бы не привязка к концу строки. Наконец, вот как можно произвести проверку того, что текст является шестна-дцатеричным числом без знака и остальных атрибутов: $text = "1AO"; unless (ftext =~ m/^[a-fA-F\d]+$/) { print "It is not a hex number, \n"; }

Проверка идентификаторов

С помощью метасимвола \w можно проверить, состоит ли текст только из букв, цифр и символов подчеркивания (это те символы, которые perl называет словесными (word characters)): $text="abc"; if($text=~/^\w+$/){ print "Only word characters found. \n"; } Only word characters found.

Однако, если вы хотите убедиться, что текст содержит латинские буквы и несодержит цифр или символов подчеркивания, придется использовать другой шаблон: $text = "аbс"; if($text=~ /^[A-Za-z]+$/) { print "Only letter characters found.\n";} Qnly letter characters found.

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

$text = "X125c"; if($text=~ /^[A-Za-z]\w+$/) { print "This is identifier.\n";} This is identifier.

Как найти множественные совпадения

Для поиска нескольких вхождений шаблона можно использовать модификатор g. Следующий пример, который мы уже видели ранее, использует команду m/.../ с модификатором g для поиска всех входжений буквы x в тексте: $text="Here is texxxxxt"; while($text=~m/x/g){ print "Found another x.\n"; } Found another x. Found another x. Found another x. Found another x. Found another x.

Модификатор g делает поиск глобальным. В данном (скалярном) контексте perl помнит, где он остановился в строке при предыдущем поиске. Следующий поиск продолжается с отложенной точки. Без модификатора g команда m/.../ будет упорно находить первое вхождение буквы х, и цикл будет продолжаться бесконечно.

В отличие от команды m/.../ команда s/.../.../ с модификатором g выполняет глобальную замену за один раз, работая так, будто внутри нее уже имеется встроенный цикл поиска, подобный приведенному выше. Следующий пример за один раз заменяет все вхождения х на z: $text = "Here is texxxxxt."; $text =~ s/x/z/g; print $text; Here is tezzzzzt.

Без модификатора g команда s/.../.../ заменит только первую букву х. Команда s/.../.../ возвращает в качестве значения число сделанных подстановок, что может оказаться полезным: $text= "Here is texxxxxt."; print (text =~ s/x/z/g) 5 Поиск нечувствительных к регистру совпадений

Вы можете использовать модификатор i, чтобы сделать поиск нечувствительным к разнице между заглавными и строчными буквами. В следующем примере про-грамма повторяет на экране введенный пользователем текст до тех пор, пока не будет введено Q, или q (сокращение для QUIT или quit), после чего программа прекращает работу: while(<>){ chomp; unless (/^q$/i){ print } else { exit; } } Выделение подстроки

Чтобы получить найденную подстроку текста, можно использовать круглые скобки в теле шаблона. Если это более удобно, можно также использовать встроенную функцию substr. В следующем примере мы вырезаем из текстовой строки нужный нам тип изделия: $record = "Product number:12345 Product type: printer Product price: $325"; if($record=~/Product type:\s*([a-z]+)/i){ print "The product's type Is^$1.\n"; } product's type is printer.

Вызов функций и вычисление выражений при подстановке текста

Используя для команды s/.../.../ модификатор е, вы тем самым показываете, что правый операнд (то есть подставляемый текст) - это то выражение perl, которое надо вычислить. Например, с помощью встроенной функции perl uc (uppercase) можно заменить все строчные буквы слов строки на заглавные: $text = "Now is the time."; $text=~ s/(\w+)/uc($1)/ge; print $text; NOW IS THE TIME. Вместо функции uc($l) можно поместить произвольный код, включая вызовы программ.

Поиск n-го совпадения

С помощью модификатора g перебираются все вхождения заданного шаблона. Но то делать, если нужна вполне определенная точка совпадения с шаблоном, например, вторая или третья? Оператор цикла while в сочетании с круглыми cкобками, выделяющими нужный образец, поможет вам: $text = "Name:Anne Nanie:Burkart Name:Glaire Name: Dan"; while ($text =~ /Name: \s*(\w+)/g){ ++$match; print "Match number $match is $1.\n"; }

Match number 1 is Anne Match number 2 is Burkart Match number 3 is Claire Match number 4 is Dan

Этот пример можно переписать, используя цикл for:

$text = "Name:Anne Name:Burkart Name:Ciaire Name:Dan"; for ($match = 0; $text =~ /Name:\s*(\w+)/g; print "Match number ${\match} is $1.\n") {} Match nuwber 1 Is Anne Match number 2 is Burkart Match number 3 is Claire Match number 4 is Dan

Если же вам требуется определить нужное совпадение не по номеру, а по содержанию (например, по первой букве имени пользователя), то вместо счетчика $match можно анализировать содержимое переменной $1, обновляемой при каждом найденном совпадении. Когда требуется не найти, а заменить второе или третье вхождение текста, можно применить ту же схему, использовав в качестве тела цикла выражение perl, вызываемое для вычисления заменяющей строки: $text = "Name:Anne Name:Burkart Name:Claire Name:Dan"; $match =0; $text =~ s/(Name:\s*(\w+))/ # начинается код perl if (++$match == 2) # увеличить счетчик {"Name:John ($2)"}# вернуть новое значение else {$1} # оставить старое значение /gex; print $text; Name:Anne Name:John (Burkart) Name:ClaireName:Dan

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

Как ограничить "жадность" квантификаторов

По умолчанию квантификаторы ведут себя как "жадные" объекты. Начиная с текущей позиции поиска, они захватывают самую длинную строку, которой может соответствовать регулярное выражение, стоящее перед квантификатором. Алгоритм перебора с возвратами, используемый perl, способен ограничивать аппетит квантификаторов, возвращаясь назад и уменьшая длину захваченной строки, если не удалось найти соответствия между текстом и шаблоном. Однако этот механизм не всегда работает так, как хотелось бы. Рассмотрим следующий пример. Мы хотим заменить текст "That is" текстом "That's". Однако в силу "жадности" квантификатора регулярное выражение ".*is" сопоставляется фрагменту текста от начала строки и до последнего найденного "is": $text = "That is some text, isn't it?"; $text =~ s/.*is/That's/; print $texts; That'sn't it?

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

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

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

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

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

найдет все слова, стоящие между тегами <a></a> и <b></b>.

В регулярных выражениях пристутствует своя семантика: быстрота, торопливость и возврат. Если квантификатор * совпадает во многих случаях, то в результате быдет выведен наибольший по длинне результат. Это жадность. Быстрота: поиск старается найти как можно быстрее. "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%<f(.*?)><(.*?)"><(.*?)">%$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!<TABLE WIDTH="400" BORDER="0" CELLPADDING="0" CELLSPACING="0">(.*?)</TD></TR></TABLE>!igsm){ $file=$1; &getlink($page); foreach $names(@res){ $names=~s|.*/ig; $file=~s|src="http://(.*?)$names"|src=$imgurl/$names|igs; } $html=qq~ <TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"> $file </TD></TR></TABLE>~; } 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, "<page.html"; $page=<F>; close F; &getlink($page); ...

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

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

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

open F, "<file.txt"; $mass=<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, "<file"; while(<F>){ print if(3 .. 15) }

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

open F, "<file"; while(<F>){ print if(//i ... //i) }

Такая конструкция позволяет выводить куски многострочного html кода(для однострочного нужно ставить оператор ..).

Условия в таких операторах можно ставить и разнотипными $file=qr/2345/; while(<F>){ print if(/^$/ .. 10); #увидим, что находится от пустой до 10-й строки print if(/^\001/ .. /$file/); #выведет все, что после нуля и до того что задано qr }

Программа чтения почтовых адресов из mbox или sent-mail: while(<F>){ 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/, <F>;

что эквивалентно:

while (<F>) {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 <А> и <B>. Следующий пример позволяет выделять текст, расположенный между любыми правильно закрытыми метками:

$text = "<А>Here is an anct1or.</А>"; if($text=~m%<([A-Za-z]+)>[\w\s\.]+</\1>%i){ }

Вместо косой черты в качестве ограничителя шаблона использован другой символ. Это позволяет использовать символ косой черты внутри шаблона без предшествующей ему обратной косой черты. Каждому фрагменту шаблона, заключенному в круглые скобки, соответствует определенная внутренняя переменная. Переменные пронумерованы, так что на них можно ссылаться внутри шаблона, поставив перед номером обратную косую черту (\1, \2, \3,...). На значения переменных можно ссылаться внутри шаблона, как на обычный текст, поэтому </\1> соответствует </\A>, если открываю-щей меткой служит, и , если открывающей меткой служит .

Эти же самые внутренние переменные можно использовать и вне шаблона, ссылаясь на них как на скаляры с именами $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<font color=red>$3</font>$4..." while(m/(([\s,\.\n^]*\w*){$sn})(\s*$query\s*)(([\s,\.\n^]*\w+){$sn})/ig); } $_="";

Исходная задача состоит в следующем: вывести по 4 слова спереди и сзади результата поиска, причем так, чтобы если слово находится первым, то будет видно 4 слова позади него. В точности такое-же условие и для последнего слова.

Соответственно из вида регекспа понятно, что разделителями слов могут быть символы [\s,\.\n^]*, в том числе и символ перевода каретки ^. Комбинация (\d\d\d){$sn} значит что нужно найти 3 цифры три раза.