使用Perl除HTML标签外的其他内容

6
我一直在寻找一种方法,可以从HTML文档中剥离除了HTML标签以外的所有内容。有没有人知道这方面的方法?我熟悉许多Perl模块,并且已经仔细搜索了这个网站。
我想把HTML作为字符串传递给我的Perl脚本,并删除除标签以外的所有内容。以下是一个示例:
输入:
<!doctype html>
<html>
<head>
<title>Example Domain</title>

<meta charset="utf-8" />
<meta http-equiv="Content-type" content="text/html; charset=utf-8" />
<meta name="viewport" content="width=device-width, initial-scale=1" />
<style type="text/css">
body {
    background-color: #f0f0f2;
    margin: 0;
    padding: 0;
    font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif;

}
div {
    width: 600px;
    margin: 5em auto;
    padding: 50px;
    background-color: #fff;
    border-radius: 1em;
}
a:link, a:visited {
    color: #38488f;
    text-decoration: none;
}
@media (max-width: 700px) {
    body {
        background-color: #fff;
    }
    div {
        width: auto;
        margin: 0 auto;
        border-radius: 0;
        padding: 1em;
    }
}
</style>    
</head>

<body>
<div>
    website content ....
</div>
</body>
</html>

Becomes:

<html><head><title></title><meta><meta><meta><style></style></head><body><div><h1></h1>       <p></p><p><a></a></p></div></body></html>

成为什么?我讨厌人们... - hjpotter92
第一次使用此网站上的代码工具,已经修复了。 ;) - user2421267
你也想删除标签属性吗?如果是的话,你可以使用正则表达式像 /</?\w+?>/ 这样做。 - Robbert
这个应该可以解决问题:$text =~ s#[^<]*<(/?\w+).*?>[^<]*#$1#sg; - Vedran Šego
1
在线演示 注意,如果内容包含 <,则此方法将失败,因此您应该使用 DOM。 - HamZa
3个回答

2
#!/usr/bin/perl --
use strict;
use warnings;
use XML::Twig;

Main( @ARGV );
exit( 0 );

sub Main {
    if( @_ ){
        nothing_but_tags("$_") for @_;
    } else {
        nothing_but_tags(q{<NoTe
KunG="FoO"
ChOp="SuEy"> 
NoteKungFo0Ch0pSuEy
<To KunG="FoO">ToKungFo0 
<Person KunG="FoO">Satan</Person>
</To>
<Beef KunG="FoO"> BeefKunGFoO <SaUsAGe KunG="FoO">is Tasty
</SaUsAGe>
</Beef>
</NoTe>},
        );
    }
}

sub nothing_but_tags
{
    my( $input, %opt ) = @_;

    $opt{pretty_print}  ||= 'indented' ;

    my $t = XML::Twig->new(
        %opt,
        force_end_tag_handlers_usage => 1,
        start_tag_handlers => {
            _all_ =>  sub {
                if( $_->has_atts ){
                    $_->set_atts ({});
                }
                return;
            },
        },
        end_tag_handlers => { _all_ =>  sub { $_->flush; return }, },
        char_handler => sub { '' },
    );
    $t->xparse( $_[0] );
    $t->flush();
    ();
}
__END__
<NoTe>
  <To>
    <Person></Person>
  </To>
  <Beef>
    <SaUsAGe></SaUsAGe>
  </Beef>
</NoTe>

0

使用XSLT进行这样的转换非常简单,因此这里提供一个使用XML::LibXSLT的示例。

#!/usr/bin/perl
use strict;

use XML::LibXML;
use XML::LibXSLT;

my $filename = $ARGV[0] or die("Usage: $0 filename\n");
my $doc      = XML::LibXML->load_html(location => $filename);

my $stylesheet_doc = XML::LibXML->load_xml(string => <<'EOF');
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
    <xsl:template match="*">
        <xsl:copy>
            <xsl:apply-templates select="*"/>
        </xsl:copy>
    </xsl:template>
</xsl:stylesheet>
EOF

my $xslt       = XML::LibXSLT->new;
my $stylesheet = $xslt->parse_stylesheet($stylesheet_doc);
my $result     = $stylesheet->transform($doc);

print $result->serialize_html;

0
我不确定我是否正确理解了你的问题,但是如果要仅保留标签,你可以使用strip tags(仅剥离标签)函数来获取输出,然后在原始文本中用null替换此输出。理论上,第一个函数将为您提供标签外的确切文本,下一步将替换此文本为空值。

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接