如何使用 Perl 提取或更改 HTML 中的链接？答案

【问题标题】：How can I extract or change links in HTML with Perl?如何使用 Perl 提取或更改 HTML 中的链接？
【发布时间】：2010-09-26 14:16:48
【问题描述】：

我有这个输入文本：

<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 方法可以做到这一点？或者也许我只是太笨了，看不到明显的方法，而且我知道把全局选项不起作用。

谢谢。〜史蒂夫

【问题讨论】：

htmlRegexParserQuestions++ （显然，每天必须有一个）

标签： html regex perl multiple-instances

【解决方案1】：

Perl 有优秀的 HTML 解析器，学习使用它们并坚持下去。 HTML 很复杂，在属性中允许 >，大量使用嵌套等。使用正则表达式对其进行解析，除了非常简单的任务（或机器生成的代码）之外，很容易出现问题。

【讨论】：

嗨，我正在使用 mod perl，我们在 unix 中运行，我需要管理层批准才能添加模块，所以希望找到一种简单的 perl 方法来完成它或默认mod perl 中的模块。谢谢
嗯，你可以随时查看模块源代码。至于管理，你可以告诉他们有人已经正确地完成了它，如果你使用现有的正确解决方案，他们可以节省时间和金钱，你可以转移到下一个问题。
有道理，我宁愿使用经过测试证明的方法，我的另一个可怕的黑客......希望我的尖头发老板能答应。
没有什么比重新发明轮子，最终得到一个矩形“轮子”。

【解决方案2】：

我想你想要我的HTML::SimpleLinkExtor 模块：

使用 HTML::SimpleLinkExtor；我的 $extor = HTML::SimpleLinkExtor->new; $extor->parse_file($file); 我的@imgs = $extor->img;

我不确定你到底想做什么，但如果我的不这样做的话，听起来好像其中一个 HTML 解析模块应该可以解决问题。

【讨论】：

基本上，我正在尝试将 html 作为外部文件导出，因此我需要复制图像并将图像导出到图像文件夹并将 img src 更改为原始文件html.
这是您应该在问题中包含的信息，而不是隐藏在评论中。 :)

【解决方案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
  }
}

这样，您将在所有源代码（包括换行符）上应用此正则表达式，并拥有更紧凑的代码（另外，您将考虑属性与其值之间的任何额外空间）

【讨论】：

人们真的应该让 cmets 去投票。 +1，因为您正在回答一个特定的非常真实的案例。
刚刚回到我的帖子。那被否决了？当然，HTML 解析器是要走的路，但我也喜欢回答用户的实际情况。感谢 Axeman 认识到这个“答案”是什么。
是的，这个答案完全符合我的情况，因为除非必要，否则我真的不能简单地介绍更多模块的使用:)