Question

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

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

例如，假设$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中实现它。

其他信息：

我的白名单＆＃39;目前只有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。

然后执行另一个全局替换，通过匹配＆＃39;白名单来删除前缀。

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

感谢。

Answer 1

正如其他人所提到的，强烈建议使用RE解析HTML - 请参阅here（其他许多地方）。

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

要考虑的事情是;

如果您的白名单关键字与域的一部分相匹配怎么办？
反之亦然 - 如果域（.net）是路径的一部分该怎么办？
如果该方案不是http（s），会发生什么？
如果网址不是双引号怎么办？或任何报价？
如果在＆＃34; pre-text＆＃34;
白名单上的条目区分大小写吗？域名不是;路径是;那该怎么办？

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

使用正则表达式单独的正则表达式规范
始终使用扩展模式正则表达式，即：使用＆＃39; / x＆＃39;选项
预处理白名单以制作一系列RE＆＃34;测试＆＃34;通过
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 ;
}

Answer 2

您可以使用HTML:TokeParser:Simple找到img标记并从其src属性中提取网址。
您可以使用URI:URL从网址中提取主机名。
您可以将白名单转换为a set，以便轻松有效地查找主机名。
您可以使用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">

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

2 个答案: