Подскажите при помощи каких регулярных выражений можно сотворить следующее

имеем некий 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>

Заранее Спасибо за подсказочки

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

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

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

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

Вообще-то было бы не плохо знать, что мы ищем, текст, цифры и т.п. Вот такой вариант попробуй:

Код

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

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

Пасиба!!!

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

Код

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;

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

Кстати, можно и топорным способом через временную переменную (чтоб не портить первоначальную):

Код

$e=~tr/a-zA-Z0-9/k/s;

Результат либо "k" (для простой переменной), либо "[email protected]" или "[email protected]" для мыла...
Должно сработать

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}$/ ); }

Это сообщение отредактировал(а) sharq - 7.7.2005, 19:01

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>);}

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

SantaXP сравни две строки

Цитата(sharq @ 7.7.2005, 18:43)

$str =~ /[^A-Za-z0-9_]/

Цитата(SantaXP @ 7.7.2005, 23:48)

$nick =~ /^[a-zA-Z0-9_]

Видишь разницу - она большая!!!

Твой случай проверяет, чтобы логин начинался с символа приведенного множества...

Почитай основы регулярных выражений, например, в книге Изучаем Perl/

Реально, ничего сложного там нет.

Это сообщение отредактировал(а) sharq - 8.7.2005, 00:13

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>);}

Цитата

у тебя выдает ошибку потому-что

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_]+$/

У него же условие стоит такое: если строка состоит из данных символов, все ОК, если нет - проблема. Потому отрицание здесь не нужно, а так же необходим +, так как мы же проверяем не только первый символ, для полноты ещё и символ конца строки.

Удачи.

Это сообщение отредактировал(а) 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>); }

Это сообщение отредактировал(а) korob2001 - 8.7.2005, 05:25

ну и что получается в твоем варианте пропускает а в моем нет

Код

#!/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!

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

Хотя наверное отрицание, будет выглядеть более разумным если записатьего так:

Код

#!/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

ну вот ты мне обьясни на этом примере???

Код

#!/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!

Код

#!/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); }

Что-то вы здесь пургу развели...

Что это за логин: с пробелами и русскими буквами??? Хотя смотря какая задача стоит...

Вот аффтору нужно наличие только латинских букв, цифр и _. Всё!
Никаких пробелов и русских букв тем более!!!

Для логина и пароля:

Код

$nick =~ /[^a-zA-Z0-9_]/

Для мыла я уже писал, еще раз:

Код

$email =~ /^[a-zA-Z_\.\-\d]+\@[a-zA-Z\.\-\d]+\.[a-zA-Z]{2,4}$/

Какие еще могут быть проблемы?

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

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

А я читаю и понять не могу, о чем посты.


SantaXP разабрался?

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

korob2001 да спасибо за косяк, но твой вариант не прокатит, т.к. в моей проверке проверяется еще первый символ. Если заменить первый сивол на любой, то надо исправлять...

НО потестил на mail'e и такие варианты хляют:
[email protected]
[email protected]
[email protected]

Самоге главное чтобы не начиналась с точки, _, - и не заканчивались точкой или _.

Так что в моем варианте проверки скрипта необходимо исправить проверку домена и последнего символа в имени.
Вот такие пока хляют:
[email protected]
[email protected]

Но на самом деле в своей регистрации я отсылаю письмо на мыло, если ввели несуществующий адрес, то полная регистрация произведена не будет.

Цитата

смысл у этих постов ничуть не меньше, чем в тех постах, конторые написал ты.

все-таки обижаться не стоит

Что значит мой вариант??? Я пока никаких вариантов, по поводу E-mail не выкладывал. Вот тебе тестовый код, с твоим регулярным выражением, никакой первый символ не проверяется:

Код

#!/usr/bin/perl -w use strict; my $email = '[email protected]'; 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 = '[email protected]'; if ( $email =~ /^(?:[A-Za-z0-9]+?(?:\.|-|_)?)*(?:[A-Za-z0-9]+)?\@(?:[A-Za-z0-9]+?\.)*?[A-Za-z0-9]{2,4}$/ ) {      print "ПРОШЛО"; } else {      print "НЕ ПРОШЛО"; }

Удачи.

ЗЫ: только не думай, что я хочу выделиться, просто регулярки очень обманчивы и в них легко ошибиться. Я например тоже очень часто допускаю ошибки в них. Это не для того, что бы показать, что я умнее или наоборот. Ты очень даже не плохо знаешь Perl, я это вижу, просто в данном случае ты ошибся. Вот и всё. Не принимай на свой счёт.

Это сообщение отредактировал(а) korob2001 - 9.7.2005, 13:46

korob2001

Цитата(korob2001 @ 9.7.2005, 13:35)

Что значит мой вариант???

Это значит

Цитата

[email protected] [email protected] ----------@------------ru

Цитата(korob2001 @ 9.7.2005, 13:35)

никакой первый символ не проверяется:

смотри на первой странице мой пост с проверкой и функцией

korob2001 прочти мой предыдущий пост на странице 2 про тестирование вариантов на mail.ru и протестируй на своем примере.

Цитата(korob2001 @ 9.7.2005, 13:35)

Не принимай на свой счёт.

блин, да все окей, даже проблем быть не может. respect.

Цитата

блин, да все окей, даже проблем быть не может. respect

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

Так, ок:

Код

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" понять не могу???

Цитата

$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 - специальный справочник". Последнюю посмотри, я где-то выкладывал полную версию в электронном виде. Если не найдёшь, то дай знать, выложу ещё раз.

Удачи.

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

подскажите

Цитата(sharq @ 9.7.2005, 14:44)

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

читайте rfc-822

PS да и вообще врядли можно написать такое регулярное выражение для проверки валидности почтового адреса
PSS а если и можно то он будет очень и очень большой длины

Это сообщение отредактировал(а) chaos - 11.7.2005, 12:41

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>); }

Таже тема, только в профиль.
Должно быть так, код не проверял у себя на сервере.

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

Цитата

читайте rfc-822 PS да и вообще врядли можно написать такое регулярное выражение для проверки валидности почтового адреса PSS а если и можно то он будет очень и очень большой длины

chaos - читали уже RFC, так что ты предлагаешь? Вообще не проверять поле E-mail? Лично я тем способом, как показал выше отфильтровую все более или менее реальные адреса, которые при желании можно получить на любом, бесплатном почтовом сервере. Затем отправляю письмо им на мыло с сылкой, для подтверждения регистрации.
Что касается таких товарищей, у которых адреса такого плана: mybox.mail, то таких кренделей очень мало и это их трудности.

Цитата

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

Burdin - смотри выше, я уже тебе привёл примеры того, как проверить кол-во символов прямо в регулярном выражении.

Цитата

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

Так же, но стоит подключить прагму locale и вполне возможно модуль POSIX

Это сообщение отредактировал(а) korob2001 - 12.7.2005, 09:26

SantaXP качай доку по регекспу здесь.


chaos

Цитата(chaos @ 11.7.2005, 12:39)

PS да и вообще врядли можно написать такое регулярное выражение для проверки валидности почтового адреса PSS а если и можно то он будет очень и очень большой длины

Вот вариант Т. Кристиансена, может слышал о таком .)

Код

#!/usr/bin/perl # # addrcheck - mail address checker # by [email protected] # 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     # [email protected]     #     # 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 работает, но попробовать стоит.

Цитата

у меня без прагмы 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 делает это, она для того и предназначена.

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

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($$) Вася пУпКин

Думаю подробно описал. Если, что-то не поймёшь, пиши.

Это сообщение отредактировал(а) korob2001 - 24.8.2005, 06:20