Perl регулярные выражения: преобразование http, ftp и mailto ссылок в теги HTML

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

Возьмем такой текст:

 Зайдите на www.cronc.com/ru.shtml и посмотрите список статей по Perl регулярным выражениям.
Здесь текст www.cronc.com/ru.shtml является ссылкой, несмотря на отсутствие протокола http://, который подразумевается по умолчанию. В итоге наше регулярное выражение должно преобразовать этот текст к такому виду:
 Зайдите на <a href="www.cronc.com/ru.shtml" target="_blank"> www.cronc.com/ru.shtml</a>
    и посмотрите список статей по Perl регулярным выражениям.

Может быть и так, что ссылка не отделена пробелом от окружающих слов или после нее идет знак препинания (точка, запятая и т.д.) Желательно, чтобы регулярное выражение это учитывало и не включало такой знак в ссылку. И конечно, оно не должно совпадать там, где ему совпадать не следует. Неплохо было бы, если бы оно также форматировало текст ссылки href: протокол, домен и субдомены должны быть записаны строчными буквами. А сам текст, который будет виден на странице, должен оставаться таким, каким его ввёл участник форума. Задача эта непростая и не формализуется. Критерием успешности регулярного выражения является то, как оно справляется с набором тестов, которые провоцируют его к несовпадению или совпадению не в тех местах.

Это регулярное выражение достаточно сложное и громоздкое, и мы будем создавать его по частям. Начнем с протокола.
Протокол может быть http, https и ftp. Для его обнаружения создадим строковую переменную $protocol:

my $protocol='(?:(?=[FfHh])(?i:http(?>s?)|ftp)://)';

Если в тексте следующий символ F, f, H или h, то этот подшаблон делает проверку следующих за ним символов и, если это протокол, поглощает его вместе с префиксом. Я взял весь шаблон для протокола в скобки, потому что в общем регулярном выражении у этого подшаблона может стоять квантификатор, который должен относиться ко всему этому подшаблону, а не к последнему его символу /.

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

my $host=<<HOST;
   (?>[A-Za-z0-9]{1,63}\\.)
        (?>[A-Za-z0-9]
             (?>[-A-Za-z0-9]{0,62})\\.
         )*
HOST

Эта запись соответствует последовательности имен, разделенных точками, или IP-адресу, она в том числе поглотит префикс www. Также учтено, что длина одного имени (от точки до точки) не может быть больше 63 символов. Обратите внимание на два обратных слэша перед точками. Подобная запись содержимого переменной (here doc) транслируется как строка в двойных кавычках. В таких строках обратный слэш является метасимволом.

Поэтому, чтобы записать его в такой строке один раз, его надо повторить дважды. Если распечатать переменную $host, то мы увидим по одному обратному слэшу перед точками.

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

Для поддоменов запишем такой шаблон:

my $subdom='(?:(?>[A-Za-z0-9](?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?)\\.)+';

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

Введем вспомогательный подшаблон, который будет повторяться в других подшаблонах:

my $wb='(?![A-Za-z0-9])';

Он означает, что справа не должно быть ни буквы, ни цифры.

Для зоны (это может быть com, net, org, ru, de, name, museum, co.uk:) имеется такой подшаблон:

my $zone=<<ZONE;
   (?i:(?(?=[a-z]{3}$wb)(?>com|net|org|edu|biz|gov|int|mil)|
            (?(?=[a-z]{2}$wb)[a-z]{2}|
             (?(?=[a-z]{4}$wb)(?>info|aero|name)|
              (?(?=[a-z]{6}$wb)museum|(?!)
              )
             )
            )
         )
         (?>\\.[a-z]{2}$wb)?)
ZONE

После имени хоста через двоеточие может идти порт:

my $port="(?::\\d{1,5}$wb)";

А после зоны может идти хвост, который содержит множество всяких параметров, передаваемых с URL:

my $tail=<<TAIL;
   (?:[/?]
      (?>[^.,"'<>()[\\]{}\\s\\x7F-\\xFF]*)
      (?:(?>[.,?]+)
         (?:[^"'<>()[\\]{}\\s\\x7F-\\xFF]+)
         )*
      (?<![,.?!-])
   )
TAIL

В конце стоит заглядывание назад

(?<![,.?!-])

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

Все регулярное выражение для поиска URL в тексте выглядит немного страшновато:

my $re=<<RE;
   (
      (?>($protocol)(?(2)(?>$host$zone)|$host$zone)
         (?![A-Za-z0-9])|
         (?<![A-Za-z0-9_\\\@-])
         (?<!\\.(?!(?i:www)))
         $subdom$zone(?![A-Za-z0-9_.-]*\\\@)
      )
         (?>(?>$port?(?>\\\@$host$zone(?![A-Za-z0-9_.-]*\\\@))?)?)
   )
      ($tail?)
RE

Это выражение учитывает заход через прокси-сервер вида http://proxy.com@site.com/

Часть URL от начала до хвоста, который может идти после символов / или ?, мы берем в нумерованную переменную $1. Эту часть URL внутри тега <a мы будем выводить маленькими буквами, а для отображения на странице будем выводить в том виде, в котором ее ввел автор сообщения. Протокол мы возьмем в переменную $2. Если протокола нет, то при форматировании ссылки мы подставим на его место текст http://. Хвост $tail мы захватываем в переменную $3.

Внутри переменной $re встречается эскейп-последовательности \@. Но т.к. внутри текста here doc \ и @ являются метасимволами, то, чтобы в результате получить последовательность \@, надо написать \\\@. Тогда при обработке такого текста \\ превратится в \, а \@ превратится в @, и в конце получится нужная последовательность \@. Для проверки напечатайте переменную $re.

Программа должна "подсвечивать" ссылки в тексте. Например, имеем текст

 Look at:aaa.Museum.

Это должно превратиться в

 Look at:<a href="aaa.museum" target="_blank">aaa.Museum</a>.

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

Возьмем в качестве тестового такой текст:

my $text=<<TEXT;
URLs:
Ftp://a.com/AAa
Look at:aaa.Museum.
http://www.proxy.com:80\@www.site.com/
http://proxy.com:80\@site.com/
http://proxy.com\@site.com/
aAaa.com.au.rr.ggg
Zwww.Yahoo.co.uk
Фforum.abcd.de
www.Abc.eu
П123.123.123.1234.com/?q=aaa
http://Abc.Tk
Ahttp://www.Abc.pt/AAa
http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image
Ф.Www.old-avto.tk

NOT URLs:
aaa.museumm
http://aaa.museumm,
http://-aaa.com
www._aaa.com
www.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com
TEXT

Как же мы будем форматировать найденный текст? Одним оператором s///. Можно применить вариант с модификатором e, а можно обойтись без него, но тогда в выражении для замены надо будет использовать интерполяцию кода Perl в строку.

Этот оператор подстановки выглядит так:

$text =~ s!$re!<a href="${\($2 ? '' : 'http://')} \L$1\E$3" target="_blank">$1$3</a>!gx;

Регулярное выражение для поиска $re уже составлено, остается сформировать строку для замещения найденного URL. Мы не можем в этой строке замещения сделать конкатенацию вида ":".$var1.":".$var2:, потому что в нем участвует строка без символов-ограничителей строки. Поэтому уже знакомой конструкцией ${\( код Perl ) мы вставляем протокол с помощью тернарного оператора

$2 ? '' : 'http://'

Если протокол в URL был задан, то мы вставляем то, что задано, если не задан, то вставляем http://. Дальше вставляем часть URL без хвоста ($1), предварительно сделав в нем все буквы строчными. За ней идет хвост $3. А в тексте, что будет виден на HTML-странице, будет фигурировать то, что вводил пользователь: $1$3.

Вот вся наша программа:

#!/usr/bin/perl -w
use strict;

my $protocol='(?:(?=[FfHh])(?i:http(?>s?)|ftp)://)';

my $host=<<HOST;
   (?>[A-Za-z0-9]{1,63}\\.)
     (?>[A-Za-z0-9]
      (?>[-A-Za-z0-9]{0,62})\\.
     )*
HOST

my $subdom=<<SUBDOM;
   (?:
      (?>[A-Za-z0-9]
         (?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?
      )\\.
   )+
SUBDOM

my $wb='(?![A-Za-z0-9])';

my $zone=<<ZONE;
   (?i:(?(?=[a-z]{3}$wb)(?>com|net|org|edu|biz|gov|int|mil)|
            (?(?=[a-z]{2}$wb)[a-z]{2}|
                 (?(?=[a-z]{4}$wb)(?>info|aero|name)|
                    (?(?=[a-z]{6}$wb)museum|(?!)
                 )
               )
            )
         )
         (?>\\.[a-z]{2}$wb)?
   )
ZONE

my $port="(?::\\d{1,5}$wb)";

my $tail=<<TAIL;
   (?:[/?]
      (?>[^.,"'<>()[\\]{}\\s\\x7F-\\xFF]*)
      (?:(?>[.,?]+)
         (?:[^"'<>()[\\]{}\\s\\x7F-\\xFF]+)
         )*
      (?<![,.?!-])
   )
TAIL

my $re=<<RE;
   (
      (?>($protocol)(?(2)(?>$host$zone)|$host$zone)
         (?![A-Za-z0-9])|
         (?<![A-Za-z0-9_\\\@-])
         (?<!\\.(?!(?i:www)))
         $subdom$zone(?![A-Za-z0-9_.-]*\\\@)
      )
         (?>(?>$port?(?>\\\@$host$zone(?![A-Za-z0-9_.-]*\\\@))?)?)
   )
      ($tail?)
RE

my $text=<<TEXT;
URLs:
Ftp://a.com/AAa
Look at:aaa.Museum.
http://www.proxy.com:80\@www.site.com/
http://proxy.com:80\@site.com/
http://proxy.com\@site.com/
aAaa.com.au.rr.ggg
Zwww.Yabcd.co.uk
Фforum.abcd.de
www.Abc.eu
П123.123.123.1234.com/?q=aaa
http://Abc.Tk
Ahttp://www.Abc.pt/AAa
http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image
Ф.Www.old-avto.tk

NOT URLs:
aaa.museumm
http://aaa.museumm,
http://-aaa.com
www._aaa.com
www.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com
TEXT

$text =~ s!$re!<a href="${\($2 ? '' : 'http://')}\L$1\E$3" target="_blank">$1$3</a>!gx;
print $text;

А вот текст, который она печатает:

URLs:
<a href="ftp://a.com/AAa" target="_blank">Ftp://a.com/AAa</a>
Look at:<a href="http://aaa.museum" target="_blank">aaa.Museum</a>.
<a href="http://www.proxy.com:80@www.site.com/"
    target="_blank">http://www.proxy.com:80@www.site.com/</a>
<a href="http://proxy.com:80@site.com/" target="_blank">http://proxy.com:80@site.com/</a>
<a href="http://proxy.com@site.com/" target="_blank">http://proxy.com@site.com/</a>
<a href="http://aaaa.com.au.rr" target="_blank">aAaa.com.au.rr</a>.ggg
<a href="http://zwww.yabcd.co.uk" target="_blank">Zwww.Yabcd.co.uk</a>
Ф<a href="http://forum.abcd.de" target="_blank">forum.abcd.de</a>
<a href="http://www.abc.eu" target="_blank">www.Abc.eu</a>
П<a href="http://123.123.123.1234.com/?q=aaa" target="_blank">123.123.123.1234.com/?q=aaa</a>
<a href="http://abc.tk" target="_blank">http://Abc.Tk</a>
A<a href="http://www.abc.pt/AAa" target="_blank">http://www.Abc.pt/AAa</a>
<a href="http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image"
    target="_blank">http://abc.au/query/vid.cam.dig/sony.dcrhc15.htm#full_image</a>
Ф.<a href="http://www.old-avto.tk" target="_blank">Www.old-avto.tk</a>

NOT URLs:
aaa.museumm
http://aaa.museumm,
http://-aaa.com
www._aaa.com
www.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com

Две строки не уместились по ширине страницы и перенесены на следующие строки со отступом.

Обратите внимание, как преобразуется в URL строка

 aAaa.com.au.rr.ggg

Получается

 <a href="http://aaaa.com.au.rr" target="_blank">aAaa.com.au.rr</a>.ggg

.ggg не считается частью URL. Количество последовательностей символов через точку ограничено, чтобы не захватить в URL следующий за ним текст. Это интуитивное ограничение.

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

 http://www.proxy.com:80@www.site.com/

может трактоваться неоднозначно из-за наличия в ней символа @. Если мы сначала будем искать адреса электронной почты, то программа может "найти" такой e-mail:

 80@www.site.com

Конфликт также может возникнуть со ссылками вида

 ftp://login:passw@a-aa.com/www/

Чтобы устранить этот конфликт, перепишем регулярные выражения для поиска URL и добавим к ним регулярное выражение для поиска e-mail. Форматировать ссылки будем несколькими операторами подстановки, т.к. для одного оператора эта задача слишком сложна.

Вот текст всей этой программы:

#!perl -w
use strict;

my $wb='(?![A-Za-z0-9])';

my $protocol='(?:(?=[FfHh])(?i:http(?>s?)|ftp)://)';

my $host=<<HOST;
   (?>[-A-Za-z0-9_]{1,63}\\.)
      (?>[A-Za-z0-9_]
      (?>[-A-Za-z0-9_]{0,62})\\.
   )*
HOST

my $subdom=<<SUBDOM;
   (?:
      (?>[A-Za-z0-9]
         (?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?
      )\\.
   )+
SUBDOM

my $subdom1='[A-Za-z0-9](?:[-A-Za-z0-9]{0,61}[A-Za-z0-9])?';

my $zone=<<ZONE;
   (?i:
       (?=[a-z]{3}$wb)
          (?>com|net|org|edu|biz|gov|int|mil)|
             (?(?=[a-z]{2}$wb)[a-z]{2}|
             (?(?=[a-z]{4}$wb)(?>info|aero|name)|
             (?(?=[a-z]{6}$wb)museum|(?!)
             )
          )
        )
      (?>\\.[a-z]{2}$wb)?
   )
ZONE

my $port="(?::\\d{1,5}$wb)";

my $tail=<<TAIL;
   (?:[/?]
         (?>[^.,"'<>()\\[\\]{}\\s\\x7F-\\xFF]*)
         (?:
            (?>[.,?]+)
            (?:[^"'<>()\\[\\]{}\\s\\x7F-\\xFF]+)
         )*
         (?<![,.?!-])
   )
TAIL

my $firstchr='(?:[A-Za-z0-9])';

my $namechr='(?:[A-Za-z0-9_+.-])';

my $ip='(?:(?<!\\d)(?>\\d{1,3})\\.(?>\\d{1,3})\\.(?>\\d{1,3})\\.(?>\\d{1,3})(?!\\d))';

 # Login и passw ограничены 32 символами
my $loginpasswat='(?:(?>[A-Za-z0-9_]{1,32})(?>(?::[A-Za-z0-9_]{1,32})?)\\@)';

my $res;

$_=q(http://www.proxy.com:80@www.site.com/
Ftp://a.com/AAa
Ftp://Login:Passw@Www.Aaa.Com/Www/
Ftp://login:passw@a-aa.com/www/
Mailto:aaa@sss.zzz.co.
Mailto:aaa@sss.zzz.eee.co.
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com
ыы@ddd.com
ыы@ddЫd.com
ыыsы-sf.ff.com.com@ddd.com
ыыsы.-sf.ff@ddd.com
Mailto:aaa@sss.co,
aaa@sss.comЫЫЫ
aaa.Bb.b@aaaa.com.ru.rr.ggg
aaa.museumm
Look at:aaa.museum.
httpS://aaa.museumm,
http://www.p.com:80@www.s.com/
http://proxy.com:80@site.com/
http://proxy.com@site.com/
aAaa.com.ru.rr.ggg
Zwww.Yabcd.co.uk
Фforum.abcde.ru
www.Eabcd.ru
http://Eabcd.Ru
Ahttp://www.Eabcd.ru/AAa
http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image
Ф.Www.abcdefg-avto.ru
httP://1.2.3.400/aaa/ddd.exe?
1.2.3.400/a/d.exe?d=c,f=t;&e=h,
.0.2.3.400.
http://66.123.234.555/ddd
michel@ab-cdefg.ru
http://99.999.999.999/search?q=cache:w5K:ol.soft.com/c-man.doc+c-man&hl=ru&client=firefox-a);

 # Оформляем ссылки без login:passw
s#((?>($protocol)(?(2)(?>$ip|$host$zone)|$host$zone)(?![A-Za-z0-9])|(?<![A-Za-z0-9_\@-])
 (?<!\.(?!(?i:www)))$subdom$zone(?![A-Za-z0-9_.-]*\@))(?>(?>$port?(?>\@$host$zone
 (?![A-Za-z0-9_.-]*\@))?)?))($tail?)#
 $res=$2 ? '' : 'http://'; qq!<a href="$res\L$1\E$3" target="_blank">$1$3</a>!#gex;
 #  Оформляем ссылки с login:passw
s#($protocol)($loginpasswat)($ip|$host$zone)((?>$port?)$tail?)#<a href=\"\L$1\E$2\L$3\E$4
 \" target=\"_blank\">$1$2$3$4</a>"#gx;
 # Оформляем имейлы. Этот оператор чувствителен к тексту, на который меняет предыдущие операторы!
s#((?<!$firstchr)$firstchr(?>$namechr{0,39})\@(?>$subdom1)(?:\.$subdom1)?\.$zone)
 (?!(?>[^\s"<]*)(?:"\starget="_blank">|</a>))#<a href="mailto:$1">$1</a>#gx;
 # Оформляем ссылки с IP
s#((?<![>/])$ip(?>$port?))($tail?)#"<a href=\"http://\L$1\E$2\" 
target=\"_blank\">$1$2</a>"#gx;

print $_;

Операторы замены такие длинные, что пришлось их разбивать на несколько строк. А вот результат работы данной программы:

<a href="http://www.proxy.com:80@www.site.com/" target="_blank">http://www.proxy.com:
    80@www.site.com/</a>
<a href="ftp://a.com/AAa" target="_blank">Ftp://a.com/AAa</a>
<a href="ftp://Login:<a href="mailto:Passw@www.aaa.com">Passw@www.aaa.com</a>/Www/
    " target="_blank">Ftp://Login:Passw@Www.Aaa.Com/Www/</a>"
<a href="ftp://login:<a href="mailto:passw@a-aa.com">passw@a-aa.com</a>/www/
    " target="_blank">Ftp://login:passw@a-aa.com/www/</a>"
Mailto:<a href="mailto:aaa@sss.zzz.co">aaa@sss.zzz.co</a>.
Mailto:aaa@sss.zzz.eee.co.
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@aaa.com
ыы@ddd.com
ыы@ddЫ<a href="http://d.com" target="_blank">d.com</a>
ыыsы-<a href="mailto:sf.ff.com.com@ddd.com">sf.ff.com.com@ddd.com</a>
ыыsы.-<a href="mailto:sf.ff@ddd.com">sf.ff@ddd.com</a>
Mailto:<a href="mailto:aaa@sss.co">aaa@sss.co</a>,
<a href="mailto:aaa@sss.com">aaa@sss.com</a>ЫЫЫ
<a href="mailto:aaa.Bb.b@aaaa.com.ru.rr">aaa.Bb.b@aaaa.com.ru.rr</a>.ggg
aaa.museumm
Look at:<a href="http://aaa.museum" target="_blank">aaa.museum</a>.
httpS://aaa.museumm,
<a href="http://www.p.com:80@www.s.com/" target="_blank">http://www.p.com:80@www.s.com/</a>
<a href="http://proxy.com:80@site.com/" target="_blank">http://proxy.com:80@site.com/</a>
<a href="http://proxy.com@site.com/" target="_blank">http://proxy.com@site.com/</a>
<a href="http://aaaa.com.ru.rr" target="_blank">aAaa.com.ru.rr</a>.ggg
<a href="http://zwww.yabcd.co.uk" target="_blank">Zwww.Yabcd.co.uk</a>
Ф<a href="http://forum.abcde.ru" target="_blank">forum.abcde.ru</a>
<a href="http://www.eabcd.ru" target="_blank">www.Eabcd.ru</a>
<a href="http://eabcd.ru" target="_blank">http://Eabcd.Ru</a>
A<a href="http://www.eabcd.ru/AAa" target="_blank">http://www.Eabcd.ru/AAa</a>
<a href="http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image" target="_blank">
    http://abc.ru/query/vid.cam.dig/sony.dcrhc15.htm#full_image</a>
Ф.<a href="http://www.abcdefg-avto.ru" target="_blank">Www.abcdefg-avto.ru</a>
<a href="http://1.2.3.400/aaa/ddd.exe" target="_blank">httP://1.2.3.400/aaa/ddd.exe</a>?
    "<a href="http://1.2.3.400/a/d.exe?d=c,f=t;&e=h" 
    target="_blank">1.2.3.400/a/d.exe?d=c,f=t;&e=h</a>",
    ."<a href="http://0.2.3.400" 
target="_blank">0.2.3.400</a>".
<a href="http://66.123.234.555/ddd" target="_blank">http://66.123.234.555/ddd</a>
<a href="mailto:michel@ab-cdefg.ru">michel@ab-cdefg.ru</a>
<a href="http://99.999.999.999/search?q=cache:w5K:ol.soft.com/c-man.doc+c-man&hl=ru&
    client=firefox-a" target="_blank">http://99.999.999.999/search?q=cache:w5K:ol.soft.com/
    c-man.doc+c-man&hl=ru&client=firefox-a</a>

Как видим, в этом тестовом тексте программа в основном правильно отделила e-mail ссылки от остальных ссылок. Ошибки отмечены красным цветом. Т.к. на форумах вряд ли будут даваться ссылки ftp с логином и паролем, то работу нашей программы можно считать удовлетворительной. Perl регулярные выражения