Question

我正在尝试使用以下正则表达式在Perl中进行匹配：

s/<font(.*?)>[\t\f ]*<\/font>//gi;

我想要的是删除所有内部没有任何内容的字体标记。

不幸的是，它在第<font >后不会停止，直到>之前为止。

关于正则表达式有什么问题的任何指示？

my $text1 = '<font color="#008080"><span style="background: #ffffff"></span></font>';
my $text2 = '<font color="#008080">    s</font>';
my $text2 = '<font></font>';
$text1 =~ s/<font(.*?)>[\t\f ]*<\/font>//gi;
$text2 =~ s/<font(.*?)>[\t\f ]*<\/font>//gi;
$text3 =~ s/<font(.*?)>[\t\f ]*<\/font>//gi;
print "$text1\n$text2\n$text3\n";

将打印

 
<font>s</font>

Answer 1

如果您使用的是XHTML，那么使用XML::Twig非常简单：

use XML::Twig;

my $string = <<"HTML";
<?xml version="1.0"?>
<html>
<font color="#008080"><span style="background: #ffffff"></span></font>
<font color="#008080">    s</font>
<font></font>
</html>
HTML

use XML::Twig;
my $twig = XML::Twig->new( 
    pretty_print => 'nice',
    twig_handlers => {
        span => \&delete_empty,
        font => \&delete_empty,
        },
    );
$twig->parse( $string );

$twig->print;

sub delete_empty {
    my( $twig, $element ) = @_;

    $element->delete unless $element->text =~ /\S/;
    }

你也可以使用HTML::Tree，但我现在没有时间写一个例子（现在我做了，Greg Bacon has already done it）。我没有在InformIT的Process HTML with a Perl Module文章中向您展示如何执行此特定任务，但大多数部分都在那里。

Answer 2

强制警告：You shouldn't use regex to parse HTML。

虽然.*?是懒惰的，但这并不意味着它会避免匹配成功。在$ text1中，

<font color="#008080"><span style="background: #ffffff"></span></font>

通过让<font(.*?)>[\t\f ]*<\/font>与.*?匹配，可以匹配" color="#008080"></span"。这是最短匹配，会导致匹配成功。

如果您想在第一个>停留，请使用

s|<font[^>]*>\s*</font>||gi
#      ^^^^

这假定>标记内不会显示。（示例违规：2">。）

Answer 3

下面的代码使用HTML::TreeBuilder模块，该模块是解析HTML的合适工具。正则表达式不是。

#! /usr/bin/perl

use warnings;
use strict;

use HTML::TreeBuilder;

您问题中的测试用例：

my @cases = (
  '<font color="#008080"><span style="background: #ffffff"></span></font>',
  '<font color="#008080">    s</font>',
  '<font></font>',
);

我们会使用is_empty作为look_down HTML::Element方法的谓词来查找没有感兴趣内容的元素。

sub is_empty {
  my($font) = @_;

  my $is_interesting = sub {
    for ($_[0]->content_list) {
      return 1 if !ref($_) && /\S/;
    }
  };

  !$font->look_down($is_interesting);
}

最后是主循环。对于每个片段，我们创建一个新的HTML::TreeBuilder实例，删除空的元素，并修剪剩余的第一级文本内容。

foreach my $html (@cases) {
  my $tree = HTML::TreeBuilder->new_from_content($html);
  $_->detach for $tree->guts->look_down(_tag => "font", \&is_empty);

  my $result = "";
  if ($tree->guts) {
    foreach my $font ($tree->guts->look_down(_tag => "font")) {
      $font->attr($_,undef) for $font->all_external_attr_names;
      foreach my $text ($font->content_refs_list) {
        next if ref $$text;
        $$text =~ s/^\s+//;
        $$text =~ s/\s+$//;
      }
    }

    ($result = $tree->guts->as_HTML) =~ s/\s+$//;
  }

  print "$result\n";
}

输出：

    
<font>s</font>

两次传球是草率的。代码可以改进：

#! /usr/bin/perl

use warnings;
use strict;

use HTML::TreeBuilder;

my @cases = (
  '<font color="#008080"><span style="background: #ffffff"></span></font>',
  '<font color="#008080">    s</font>',
  '<font></font>',
);

foreach my $fragment (@cases) {
  my $tree = HTML::TreeBuilder->new_from_content($fragment);
  foreach my $font ($tree->guts->look_down(_tag => "font")) {
    $font->detach, next
      unless $font->look_down(sub { grep !ref && /\S/ => $_[0]->content_list });

    $font->attr($_,undef) for $font->all_external_attr_names;
    foreach my $text ($font->content_refs_list) {
      next if ref $$text;
      $$text =~ s/^\s+//;
      $$text =~ s/\s+$//;
    }
  }

  (my $cleaned = $tree->guts ? $tree->guts->as_HTML : "") =~ s/\s+$//;
  print $cleaned, "\n";
}

Answer 4

我真的很喜欢HTML::TokeParser::Simple。所以，对于多样性，这是另一种方式：

#!/usr/bin/perl

use strict; use warnings;
use HTML::TokeParser::Simple;

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

while ( my $stag = $parser->get_token ) {
    if ( $stag->is_start_tag( qr/font|span/ ) ) {
        my $closer = '/' . $stag->get_tag;
        my $text   = $parser->get_text( $closer );
        my $etag   = $parser->get_tag( $closer );

        if ( $text =~ /\S/ ) {
            $text =~ s/^\s+//;
            $text =~ s/\s+\z//;
            print $stag->as_is, $text, $etag->as_is;
        }
    }
    else {
        print $stag->as_is;
    }
}


__DATA__
<h1>Test heading</h1>
<p>Here is some <b>sample</b> <em>text</em>: <span>one</span>
<font color="#008080"><span style="background: #ffffff"></span></font>
<font color="#008080">    s</font>
<font></font></p>

<h2>A subtitle</h2>
<p><q>this is a test</q>: ya ba da ba doo!</p>
</body>

输出：

<h1>Test heading</h1>
<p>Here is some <b>sample</b> <em>text</em>: <span>one</span>

<font color="#008080">s</font>
</p>

<h2>A subtitle</h2>
<p><q>this is a test</q>: ya ba da ba doo!</p>
</body>

Answer 5

s/<font[^>]*>\s*<\/font>//gi;

非贪婪的.*?尝试消耗最少数量的字符，但需要尽可能多的数量来实现整体匹配。如果您将其替换为[^>]*，则>必须与 next >匹配，否则匹配尝试将失败。

请注意，>出现在属性值中是合法的，因此此解决方案不是100％保证。幸运的是，知道这个小漏洞的人也明智地不使用它;我从未在野外的属性值中看到过尖括号。

如何使用Perl删除除了空格之外只有空格的所有字体标记？

5 个答案: