Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: разработка для Web > регулярные выражения

Автор: Гость_Андрей 5.7.2005, 07:29

Подскажите при помощи каких регулярных выражений можно сотворить следующее имеем некий html текст в нем имеется строка: ........<div class=type><b>Relib</b><a name="Relib">..........-> ->..........</table></td><td></td></tr>....................... каким выражением мне их вырезать в пределах от: <div class=type><b>Relib</b><a name="Relib"> до: </table></td><td></td></tr> Заранее Спасибо за подсказочки

Автор: chaos 5.7.2005, 07:53

сдесь наверное лутше воспользоваться index Добавлено @ 07:55 или каким-нибудь HTML paresr'ом

Автор: Burdin 5.7.2005, 08:44

непонял!!!! если можно то поподробней

Автор: korob2001 5.7.2005, 09:00

А я не понял, что именно нужно вырезать???

Автор: Burdin 5.7.2005, 09:08

имеем html файл в нем надо вырезать ту информацию которая находится в промежутке от: <div class=type><b>Relib</b><a name="Relib"> до: </table></td><td></td></tr> и содержимое которое находится между этими данными нужно сохранить и работать с ними дальше

Автор: korob2001 5.7.2005, 09:21

Вообще-то было бы не плохо знать, что мы ищем, текст, цифры и т.п. Вот такой вариант попробуй: Код #!/usr/bin/perl -w use strict; my $str = '<div class=type><b>Relib</b><a name="Relib">Результат1</table></td><td></td></tr><table>            <div class=type><b>Relib</b><a name="Relib">Результат2</table></td><td></td></tr>'; my @res = (); $str =~ s/<div class\=type><b>Relib<\/b><a name=\"Relib\">(.*?)<\/table><\/td><td><\/td><\/tr>/push(@res, $1)/egi; print join("\n", @res); В результате массив @res, будет иметь все подстроки, которые находятся между теми тегами, которые ты указал.

Автор: Usya 5.7.2005, 18:59

Кстати, посмотри еще http://www.webcode.ru/re/table/ Думаю, что пригодится

Автор: Burdin 6.7.2005, 00:48

Пасиба!!!

Автор: SantaXP 7.7.2005, 00:17

Разу уж тема так называется, то не стал создавать отдельную тему. ---- Мне крайне нужно создать проверку переменных ($nick, $password, $repeat_password, $email) на наличие лишь знаков a-zA-z и 0-9 (в случае с $email + @) при скрипте регистрации посетителя, но поскольку я в регулрных выражениях вечно путаюсь, то ничего толкового сделать не могу. Не мог ли бы вы мне помочь???

Автор: Burdin 7.7.2005, 00:59

Код if ($form_email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ || $form_email !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) { $retyrn="Email неверный!!!"; } $field =~ /[^a-zA-Z0-9_-]/ #проверяет на наличиие латинского алфавита, цифр и знаков `_' и `-' Добавлено @ 01:04 Код # А эти символы лучше вырезать $post{$field} =~ S/[\&;\`'\\\|"*?~<>^\(\)\[\]\{\}\$\n\r\0]///ig;

Автор: korob2001 7.7.2005, 02:26

Зачем так много скобок? Ты же не используешь эти переменные.

Автор: Usya 7.7.2005, 07:52

Кстати, можно и топорным способом через временную переменную (чтоб не портить первоначальную): Код $e=~tr/a-zA-Z0-9/k/s; Результат либо "k" (для простой переменной), либо "k@k.k" или "k@k.k.k" для мыла... Должно сработать

Автор: sharq 7.7.2005, 18:43

SantaXP вот собственно: Код            $value = trim($value);            $value = unHTML($value);         # проверка поля на пустоту         if (!$value && $req) {             $comm = 2;             $check_errors = 1;         }         # если поле заполнено         if ($value) {             # определение типа проверки             if (($name eq 'login') or ($name eq 'pass') or ($name eq 'pass2')) {                 $flag = 1;             } elsif ($f->{name} eq 'email') {                 $flag = 2;             } else {                 $flag = undef;             }             # проверка поля на наличие определенных символов             if (check_symbol($value, $flag)) {                 $comm = 3;                 $check_errors = 1;             }             # проверка первого символа             if (check_first_symbol($value, $flag)) {                 $comm = 4;                 $check_errors = 1;             }             # проверка длины слова             if (!check_word($value, $max)) {                 $comm = (!$max) ? 5 : 6;                 $check_errors = 1;             }             # проверка уникальности логина             if ($name eq 'login') {                 if (get_item($dbh, $value, 'login', 'regestry') or                     get_item($dbh, $value, 'login', 'temp_regestry') ) {                     $comm = 1;                     $check_errors  = 1;                 }             }             # сравнение двух паролей             $pass = $value if $name eq 'pass';             if ($name eq 'pass2') {                 if (!Tools::check_compare($pass, $value)) {                     $comm = 1;                         $check_errors  = 1;                 }             }             # проверка электронного адреса: пользователь@имя.хоста             if ($name eq 'email') {                 if (!check_email($value)) {                     $comm = 1;                     $check_errors = 1;                 }             }         } # конец всех проверок Здесь $req - флаг, определяющий, что поле является необходимым для отображения, $comm = номер сообщения об ошибке, $check_errors - флаг, определяющий наличие ошибок. $name - название поля, $value - значение поля. Функция get_item - выбирает записи из БД. Вот функции: Код # функция удаления лишних пробелов в начале и в конце sub trim($) {     my $str = shift;     $str =~ s/^\s+//; # удаление пробелов в начале слова     $str =~ s/\s+$//; # удаление пробелов в конце слова     return $str; } # замена html sub unHTML($) {     my $text = shift;     # экранирование html     my %ENT=('<'=>'lt','>'=>'gt','"'=>'quot');     $text =~ s!([<>"])!&$ENT{$1};!g;     $text =~ s|\&lt;!--|<!--|g;     $text =~ s|--\&gt;|-->|g;     # обработка \n, \r, \s     $text =~ s|\n|[br]|g;     $text =~ s|\r||g;     $text =~ s|\s+| |g;     # экранирование стоп-символов     $text =~ s|\@|{et}|g;     $text =~ s!\|!|!g;     $text =~ s|\{|{|g;     $text =~ s|\}|}|g;     $text =~ s|\(|(|g;     $text =~ s|\)|)|g;     $text =~ s|\[|]|g;     $text =~ s|\[|]|g;     $text =~ s|\.|.|g;     $text =~ s|\,|,|g;     $text =~ s|\~|~|g;     $text =~ s|'|'|g;     $text =~ s|\?|?|g;     $text =~ s|\+|+|g;     $text =~ s|\#|#|g;     $text =~ s|^\$+$|& # 3 6 \;|g;     $text =~ s|\$|& # 3 6 \;|g;     $text =~ s|\&|& # 3 8 \;|g;     $text =~ s|\*|& # 8 7 2 7 \;|g;     $text =~ s|\^|& # 7 1 0 \;|g;     return $text; } # функция проверки наличия определенных символов sub check_symbol($$) {     my ($str, $flag) = @_;     if ($flag == 1) {         return ( $str =~ /[^A-Za-z0-9_]/ ); # проверка слов типа login     }     elsif ($flag == 2) {         return ( $str =~ /[^A-Za-z0-9\@_\.\-]/ ); # проверка слов типа email     }     else {         return ( $str =~ /[^A-Za-zА-Яа-я0-9_\.\-\s]/ ); # проверка любых слов     } } # функция проверки первого символа sub check_first_symbol($$) {     my ($str, $flag) = @_;     ($flag) ? return ( substr($str, 0, 1) =~ /_|\.|\-/ ) # проверка "_", ".", "-"                : return ( substr($str, 0, 1) =~ /[^A-Za-zА-Яа-я]/ ); # проверка "не буква" } # функция проверки длины слова sub check_word($$) {     my ($str, $flag) = @_;     my $str_length = length($str);     my $max_length = (!$flag) ? $word_max_size : $word_max2_size;     return ( ($str_length >= $word_min_size)and($str_length <= $max_length) ); } # функция, которая сравнивает два значения sub check_compare($$) {     my ($value1, $value2) = @_;     return ( $value1 eq $value2 ); } # функция проверки электронного адреса: пользователь@имя.хоста sub check_email($) {     my $str = shift;     return ( $str =~ /^[a-zA-Z_\.\-\d]+\@[a-zA-Z\.\-\d]+\.[a-zA-Z]{2,4}$/ ); }

Автор: SantaXP 7.7.2005, 23:48

Burdin Спасибо. Пример с e-mail работает, а вот выражение с проверкой на различные символы, которые нужно вырезать написано неправильно, ибо выдаёт у меня ошибку. ---------- sharq Спасибо огромное за проделанную вами работу, но вычленяя из написанного вами нужное мне я немного запутался. Ибо мне надо лишь выражение, чтобы в логине и пароле кроме a-zA-Z0-9_ ничего не было, а когда я пишу: Код #это только проверка $nick (он же логин) if (($nick =~ /^[a-zA-Z0-9_]/) {print qq( <td align="center" width=67%> All in normal! </td>);} else {print qq( <td align="center" width=67%> Go fuck yourself! </td>);} то он лишь проверяет, чтобы один из знаков написаееых выше попадался ему на глазе, а мне надо, чтобы там были только эти знаки, а вот как это сделать понять пока не могу...

Автор: sharq 8.7.2005, 00:11

SantaXP сравни две строки Цитата(sharq @ 7.7.2005, 18:43) $str =~ /[^A-Za-z0-9_]/ Цитата(SantaXP @ 7.7.2005, 23:48) $nick =~ /^[a-zA-Z0-9_] Видишь разницу - она большая!!! Твой случай проверяет, чтобы логин начинался с символа приведенного множества... Почитай основы регулярных выражений, например, в книге Изучаем Perl/ Реально, ничего сложного там нет.

Автор: Burdin 8.7.2005, 00:53

SantaXP у тебя выдает ошибку потому-что Код if (($nick =~ /^[a-zA-Z0-9_]/)     #^^^^^^^ убери одну скобку ( {print qq(     <td align="center" width=67%>     All in normal!     </td>);}     else     {print qq(     <td align="center" width=67%>     Go fuck yourself!     </td>);}

Автор: korob2001 8.7.2005, 05:02

Цитата у тебя выдает ошибку потому-что SantaXP - Потому что, нужно писать читабельный код, что бы в нём разобраться, ниже я отформатировал твой код, теперь сравни: В каком варианте код легче читать да и вообще поддерживать его? В данном коде: Код if ( $nick =~ /^[a-zA-Z0-9_]/ ) {      print qq(<td align="center" width="67%">All in normal!</td>); } else {      print qq(<td align="center" width=67%>Go fuck yourself!</td>); } вообще нужно написать это выражение так: Код /^[a-zA-Z0-9_]+$/ У него же условие стоит такое: если строка состоит из данных символов, все ОК, если нет - проблема. Потому отрицание здесь не нужно, а так же необходим +, так как мы же проверяем не только первый символ, для полноты ещё и символ конца строки. Удачи.

Автор: Burdin 8.7.2005, 05:09

а как тогда проверить на все запрещенные символы

Автор: korob2001 8.7.2005, 05:09

Код $nick !~ /^[a-zA-Z0-9_]+$/ Если встретятся символы, которые мы не указали, условие вернёт TRUE, значит ошибка. Т.е. если бы у него была проверка такого плана: если в строке обнаружен недопустимый символ, значит ОШИБКА, если в строке все символы допустимы - значит всё ОК. Тогда это условие будет выглядеть так: Код if ( $nick !~ /^[a-zA-Z0-9_]+$/ ) {      print qq(<td align="center" width="67%">Go fuck yourself!</td>); } else {      print qq(<td align="center" width="67%">All in normal!</td>); } В его же случае оно должно выглядеть так: Код if ( $nick =~ /^[a-zA-Z0-9_]+$/ ) {      print qq(<td align="center" width="67%">All in normal!</td>); } else {      print qq(<td align="center" width="67%">Go fuck yourself!</td>); }

Автор: Burdin 8.7.2005, 05:31

ну и что получается в твоем варианте пропускает а в моем нет Код #!/usr/bin/perl $nick ="ssвася иди тыqwe"; # твой if ( $nick =~ /^[^a-zA-Z0-9_]+$/ ) {      print qq(Go fuck yourself!\n); } else {      print qq(All in normal!\n); } #мой if ( $nick =~ /[^a-zA-Z0-9_]/ ) {      print qq(Go fuck yourself!\n); } else {      print qq(All in normal!\n); } Вот ответ: Код All in normal! Go fuck yourself!

Автор: korob2001 8.7.2005, 05:32

Уже подправил, посмотри последнее сообщение ещё раз.

Автор: korob2001 8.7.2005, 05:48

Хотя наверное отрицание, будет выглядеть более разумным если записатьего так: Код #!/usr/bin/perl -w use strict; my $nick = "45gfd,45fd_"; unless ( $nick =~ /^[a-zA-Z0-9_]+$/ ) {      print qq(<td align="center" width="67%">Go fuck yourself!</td>); } else {      print qq(<td align="center" width="67%">All in normal!</td>); } Теперь если отрицание не нужно, достаточно только заменить unless на if

Автор: Burdin 8.7.2005, 05:53

ну вот ты мне обьясни на этом примере??? Код #!/usr/bin/perl     $nick ="ssвася иди тыqwe";     # твой     if ( $nick =~ /^[a-zA-Z0-9_]+$/ ) {          print qq(Go fuck yourself!\n);     } else {          print qq(All in normal!\n);     }     #мой     if ( $nick =~ /[^a-zA-Z0-9_]/ ) {          print qq(Go fuck yourself!\n);     } else {          print qq(All in normal!\n);     } почему в первом говорит All in normal! а во втором Go fuck yourself!

Автор: korob2001 8.7.2005, 07:04

Код #!/usr/bin/perl $nick ="ssвася иди тыqwe"; # Здесь проверка на то, что все символы в строке должны быть либо цифрами, либо символами латинского алфавита, # либо символами подчеркивания, таких символов может быть сколько угодно, но как минимум 1. # Так как в строке есть символы пробела и кирилица, значит условие будет ЛОЖНЫМ, # потому выполняется блок ELSE. По идее, при данной проверке в блоке ELSE и в блоке IF нужно поменять местами строки. if ( $nick =~ /^[a-zA-Z0-9_]+$/ ) {      print qq(Go fuck yourself!\n); } else {      print qq(All in normal!\n); } # Здесь ты проверяешь, что $nick содержит не символы латиского алфавит, не символы подчёркивания и не цифры # такак как в строке есть символы пробела и кирилица, значит твоё условие вернёт TRUE и выполнится блок IF if ( $nick =~ /[^a-zA-Z0-9_]/ ) {      print qq(Go fuck yourself!\n); } else {      print qq(All in normal!\n); }

Автор: sharq 8.7.2005, 09:42

Что-то вы здесь пургу развели... Что это за логин: с пробелами и русскими буквами??? Хотя смотря какая задача стоит... Вот аффтору нужно наличие только латинских букв, цифр и _. Всё! Никаких пробелов и русских букв тем более!!! Для логина и пароля: Код $nick =~ /[^a-zA-Z0-9_]/ Для мыла я уже писал, еще раз: Код $email =~ /^[a-zA-Z_\.\-\d]+\@[a-zA-Z\.\-\d]+\.[a-zA-Z]{2,4}$/ Какие еще могут быть проблемы?

Автор: korob2001 8.7.2005, 15:08

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

Автор: SantaXP 8.7.2005, 23:32

sharq Хе... Именно её я и перечитываю постоянно... Спасибо...

Автор: sharq 9.7.2005, 00:13

А я читаю и понять не могу, о чем посты. SantaXP разабрался?

Автор: korob2001 9.7.2005, 08:08

sharq - смысл у этих постов ничуть не меньше, чем в тех постах, конторые написал ты. Про E-mail я вообще молчу, потому как следующие адреса, твоё выражение очень даже пропустит: ............@................ru ---------@................ru ----------@------------ru

Автор: sharq 9.7.2005, 13:16

korob2001 да спасибо за косяк, но твой вариант не прокатит, т.к. в моей проверке проверяется еще первый символ. Если заменить первый сивол на любой, то надо исправлять... НО потестил на mail'e и такие варианты хляют: q--------@mail.ru q........w@mail.ru q_____s@mail.ru Самоге главное чтобы не начиналась с точки, _, - и не заканчивались точкой или _. Так что в моем варианте проверки скрипта необходимо исправить проверку домена и последнего символа в имени. Вот такие пока хляют: mail@---.ru mail@....ru Но на самом деле в своей регистрации я отсылаю письмо на мыло, если ввели несуществующий адрес, то полная регистрация произведена не будет. Цитата смысл у этих постов ничуть не меньше, чем в тех постах, конторые написал ты. все-таки обижаться не стоит

Автор: korob2001 9.7.2005, 13:35

Что значит мой вариант??? Я пока никаких вариантов, по поводу E-mail не выкладывал. Вот тебе тестовый код, с твоим регулярным выражением, никакой первый символ не проверяется: Код #!/usr/bin/perl -w use strict; my $email = '.............@---------.ru'; if ( $email =~ /^[a-zA-Z_\.\-\d]+\@[a-zA-Z\.\-\d]+\.[a-zA-Z]{2,4}$/ ) {      print "ПРОШЛО"; } else {      print "НЕ ПРОШЛО"; } Если ты мел вииду это: ^ , то здесь первым символом может быль любой из перечисленных в квадратных скобках, это может быть и точка и подчёркивание и т.д. Вот так проверяю я E-mail, но задесь только регулярка, я же как правило таким выражением очищаю переменную, если это возможно, так как всегда использую -T. Код #!/usr/bin/perl -w use strict; my $email = '......@.....ru'; if ( $email =~ /^(?:[A-Za-z0-9]+?(?:\.|-|_)?)*(?:[A-Za-z0-9]+)?\@(?:[A-Za-z0-9]+?\.)*?[A-Za-z0-9]{2,4}$/ ) {      print "ПРОШЛО"; } else {      print "НЕ ПРОШЛО"; } Удачи. ЗЫ: только не думай, что я хочу выделиться, просто регулярки очень обманчивы и в них легко ошибиться. Я например тоже очень часто допускаю ошибки в них. Это не для того, что бы показать, что я умнее или наоборот. Ты очень даже не плохо знаешь Perl, я это вижу, просто в данном случае ты ошибся. Вот и всё. Не принимай на свой счёт.

Автор: sharq 9.7.2005, 14:44

korob2001 Цитата(korob2001 @ 9.7.2005, 13:35) Что значит мой вариант??? Это значит Цитата ............@................ru ---------@................ru ----------@------------ru Цитата(korob2001 @ 9.7.2005, 13:35) никакой первый символ не проверяется: смотри на первой странице мой пост с проверкой и функцией korob2001 прочти мой предыдущий пост на странице 2 про тестирование вариантов на mail.ru и протестируй на своем примере. Цитата(korob2001 @ 9.7.2005, 13:35) Не принимай на свой счёт. блин, да все окей, даже проблем быть не может. respect.

Автор: korob2001 9.7.2005, 21:47

Цитата блин, да все окей, даже проблем быть не может. respect Спасибо за понимание, просто многие так и считают, хотя я их и понимаю, тоже в своё время был таким.

Автор: SantaXP 10.7.2005, 02:06

Так, ок: Код if ( ($nick =~ /[^A-Za-z0-9_]/) && ($nick =~ /()+/) ){          print qq(             <td align="center" width=67%>             Go fuck your login!             </td>); } else {         print qq(             <td align="center" width=67%>             Login in normal! $length_nick             </td>); } Это проверка работает, но, если написать так: Код if ( ($nick =~ /^[a-zA-Z0-9_]+$/) && ($nick =~ /()+/) ){          print qq(             <td align="center" width=67%>             Go fuck your login!             </td>); } else {         print qq(             <td align="center" width=67%>             Login in normal! $length_nick             </td>); } То всё меняется местами (то есть значение True и False). Почему так??? ------ И ещё один ламерский вопрос, мне надо, чтобы логин был не менее 3-х знаков, я пишу: Код my $length_nick = length($nick); my $length_pass = length($password); my $min_length = 3; if ( ($nick =~ /[^A-Za-z0-9_]/) && ($nick =~ /()+/) && ($length_nick < $min_length) ){          print qq(             <td align="center" width=67%>             Go fuck your login!             </td>); } else {         print qq(             <td align="center" width=67%>             Login in normal! $length_nick             </td>); } Однако тогда проверка не пашет вообще... Видимо дело в моих кривых руках и операторе &&, который работает только при 2-ух условиях.. помогите, плиз, разобраться... ------- И последний маленький вопросик, какую книгу или статью вы посоветуете, чтобы разобраться в тонкостях регулярных выражений, а то я их даже из книги "Изучаем PERL" понять не могу???

Автор: korob2001 10.7.2005, 22:43

Цитата $nick =~ /()+/ А это зачем? Цитата И ещё один ламерский вопрос, мне надо, чтобы логин был не менее 3-х знаков, я пишу: Код if ( ($nick =~ /[^A-Za-z0-9_]/) && ($nick =~ /()+/) && ($length_nick < $min_length) ){  Исправь: Код my $min_length = 3; my $max_length = 10; if ( $nick =~ /^[A-Za-z0-9_]{$min_length,$max_length}$/  ) {      print "Проходит"; } else {      print "Не проходит"; } Если проверка максимального значения не нужна, тогда это выражение будет выглядеть так: Код my $min_length = 3; if ( $nick =~ /^[A-Za-z0-9_]{$min_length,}$/  ) {      print "Проходит"; } else {      print "Не проходит"; } Цитата И последний маленький вопросик, какую книгу или статью вы посоветуете, чтобы разобраться в тонкостях регулярных выражений, а то я их даже из книги "Изучаем PERL" понять не могу??? "Программирование на Perl", "Perl - библиотека программиста", "Perl - специальный справочник". Последнюю посмотри, я где-то выкладывал полную версию в электронном виде. Если не найдёшь, то дай знать, выложу ещё раз. Удачи.

Автор: Burdin 11.7.2005, 08:44

а как тогда проверить на содержание в ней только а-яА-Яa-zA-Z0-9_ подскажите

Автор: chaos 11.7.2005, 12:39

Цитата(sharq @ 9.7.2005, 14:44) korob2001 Цитата(korob2001 @ 9.7.2005, ) Что значит мой вариант??? Это значит Цитата ............@................ru ---------@................ru ----------@------------ru Цитата(korob2001 @ 9.7.2005, 13:35) никакой первый символ не проверяется: смотри на первой странице мой пост с проверкой и функцией korob2001 прочти мой предыдущий пост на странице 2 про тестирование вариантов на mail.ru и протестируй на своем примере. Цитата(korob2001 @ 9.7.2005, 13:35) Не принимай на свой счёт. блин, да все окей, даже проблем быть не может. respect. читайте rfc-822 PS да и вообще врядли можно написать такое регулярное выражение для проверки валидности почтового адреса PSS а если и можно то он будет очень и очень большой длины

Автор: Guest 11.7.2005, 12:48

Burdin Код if ( $nick =~ /[а-яА-Яa-zA-Z0-9_]/){          print qq(             <td align="center" width=67%>             Go fuck your login!             </td>); } else {         print qq(             <td align="center" width=67%>             Login in normal! $length_nick             </td>); } Таже тема, только в профиль. Должно быть так, код не проверял у себя на сервере.

Автор: Burdin 12.7.2005, 00:53

а количество символов?????

Автор: korob2001 12.7.2005, 09:23

Цитата читайте rfc-822 PS да и вообще врядли можно написать такое регулярное выражение для проверки валидности почтового адреса PSS а если и можно то он будет очень и очень большой длины chaos - читали уже RFC, так что ты предлагаешь? Вообще не проверять поле E-mail? Лично я тем способом, как показал выше отфильтровую все более или менее реальные адреса, которые при желании можно получить на любом, бесплатном почтовом сервере. Затем отправляю письмо им на мыло с сылкой, для подтверждения регистрации. Что касается таких товарищей, у которых адреса такого плана: mybox.mail, то таких кренделей очень мало и это их трудности. Цитата а количество символов????? Burdin - смотри выше, я уже тебе привёл примеры того, как проверить кол-во символов прямо в регулярном выражении. Цитата а как тогда проверить на содержание в ней только а-яА-Яa-zA-Z0-9_ подскажите Так же, но стоит подключить прагму locale и вполне возможно модуль POSIX

Автор: sharq 13.7.2005, 00:39

SantaXP качай доку по регекспу http://vingrad.ru/download/perl/regexp2-ref.pdf. chaos Цитата(chaos @ 11.7.2005, 12:39) PS да и вообще врядли можно написать такое регулярное выражение для проверки валидности почтового адреса PSS а если и можно то он будет очень и очень большой длины Вот вариант Т. Кристиансена, может слышал о таком .) Код #!/usr/bin/perl # # addrcheck - mail address checker # by tchrist@perl.com # Copyright 1997 Tom Christiansen # version 1.001 Fri Feb 14 15:20:02 MST 1997 #################################### # this program takes an email address as its argument # and decides whether you're being spoofed or not. # it exists 0 if it likes the address, and 1 if it doesn't. #  # can be tested interactively.  if not interactive, it will # use syslog. # # should be rewritten instead of just growing via hacks. #################################### $LOGGER   = '/usr/bin/logger';  # or /usr/ucb? $NSLOOKUP = '/usr/bin/nslookup';  # or /usr/ucb? $DEBUG = -t STDIN && -t STDOUT; $address = shift || die "usage: $0 address\n"; for ($address) {     s/^-+//;     tr/A-Z/a-z/; } ($user, $host) = split /\@/, $address; # we check in this order because of speed; # this way it will fail more quickly. check_passwd($user);    # picky if ($address =~ /\@./) {      check_host($host);     ck822($address);    # inscrutable     dns_check($host);    # slow } exit 0; ####################################   sub bad {     # GLOBAL $hispass and $what     if ($DEBUG) {     print "$what `$hispass' is bad: @_\n";     } else {     system $LOGGER,             "-p", "daemon.notice",              "-t", "ftpucheck",         "BOGUS \U$what\E $hispass (@_)";     }      exit 1; }  #################################### ############# sub check_passwd {       local $what = 'user';     local $hispass = shift;     for (@rude) {     bad("rude") if index($hispass, lc $_) != -1;     }      for (@anywhere) {     bad("inside") if index($hispass, lc $_) != -1;     }      for (@full) {     bad("full") if $hispass eq lc $_;     }      for (@start) {     bad("start") if index($hispass, lc $_) == 0;     }      # single char     bad("single") if length($hispass) == 1;     study $hispass;     bad("dup letters") if $hispass =~ /(\w)\1{3,}/;     bad("white") if $hispass =~ /\s/;     bad("junk") if $hispass =~ /[;,\/#^*]/;     $V = 'aeiouy';     if ($hispass =~ /netscape/ || $hispass =~ /^m[$V]*[sz]+[$V]*l+[$V]*\W*$/) {     bad("mozilla");     }      if ($hispass =~ /xyz+y/) {     bad("xyzzy");     }      # all same letter     bad("dup letters") if $hispass =~ /^(.)\1+$/;     # want letters     bad("ugly") unless $hispass =~ /[a-z]/;     bad("backspace") if $hispass =~ /[\010\177]/;     $letters = "qwertyuiopasdfghjklzxcvbnmmnbvcxzlkjhgfrdsapoiuytrewq";     # consecutive     bad("consecutive") if          length($hispass) > 2 &&         ( index($letters, $hispass) != -1             ||           ($hispass =~ /^(\w+)\1$/ && length($1) > 2             && index($letters, $1) != -1)         );     print "$what: $hispass is good\n" if $DEBUG; } ############# sub check_host {     local $what = 'host';     local $hispass = shift;     bad("dotless") unless index($hispass, '.') >= 0;     for (@rude) {     bad("rude") if index($hispass, lc $_) != -1;     }      for (@full) {     bad("full") if $hispass eq lc $_;     }      # single char     bad("single") if length($hispass) == 1;     study $hispass;     bad("white") if $hispass =~ /\s/;     bad("junk") if $hispass =~ /[;,\/#^*]/;     # want letters, darnit;  this will cause 127.1 to fail though     bad("ugly") unless $hispass =~ /[a-z]/;     bad("backspace") if $hispass =~ /[\010\177]/;     $letters = "qwertyuiopasdfghjklzxcvbnmmnbvcxzlkjhgfrdsapoiuytrewq";     # consecutive     bad("consecutive") if          length($hispass) > 2 &&         ( index($letters, $hispass) != -1             ||           ($hispass =~ /^(\w+)\1$/ && length($1) > 2             && index($letters, $1) != -1)         );     print "$what: $hispass is good\n" if $DEBUG; } sub dns_check {     # first try an MX record, then an A rec (for badly configged hosts)     my $host = shift;     local $/ = undef;     local $what = "DNS record";     local $hispass = $host;     # the following is comment out for security reasons:     #    if ( `nslookup -query=mx $host` =~ /mail exchanger/     # otherwise there could be naughty bits in $host     # we'll bypass system() and get right at execvp()     if (open(NS, "-|")) {     if (<NS> =~ /mail exchanger/) {         print "$what MX: $hispass is good\n" if $DEBUG;         close NS;         return;     }     } else {     open(SE, ">&STDERR");     open(STDERR, ">/dev/null");     exec $NSLOOKUP, '-query=mx', $host;     open(STDERR, ">&SE");     die "can't exec nslookup: $!";     }      if (open(NS, "-|")) {     $_ = <NS>;     if (/answer:.*Address/s) {         print "$what A: $hispass is good\n" if $DEBUG;         close NS;         return;     }     if (/Name:.*$host.*Address:/si) {         print "$what A: $hispass is good\n" if $DEBUG;         close NS;         return;     }     } else {     open(SE, ">&STDERR");     open(STDERR, ">/dev/null");     exec $NSLOOKUP, '-query=a', $host;     open(STDERR, ">&SE");     die "can't exec nslookup: $!";     }      bad("No DNS"); }  sub ck822 {      # ck822 -- check whether address is valid rfc 822 address     # tchrist@perl.com     #     # pattern developed in program by jfriedl;      # see "Mastering Regular Expressions" from ORA for details     # this will error on something like "ftp.perl.com." because     # even though dns wants it, rfc822 hates it.  shucks.     local $what = 'address';     local $hispass = shift;     local $_;     $is_a_valid_rfc_822_addr = '';     while (<DATA>) {     chomp;     $is_a_valid_rfc_822_addr .= $_;     }      bad("rfc822 failure") unless $hispass =~ /^${is_a_valid_rfc_822_addr}$/o;     print "$what: $hispass is good\n" if $DEBUG; } ############################## # initializations ############################## BEGIN {     @full = qw{     admin     anon     anonymous     bar     big-liar     bin     bizarre     bla     blah     bogus     cache     collect     compuserve     cool     crud     DeleGateMaster     devnull     dialup     dork     dummy     employee     first1     foo     friendly     ftpsearch-collect     fu     god     guest     gunk     gw     harvest     here     hi     ident     ident     ie30user     info     internet     junk     liar     login     lycos     maxima     me     mirror     mosaic     nobody     none     none-known     nouser     ntcon     ok     outbound     postmaster     president     public     Put_Your_Email_Address     report_abuse     root     satan     socks     spanky     src     sticky     system     there     Unknown_Netscape_User     Unregistered     unverified     user     UserName     vice-president     vividnet     whoever     wow     xyz     xyz     };     @start = qw{     aaa     abc     account     anon     anon     asquid     daemon      delegate     ftp     gopher     gotch     oracle     otthttp     pass     satan     squid     student     test     web     xx     };     @anywhere = qw{     adresse     asdf     asfd     cache     firewall     -gw     http     mail     mirror     mother     name     nobody     proxy     sadf     system     user     www     };      @rude = qw{     asshole     crap     cunt     damn     fuck     piss     shit     suck     tits     upyour     }; } # don't touch this stuff down here or you'll break the rfc822 matcher. __END__ (?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n \015()]|\\[^\x80-\xff])*\))*\))*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\ xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015" ]|\\[^\x80-\xff])*")(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[ ^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\ xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,; :".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")) *(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\ n\015()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\ \[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\04 0)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80- \xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((? :[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80 -\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\( (?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\] \000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\ \x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*|(?:[^(\040)<>@,;:".\\\[\]\000-\0 37\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xf f\n\015"]|\\[^\x80-\xff])*")(?:[^()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\03 7]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\ \[^\x80-\xff])*\))*\)|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")*<(?:[\04 0\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()] |\\[^\x80-\xff])*\))*\))*(?:@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x 80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@ ,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff] )|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\ \x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff ])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^ \\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000- \037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80- \xff\n\015\[\]]|\\[^\x80-\xff])*\]))*(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\01 5()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*,(? :[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\0 15()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^ \x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)< >@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xf f])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^ \\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\x ff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?: [^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\00 0-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x8 0-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*)*:(?:[\040\t]|\((?:[^\\\x80-\xff\n\ 015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*) ?(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000 -\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")(?:(?:[\040\t] |\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[ ^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\ \\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?: [^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*"))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\ 015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*@ (?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n \015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff ]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\ ]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\ xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((? :[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80 -\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@ ,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff ])*\]))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x8 0-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*>)(?:[\040\t]|\((?:[^\\\x80-\xff\n\ 015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*  korob2001 Цитата(korob2001 @ 12.7.2005, 09:23) Цитата а как тогда проверить на содержание в ней только а-яА-Яa-zA-Z0-9_ подскажите Так же, но стоит подключить прагму locale и вполне возможно модуль POSIX у меня без прагмы locale работает, но попробовать стоит.

Автор: korob2001 13.7.2005, 01:41

Цитата у меня без прагмы locale работает, но попробовать стоит. sharq - у меня работает только с use locale, а некоторым и она не помогает и нужно напрямую подключать POSIX. Эта тема уже была здесь, только я не помню как называется. Вобщем я пишу всегда просто: Код #!/usr/bin/perl use locale; Тут и начался спор, что нужно подключать ещё и POSIX, т.е. так: Код #!/usr/bin/perl use POSIX qw (locale_h); setlocale(LC_CTYPE, 'ru_RU.CP1251'); setlocale(LC_ALL, "ru_RU.CP1251"); use locale; Может для надёжности лучше так и делать, хотя по идее locale делает это, она для того и предназначена.

Автор: SantaXP 23.8.2005, 23:48

2sharq Спасибо, скачал, буду изучать! ---- 2korob2001 Можно чуть-чуть поподробней о locale? Что это за зверь, что он делает и с чем едят?

Автор: korob2001 24.8.2005, 05:33

SantaXP - эта прагма заставляет компилятор включить национальные установки из POSIX. Необходимо это в том случае, если тебе к примеру нужно перевести регистр или осуществить поиск с учётом языковой среды. Вот тебе простой пример: Код #!/usr/bin/perl use strict; # use locale; my $name = "вАсЯ"; # Пытаемся опустить регистр всех символов и поднять только первый $name = ucfirst( lc( $name ) ); print $name; Попробуй запустить. Скорее всего, после запуска этого кода, ничего так и не произойдёт, строка так и останется такой же "вАсЯ". А теперь попробуй раскоментировать use locale и запусти пример снова. Результат должен быть таким "Вася". Эта прагма является с лексической областью видимости, а так же есть способ отключить её, no locale. Вот написал пример, который полностью всё это демострирует, подробности читай в коментариях: Код #!/usr/bin/perl use strict; my $name = "вАсЯ"; my $surname = "пУпКин"; # Посмотрим, действительно ли она с лексической областью видимости sub propString {     my $string = shift;     use locale;     $string = ucfirst( lc( $string ) );     return $string; } # Следующая подпрограмма принимает 2 аргумента ( имя, фамилия ), она # покажет нам явно, что no locale действительно отключает прагму. sub propFullName {         # Принимаем параметры         my( $name, $lastname ) = @_;         # Подключаем прагму locale         use locale;         # Пытаемся преобразовать имя         $name = ucfirst( lc( $name ) );         # Отключам прагму locale         no locale;         # Пытаемся преобразовать фамилию         $lastname = ucfirst( lc( $lastname ) );         # Возвращаем оба параметра, если их желают получить как список,         # в противном случае объединим их в строку и вернём скаляр         return wantarray ? ($name, $lastname) : join(" ", $name, $lastname); } ###################### Попытка 1 ############################################### # Пытаемся поднять регистр первого символа, остальные опускаем вниз ( не верно ) print "Пытаемся обработать строку глобально\n"; $name = ucfirst( lc( $name ) ); # Пытаемся сделать тоже самое и с фамилией ( не верно ) $surname = ucfirst( lc( $surname ) ); print "$name $surname\n\n"; ###################### Попытка 2 ############################################### # Теперь попробуем сделать это с помощью нашей подпрограммы print "Пытаемся обработать строку через подпрограмму propString(\$)\n"; $name = propString( $name ); $surname = propString( $surname ); print "$name $surname\n\n"; # Приведём строки к первоначальному виду $name = "вАсЯ"; $surname = "пУпКин"; ###################### Попытка 3 ############################################### # Теперь попробуем сделать это с помощью подпрограммы propFullName($$) print "Пытаемся обработать строки через подпрограмму propFullName(\$\$)\n"; my $fullname = propFullName( $name, $surname ); print $fullname, "\n"; После первой попытки должен быть такой результат: Цитата Пытаемся обработать строку глобально вАсЯ пУпКин После второй попытки: Цитата Пытаемся обработать строку через подпрограмму propString($) Вася Пупкин После третьей попытки: Цитата Пытаемся обработать строки через подпрограмму propFullName($$) Вася пУпКин Думаю подробно описал. Если, что-то не поймёшь, пиши.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)