Форум программистов [Powered by Invision Power Board]

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

Форум программистов > Perl: Общие вопросы > Помогите с регулярками

Автор: TwiSteR 7.2.2006, 00:07

Приветствую уважаемые !
Есть функция на пхп с кучей регулярок

Код


function clean_words($entry) {  

        $entry = " ".strip_tags($entry)." ";

        $entry = preg_replace("#\[(mm|gm|mod|ex|mergetime)\](.+?)\[/\\1\]#is",  "", $entry);

        // Replace line endings by a space
        $entry = preg_replace("/[\n\r]/is", " ", $entry); 

        // Quickly remove BBcode.
        $entry = preg_replace("/\[\/?[a-zA-Z*]+[^\]]*\]/", " ", $entry);
        $entry = preg_replace("#(^|\s)((http|https|news|ftp)://\w+[^\s\[\]]+)#is", " ", $entry);

        // HTML entities like &nbsp;
        $entry = preg_replace("/\b&[a-z]+;\b/", " ", $entry); 

//      $entry = preg_replace("/(\:spy\:|\:cool|\:mod|\:lamer)/", "", $entry);

        // Filter out strange characters like ^, $, &, change "it's" to "its"
        $entry = str_replace($this->drop_char_match, $this->drop_char_replace, $entry);

        return $entry;

        }

в регулярках вообщем не бум-бум.

Автор: korob2001 7.2.2006, 01:06

Что-то я вопроса не заметил. smile

Что именно не понятно? И почему в раздел PHP не запостил?

Автор: TwiSteR 7.2.2006, 01:37

Рад приветствовать тебя korob2001!

Непонятно вот что к примеру

// Quickly remove BBcode.
$entry = preg_replace("/\[\/?[a-zA-Z*]+[^\]]*\]/", " ", $entry);

Удалить все BBcode из текста
так вот тут суть в том что будут искаться и удалятся квадратные скобки и всё что в них

Как это сделать на перле, вообще не понимаю smile

P.S. А причём тут раздел пхп, мне на перле это надо (хоть это из пхп)
Врядли думаю что мне там помогут.

Автор: Kiber_rat 7.2.2006, 06:05

Если это все perl совместимые регулярные выражения (что видно из названий функций), то перевести это в perl очень просто smile

Код

$_ = " ".strip_tags($entry)." "; # strip_tags - это какая-то своя функция
s!\[(mm|gm|mod|ex|mergetime)\](.+?)\[/\\1\]!!is;
s/[\n\r]/ /is;
s/\[\/?[a-zA-Z*]+[^\]]*\]/ /;
s!(^|\s)((http|https|news|ftp)://\w+[^\s\[\]]+)! !is;
s/\b&[a-z]+;\b/ /;
s/(\:spy\:|\:cool|\:mod|\:lamer)//;

Автор: TwiSteR 7.2.2006, 11:21

Kiber_rat

Спасибо !
Только вот пробую так

Код


sub clean_words {
        my $entry = $_[0];

        $entry =~ s!\[(mm|gm|mod|ex|mergetime)\](.+?)\[/\\1\]!!is;
        $entry =~ s/[\n\r]/ /is;
        $entry =~ s/\[\/?[a-zA-Z*]+[^\]]*\]/ /;
        $entry =~ s!(^|\s)((http|https|news|ftp)://\w+[^\s\[\]]+)! !is;
        $entry =~ s/\b&[a-z]+;\b/ /;
        $entry =~ s/(\:spy\:|\:cool|\:mod|\:lamer)//;

        return $entry;

}

my $u = clean_words("[mm] [ex] test");
print $u;

[mm] Долбит, а вот [ex] уже нет smile

Да и по поводу функции пхпшной strip_tags , она долбит все хтмп теги. Что-то подобное можно организовать ?

Автор: Sadok 7.2.2006, 12:25

TwiSteR

Цитата

[mm] Долбит, а вот [ex] уже нет

ну, так откуда sub возмет этот [ex], если ты передаешь ей только [mm] (my $entry = $_[0];)? smile

и это не единственная ошибка.

Автор: korob2001 7.2.2006, 12:44

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

Код


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


sub clean_words {
        my $entry = $_[0];

        $entry =~ s!\[(mm|gm|mod|ex|mergetime)\](.+?)\[/\\1\]!!gis;
        $entry =~ s/[\n\r]/ /gis;
        $entry =~ s/\[\/?[a-zA-Z*]+[^\]]*\]/ /g;
        $entry =~ s!(^|\s)((http|https|news|ftp)://\w+[^\s\[\]]+)! !gis;
        $entry =~ s/\b&[a-z]+;\b/ /g;
        $entry =~ s/(\:spy\:|\:cool|\:mod|\:lamer)//g;

        # Удалим лишние пробелы
        $entry =~ s/^\s+//;
        $entry =~ s/\s+$//;
        $entry =~ s/\s+/ /g;

        return $entry;

}

my $u = clean_words("[mht] [ex] test");
print $u;

Я тут добавил код удаляющий лишние пробелы, но это уже сам смотри, если не нужен то удали эти три строки.

Автор: TwiSteR 7.2.2006, 13:29

Во спасибо ребята !

А вот как быть с strip_tags в пхп она удаляет хтмл теги, что скажите ?

Автор: korob2001 7.2.2006, 13:53

Думаю примерно так:

Код


$entry =~ /<.*?>//g;

вот так должна выглядеть твоя подпрограмма:

Код


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

sub clean_words {
        my $entry = shift;
        $entry =~ s!\[(mm|gm|mod|ex|mergetime)\](.+?)\[/\\1\]!!gis;
        $entry =~ s/[\n\r]/ /gis;
        $entry =~ s/\[\/?[a-zA-Z*]+[^\]]*\]/ /g;
        $entry =~ s!(^|\s)((http|https|news|ftp)://\w+[^\s\[\]]+)! !gis;
        $entry =~ s/\b&[a-z]+;\b/ /g;
        $entry =~ s/(\:spy\:|\:cool|\:mod|\:lamer)//g;

        # Удалим теги HTML
        $entry =~ s/<.*?>//g;

        # Удалим лишние пробелы
        $entry =~ s/^\s+//;
        $entry =~ s/\s+$//;
        $entry =~ s/\s+/ /;

        return $entry;
}

my $u = clean_words("<b><font color='#ff0000'>[mht]</font> [ex]</b> <i>test</i>");
print $u;

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

Автор: TwiSteR 7.2.2006, 16:25

korob2001,Kiber_rat

Спасибо за реальную помощь !

Автор: Kiber_rat 7.2.2006, 18:49

korob2001 Я предпочитаю удалять тэги так:

Код

$entry =~ s/<[^>]*>//g;

хотя и этот вариант далек от RFC smile

Автор: korob2001 7.2.2006, 19:46

А в чём отличие?

Автор: Kiber_rat 12.2.2006, 19:48

Теоретически в том, что мой вариант работает быстрее smile

Можешь проверить на каком -нить html файле. Ну и если верить книжке "Регулярные выражения" он боле правильный...

Автор: korob2001 12.2.2006, 21:14

Цитата(Kiber_rat @ 12.2.2006, 16:48

)

Теоретически в том, что мой вариант работает быстрее Можешь проверить на каком -нить html файле.

Практически, мой пример работает на треть быстрее.
С моим вариантом:

Код


#!/usr/bin/perl -w
use strict;
use Time::HiRes qw(time);

my $file = "guest.html";
my($start, $stop) = (0,0);

open(F, "< $file") or die "Can't open file '$file': $!\n";
$start = time();
while (<F>) {
       s/<.*?>//g;
}
$stop = time();
close(F);

printf ("%s%.5f", "Затраченное время: " , ($stop - $start));

С твоим:

Код


#!/usr/bin/perl -w
use strict;
use Time::HiRes qw(time);

my $file = "guest.html";
my($start, $stop) = (0,0);

open(F, "< $file") or die "Can't open file '$file': $!\n";
$start = time();
while (<F>) {
       s/<[^>]*>//g;
}
$stop = time();
close(F);

printf ("%s%.5f", "Затраченное время: " , ($stop - $start));

Вот такие цифры получил я:
Первый запуск:

Цитата

Твой: Затраченное время: 0.00194
Мой: Затраченное время: 0.00130

Повторный запуск:

Цитата

Твой: Затраченное время: 0.00212
Мой: Затраченное время: 0.00138

Третий запуск:

Цитата

Твой: Затраченное время: 0.00192
Мой: Затраченное время: 0.00128

Для теста прицепляю два скрипта, с обеими вариантами и html файл, на котором я тестил.

Цитата(Kiber_rat @ 12.2.2006, 16:48

)

Ну и если верить книжке "Регулярные выражения" он боле правильный...

Я не читал её, хотя много слышал о ней. Но с другой стороны, эта книга уже порядочно устарела.

Автор: nitr 13.2.2006, 03:11

Ну а вот последняя модификация быстрого удаления smile

Код


s/<*?>//sg;

"?" - нужен по-любому для "ленивого" поиска, что быстрее. С инвертированным классом "[^>]" сложней, при наличии внутренних комментариев в тегах, но будет вернее

Код

s/<[^>]*?>//sg

Теперь тестируйте... smile