Как я могу извлечь или изменить ссылки в HTML с помощью Perl?

У меня есть этот входной текст:

<html><head><meta http-equiv="content-type" content="text/html; charset=utf-8"></head><body><table cellspacing="0" cellpadding="0" border="0" align="center" width="603">   <tbody><tr>     <td><table cellspacing="0" cellpadding="0" border="0" width="603">       <tbody><tr>         <td width="314"><img height="61" width="330" src="/Elearning_Platform/dp_templates/dp-template-images/awards-title.jpg" alt="" /></td>         <td width="273"><img height="61" width="273" src="/Elearning_Platform/dp_templates/dp-template-images/awards.jpg" alt="" /></td>       </tr>     </tbody></table></td>   </tr>   <tr>     <td><table cellspacing="0" cellpadding="0" border="0" align="center" width="603">       <tbody><tr>         <td colspan="3"><img height="45" width="603" src="/Elearning_Platform/dp_templates/dp-template-images/top-bar.gif" alt="" /></td>       </tr>       <tr>         <td background="/Elearning_Platform/dp_templates/dp-template-images/left-bar-bg.gif" width="12"><img height="1" width="12" src="/Elearning_Platform/dp_templates/dp-template-images/left-bar-bg.gif" alt="" /></td>         <td width="580"><p>&nbsp;what y all heard?</p><p>i'm shark oysters.</p>             <p>&nbsp;</p>             <p>&nbsp;</p>             <p>&nbsp;</p>             <p>&nbsp;</p>             <p>&nbsp;</p>             <p>&nbsp;</p></td>         <td background="/Elearning_Platform/dp_templates/dp-template-images/right-bar-bg.gif" width="11"><img height="1" width="11" src="/Elearning_Platform/dp_templates/dp-template-images/right-bar-bg.gif" alt="" /></td>       </tr>       <tr>         <td colspan="3"><img height="31" width="603" src="/Elearning_Platform/dp_templates/dp-template-images/bottom-bar.gif" alt="" /></td>       </tr>     </tbody></table></td>   </tr> </tbody></table> <p>&nbsp;</p></body></html>

Как видите, в этом фрагменте HTML-текста нет новой строки, и мне нужно найти все ссылки на изображения внутри, скопировать их в каталог и изменить строку внутри текста на что-то вроде ./images/file_name.

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

my ($old_src,$new_src,$folder_name);
    foreach my $record (@readfile) {
        ## so the if else case for the url replacement block below will be correct
        $old_src = "";
        $new_src = "";
        if ($record =~ /\<img(.+)/){
            if($1=~/src=\"((\w|_|\\|-|\/|\.|:)+)\"/){
                $old_src = $1;
                my @tmp = split(/\/Elearning/,$old_src);
                $new_src = "/media/www/vprimary/Elearning".$tmp[-1];
                push (@images, $new_src);
                $folder_name = "images";
            }## end if
        }
        elsif($record =~ /background=\"(.+\.jpg)/){
            $old_src = $1;
            my @tmp = split(/\/Elearning/,$old_src);
            $new_src = "/media/www/vprimary/Elearning".$tmp[-1];
            push (@images, $new_src);
            $folder_name = "images";
        }
        elsif($record=~/\<iframe(.+)/){
            if($1=~/src=\"((\w|_|\\|\?|=|-|\/|\.|:)+)\"/){
                $old_src = $1;
                my @tmp = split(/\/Elearning/,$old_src);
                $new_src = "/media/www/vprimary/Elearning".$tmp[-1];
                ## remove the ?rand behind the html file name
                if($new_src=~/\?rand/){
                    my ($fname,$rand) = split(/\?/,$new_src);
                    $new_src = $fname;
                    my ($fname,$rand) = split(/\?/,$old_src);
                    $old_src = $fname."\\?".$rand;
                }
        print "old_src::$old_src\n"; ##s7test
        print "new_src::$new_src\n\n"; ##s7test
                push (@iframes, $new_src);
                $folder_name = "iframes";
            }## end if
        }## end if

        my $new_record = $record;
        if($old_src && $new_src){
            $new_record =~ s/$old_src/$new_src/ ;
    print "new_record:$new_record\n"; ##s7test
            my @tmp = split(/\//,$new_src);
            $new_record =~ s/$new_src/\.\\$folder_name\\$tmp[-1]/;
##  print "new_record2:$new_record\n\n"; ##s7test
        }## end if
        print WRITEFILE $new_record;
    } # foreach

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

У вас есть идея, если есть элегантный способ Perl сделать это? Или, может быть, я просто слишком туп, чтобы увидеть очевидный способ сделать это, плюс я знаю, что глобальные опции не работают.

Спасибо. ~ стив

12.12.2008 05:53:15
htmlRegexParserQuestions ++ (очевидно, он должен быть один раз в день)
Tomalak 12.12.2008 07:09:08
3 ОТВЕТА
РЕШЕНИЕ

Если вам необходимо избежать каких-либо дополнительных модулей, таких как анализатор HTML, вы можете попробовать:

while ($string =~ m/(?:\<\s*(?:img|iframe)[^\>]+src\s*=\s*\"((?:\w|_|\\|-|\/|\.|:)+)\"|background\s*=\s*\"([^\>]+\.jpg)|\<\s*iframe)/g) {
  $old_src = $1;
            my @tmp = split(/\/Elearning/,$old_src);
                    $new_src = "/media/www/vprimary/Elearning".$tmp[-1];
  if($new_src=~/\?rand/){
    // remove rand and push in @iframes
  else
  {
    // push into @images
  }
}

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

2
12.12.2008 07:10:20
Люди действительно должны оставлять комментарии для голосования. +1, потому что вы отвечаете за конкретный слишком реальный случай.
Axeman 12.12.2008 07:57:06
Только что вернулся на мой пост. За что проголосовали? Конечно, HTML-парсер - это путь, но я также хотел бы ответить на реальный случай пользователя. Спасибо Axeman за признание этого «ответа» за то, что он есть.
VonC 12.12.2008 11:25:15
да, этот ответ соответствует моему случаю должным образом, поскольку я действительно не могу просто представить использование большего количества модулей без необходимости :)
melaos 9.01.2009 03:30:25

Для Perl есть отличные HTML-парсеры, научитесь их использовать и придерживайтесь этого. HTML сложен, допускает> атрибуты, интенсивно использует вложение и т. Д. Использование регулярных выражений для его анализа, помимо очень простых задач (или машинно-сгенерированного кода), подвержено проблемам.

10
12.12.2008 06:22:46
Привет, я использую Mod Perl, и мы работаем в Unix, мне нужно одобрение руководства для добавления модуля, поэтому я надеялся найти простой способ Perl, чтобы сделать это или, возможно, модули по умолчанию в Mod Perl. спасибо
melaos 12.12.2008 06:25:03
ну, вы всегда можете посмотреть на источник модуля. Что касается управления, вы можете сказать им, что кто-то уже сделал это правильно, и если вы сможете использовать существующее правильное решение, они сэкономят время и деньги, и вы сможете перейти к следующей проблеме.
brian d foy 12.12.2008 07:49:12
Имеет смысл, я бы предпочел использовать проверенный тестовый метод, который еще один мой ужасный хакер ... надеюсь, что мой остроконечный босс обяжет.
melaos 12.12.2008 08:10:28
Ничего подобного изобретению колеса и получению прямоугольного «колеса».
Brad Gilbert 21.12.2008 01:59:13

Я думаю, что вы хотите мой модуль HTML :: SimpleLinkExtor :

использовать HTML :: SimpleLinkExtor;

мой $ extor = HTML :: SimpleLinkExtor-> new;
$ extor-> parse_file ($ file);

my @imgs = $ extor-> img;

Я не уверен, что именно вы пытаетесь сделать, но, похоже, один из модулей HTML-разбора должен справиться, если у меня нет.

4
12.12.2008 07:43:09
ну, в основном, я пытаюсь экспортировать HTML как внешний файл, поэтому мне нужно скопировать изображение, а также экспортировать изображения в папку изображений и изменить IMG SRC в исходный HTML.
melaos 12.12.2008 07:50:01
Именно такую ​​информацию вы должны включить в свой вопрос, а не скрыть в комментарии. :)
brian d foy 12.12.2008 08:16:55