如何使用 Perl 进行条件正则表达式全局替换？

Question

我有一个变量$content，其中包含一段混合文本和 HTML img 标签和 URL。

我想进行条件字符串注入来做一些替换。

例如，假设$content包含

ABC <img src="http://url1.com/keep.jpg">
DEF <img src="http://random-url.com/replace.jpg">
GHI <img src="http://url2.com/keep.jpg">

我想编辑$content 并制作它

ABC <img src="http://url1.com/keep.jpg"> 
DEF <img src="http://wrapper-url.com/random-url.com/replace.jpg"> 
GHI <img src="http://url2.com/keep.jpg">

我有一个要保留的 URL 正则表达式条件列表：上述 白名单匹配。白名单以外的任何图片 URL 都将使用 wrapper-url 前缀进行编辑。

我的想法是：

if image tags matched in $content {
  if match is in 'whitelist'
    do nothing
  else
    inject prefix replacement
}

我不知道如何进行条件正则表达式全局替换，因为所有内容都在单行字符串变量中。

我需要在 Perl 中实现这个。

---

附加信息：

我的“白名单”目前只有 5 行，基本上包含关键字和域。

这是我为匹配“白名单”所做的工作。

例如。

if ($_ =~ /s3\.static\.cdn\.net/) {
    # whitelist to keep, subdomain match
}
elsif ($_ =~ /keyword-to-keep/) {
    # whitelist to keep, url keyword match
}
elsif ($_ =~ /cdn\.domain\.com/) {
    # whitelist to keep, subdomain match
}
elsif ($_ =~ /whitelist-domain\.net/) {
    # whitelist to keep, domain match
}
elsif ($_ =~ /i\.whitelist-domain\.com/) {
    # whitelist to keep, subdomain match
}
else {
    # matched, do something about it with injection
}

---

我能想到的一个不太优雅的解决方案是用前缀注入全局替换所有 img url。

然后再进行一次全局替换，通过匹配“白名单”来移除前缀。

我的问题有更有效的解决方案吗？

谢谢。

Answer 1

1. 您可以使用HTML:TokeParser:Simple 定位img 标签并从其src 属性中提取url。

2. 您可以使用URI:URL从url中提取主机名。

3. 您可以将白名单转换为a set，以便轻松高效地查找主机名。

4. 您可以使用s// 运算符包装不在白名单中的主机名。

---

use strict;
use warnings; 
use 5.020;
use HTML::TokeParser::Simple;
use URI::URL;
use List::Util qw{ any };

my @white_list = qw(
    s3.static.cdn.net
    cdn.domain.com
    whitelist-domain.net
    i.whitelist-domain.com
);
#Create a set:
my %white_list = map {$_ => undef} @white_list;

my @accepted_keywords = qw(
    xxx.xxx
    cool
);
#Escape any special regex characters appearing in the keywords:
@accepted_keywords = map { quotemeta $_ } @accepted_keywords;

my $wrapper_host = "wrapper-url.com";

my $content = <<END_OF_CONTENT;
ABC <img src="http://i.whitelist-domain.com/keep.jpg">
DEF <img src="http://random-url.com/replace.jpg">
GHI <img src="http://cdn.domain.com/keep.jpg">
XYZ <img src="http://random-url.com/replace.jpg">
ZZZ <img src="http://xxx.xxx/keep.jpg">
ZZZ <img src="http://xxxXxxx/replace.jpg">
ZZZ <img src="http://waycool.com/keep.jpg">
END_OF_CONTENT

my $parser = HTML::TokeParser::Simple->new(\$content);

my ($src, $url, $host, $regex);
while (my $token = $parser->get_token() ) {

    if ($token->is_tag('img') ) {
        if ($src = $token->get_attr('src') ) {
            $url = URI::URL->new($src);
            $host = $url->host;

            next if exists($white_list{$host});
            next if any { $host =~ /$_/ } @accepted_keywords;

            $src =~ s/(http:\/\/)/$1$wrapper_host\//xms;
            $token->set_attr(
                'src',
                $src,
            );

        }
    }
}
continue {
    print $token->as_is;
}

--output:--
ABC <img src="http://i.whitelist-domain.com/keep.jpg">
DEF <img src="http://wrapper-url.com/random-url.com/replace.jpg">
GHI <img src="http://cdn.domain.com/keep.jpg">
XYZ <img src="http://wrapper-url.com/random-url.com/replace.jpg">
ZZZ <img src="http://xxx.xxx/keep.jpg">
ZZZ <img src="http://wrapper-url.com/xxxXxxx/replace.jpg">
ZZZ <img src="http://waycool.com/keep.jpg">

Answer 2

正如其他人所提到的，强烈建议不要使用 RE 来解析 HTML - 原因请参见 here（以及许多其他地方）。

由于您的示例数据简短而简单，只要牢记限制，您就可以忽略这些建议。一些

需要考虑的事情是；

1. 如果您的白名单关键字与域的一部分匹配怎么办？
2. 反之亦然 - 如果域 (.net) 是路径的一部分怎么办？
3. 如果方案不是 http(s) 会怎样？
4. 如果 URL 不在双引号中怎么办？或任何引用？
5. 如果“前置文本”中有看起来像标签的东西怎么办？
6. 白名单上的条目是否区分大小写？域名不是；路径是；那该怎么办？

我在以下解决方案中使用的几个原则是：

• 将正则表达式规范与正则表达式使用分开
• 始终使用扩展模式正则表达式，即：使用“/x”选项
• 对白名单进行预处理，以制作一系列 RE“测试”以通过
• unix 过滤器样式 - 在 STDIN 上读取，在 STDOUT 上写入，在 STDERR 上发出警告
• 使用模块来详细处理 URL 的各个部分

考虑到这些事情，这基本上可以做到；

use v5.12;
use URI::URL;

my $wrapper_host   =  "wrapper-url.com" ;
my $whitelist_file =  "whitelist.txt"   ;
URI::URL::strict 1;   # Will croak if cannot determine scheme

my $text_re    = qr/ ^ ( \s* [^<]+ \s* ) /x ;
my $quoted_str = qr/ " ( [^"]+ ) " /x ;
my $img_tag_re = qr/ < img \s+ src= $quoted_str >  /x ;

my @whitelist_rules ;
open(my $white, '<', $whitelist_file) or die "$whitelist_file: $!\n" ;
while (<$white>) {
    chomp;
    s/\./\\./;   # escape '.'
    push @whitelist_rules, qr/$_/ ;
}
close $white ;

while (<>) {

    # Parse the line into text and url
    my $text;  my $url;
    if (/ $text_re  $img_tag_re /x) {
        $text = $1 ;
        $url = new URI::URL $2 ;  # may croak
    }
    else {
        warn "Can't make sense of line $., skipping..." ;
        next ;
    }

    # iterate over @whitelist_rules to see if this one is exempt
    my $on_whitelist = 0;
    for my $r (@whitelist_rules) {
        $on_whitelist++ if $url =~ /$r/i ;            # Note: '/i'
        # $on_whitelist++ if $url->netloc =~ /$r/i ;  # alternatively ...
        # $on_whitelist++ if $url->path   =~ /$r/i ;  # alternatively ...
    }

    # If its not on the whitelist, wrap netloc
    if ( ! $on_whitelist )  {
        $url->path( $url->netloc . $url->path );
        $url->netloc( $wrapper_host );
    }

    # output the transformed line
    say $text . $url ;
}