Как извлечь или изменить ссылки в HTML с помощью Perl? - PullRequest
Новая
       19

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

2 голосов
/ 12 декабря 2008

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

<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 сделать это? Или, может быть, я просто слишком туп, чтобы видеть очевидный способ сделать это, плюс я знаю, что глобальный вариант не работает.

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

Ответы [ 3 ]

10 голосов
/ 12 декабря 2008

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

4 голосов
/ 12 декабря 2008

Я думаю, вам нужен мой HTML :: SimpleLinkExtor модуль: 

use HTML::SimpleLinkExtor;

my $extor = HTML::SimpleLinkExtor->new;
$extor->parse_file( $file );

my @imgs = $extor->img;

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

2 голосов
/ 12 декабря 2008

Если вам необходимо избежать каких-либо дополнительных модулей, таких как анализатор 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
  }
}

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

...