如何使用Perl进行条件regex全局替换

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都将使用包装URL前缀进行编辑。

我的想法是：

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

我不知道如何进行条件regex全局替换，因为所有内容都在一个单行字符串变量中。

我需要用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——原因请参见此处（以及许多其他地方）。

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

需要考虑的事情是；

1. 如果你的白名单关键字与部分域名匹配怎么办
2. 反之亦然-如果域（.net）是路径的一部分怎么办
3. 如果该方案不是http（s），会发生什么
4. 如果URL没有双引号怎么办？或者有报价吗
5. 如果在"预文本"中有一个看起来像标签的东西怎么办
6. 白名单上的条目是否区分大小写？域名不是；路径是；那么该怎么办呢

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

• 将正则表达式规范与正则表达式使用分开
• 始终使用扩展模式regexs即：使用"/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 ;
}