哦,是的,您可以使用正则表达式来解析HTML!
对于您要尝试的任务,正则表达式非常好!
这是事实,大多数人都低估了解析HTML的正则表达式的难度,因此这样做不好。
但这不是与计算理论有关的一些基本缺陷。愚蠢在这里到处都是鹦鹉,但是你不相信他们。
因此,尽管可以肯定地做到了(此发布可以证明这一无可争辩的事实的存在),但这并不意味着 应该 如此。
您必须自己决定是否要完成用正则表达式编写相当于专用,专用HTML解析器的任务。大多数人不是。
但是我是。☻
基于常规正则表达式的HTML解析解决方案
首先,我将展示使用正则表达式解析任意 HTML 多么容易。完整程序位于本文的结尾,但是解析器的核心是:
for (;;) {
given ($html) {
last when (pos || 0) >= length;
printf "\@%d=", (pos || 0);
print "doctype " when / \G (?&doctype) $RX_SUBS /xgc;
print "cdata " when / \G (?&cdata) $RX_SUBS /xgc;
print "xml " when / \G (?&xml) $RX_SUBS /xgc;
print "xhook " when / \G (?&xhook) $RX_SUBS /xgc;
print "script " when / \G (?&script) $RX_SUBS /xgc;
print "style " when / \G (?&style) $RX_SUBS /xgc;
print "comment " when / \G (?&comment) $RX_SUBS /xgc;
print "tag " when / \G (?&tag) $RX_SUBS /xgc;
print "untag " when / \G (?&untag) $RX_SUBS /xgc;
print "nasty " when / \G (?&nasty) $RX_SUBS /xgc;
print "text " when / \G (?&nontag) $RX_SUBS /xgc;
default {
die "UNCLASSIFIED: " .
substr($_, pos || 0, (length > 65) ? 65 : length);
}
}
}
看到那是多么容易阅读?
如所写,它标识每段HTML,并告诉它在哪里找到。您可以轻松地对其进行修改,以使用任何给定类型的作品,或者针对比这些更特殊的类型,做任何您想做的事情。
我没有失败的测试用例(左:):我已经在100,000多个HTML文件上成功运行了此代码-我可以快速,轻松地获得每个文件。除了这些,我还对专门为打破朴素的解析器而构建的文件运行了它。
这不是一个幼稚的解析器。
哦,我确定它不是完美的,但是我还没有打破它。我认为,即使有什么事情发生,由于程序的结构清晰,此修复程序也很容易安装。即使是正则表达式繁重的程序也应具有结构。
既然已经解决了,让我解决OP的问题。
使用正则表达式解决OP任务的演示
html_input_rx
我下面包含的小程序产生以下输出,因此您可以看到使用正则表达式解析HTML可以很好地完成您想做的事情:
% html_input_rx Amazon.com-_Online_Shopping_for_Electronics,_Apparel,_Computers,_Books,_DVDs_\&_more.htm
input tag #1 at character 9955:
class => "searchSelect"
id => "twotabsearchtextbox"
name => "field-keywords"
size => "50"
style => "width:100%; background-color: #FFF;"
title => "Search for"
type => "text"
value => ""
input tag #2 at character 10335:
alt => "Go"
src => "http://g-ecx.images-amazon.com/images/G/01/x-locale/common/transparent-pixel._V192234675_.gif"
type => "image"
解析输入标签,请参见“无恶意输入”
这是产生以上输出的程序的源代码。
#!/usr/bin/env perl
#
# html_input_rx - pull out all <input> tags from (X)HTML src
# via simple regex processing
#
# Tom Christiansen <tchrist@perl.com>
# Sat Nov 20 10:17:31 MST 2010
#
################################################################
use 5.012;
use strict;
use autodie;
use warnings FATAL => "all";
use subs qw{
see_no_evil
parse_input_tags
input descape dequote
load_patterns
};
use open ":std",
IN => ":bytes",
OUT => ":utf8";
use Encode qw< encode decode >;
###########################################################
parse_input_tags
see_no_evil
input
###########################################################
until eof(); sub parse_input_tags {
my $_ = shift();
our($Input_Tag_Rx, $Pull_Attr_Rx);
my $count = 0;
while (/$Input_Tag_Rx/pig) {
my $input_tag = $+{TAG};
my $place = pos() - length ${^MATCH};
printf "input tag #%d at character %d:\n", ++$count, $place;
my %attr = ();
while ($input_tag =~ /$Pull_Attr_Rx/g) {
my ($name, $value) = @+{ qw< NAME VALUE > };
$value = dequote($value);
if (exists $attr{$name}) {
printf "Discarding dup attr value '%s' on %s attr\n",
$attr{$name} // "<undef>", $name;
}
$attr{$name} = $value;
}
for my $name (sort keys %attr) {
printf " %10s => ", $name;
my $value = descape $attr{$name};
my @Q; given ($value) {
@Q = qw[ " " ] when !/'/ && !/"/;
@Q = qw[ " " ] when /'/ && !/"/;
@Q = qw[ ' ' ] when !/'/ && /"/;
@Q = qw[ q( ) ] when /'/ && /"/;
default { die "NOTREACHED" }
}
say $Q[0], $value, $Q[1];
}
print "\n";
}
}
sub dequote {
my $_ = $_[0];
s{
(?<quote> ["'] )
(?<BODY>
(?s: (?! \k<quote> ) . ) *
)
\k<quote>
}{$+{BODY}}six;
return $_;
}
sub descape {
my $string = $_[0];
for my $_ ($string) {
s{
(?<! % )
% ( \p{Hex_Digit} {2} )
}{
chr hex $1;
}gsex;
s{
& \043
( [0-9]+ )
(?: ;
| (?= [^0-9] )
)
}{
chr $1;
}gsex;
s{
& \043 x
( \p{ASCII_HexDigit} + )
(?: ;
| (?= \P{ASCII_HexDigit} )
)
}{
chr hex $1;
}gsex;
}
return $string;
}
sub input {
our ($RX_SUBS, $Meta_Tag_Rx);
my $_ = do { local $/; <> };
my $encoding = "iso-8859-1"; # web default; wish we had the HTTP headers :(
while (/$Meta_Tag_Rx/gi) {
my $meta = $+{META};
next unless $meta =~ m{ $RX_SUBS
(?= http-equiv )
(?&name)
(?&equals)
(?= (?"e)? content-type )
(?&value)
}six;
next unless $meta =~ m{ $RX_SUBS
(?= content ) (?&name)
(?&equals)
(?<CONTENT> (?&value) )
}six;
next unless $+{CONTENT} =~ m{ $RX_SUBS
(?= charset ) (?&name)
(?&equals)
(?<CHARSET> (?&value) )
}six;
if (lc $encoding ne lc $+{CHARSET}) {
say "[RESETTING ENCODING $encoding => $+{CHARSET}]";
$encoding = $+{CHARSET};
}
}
return decode($encoding, $_);
}
sub see_no_evil {
my $_ = shift();
s{ <! DOCTYPE .*? > }{}sx;
s{ <! \[ CDATA \[ .*? \]\] > }{}gsx;
s{ <script> .*? </script> }{}gsix;
s{ <!-- .*? --> }{}gsx;
return $_;
}
sub load_patterns {
our $RX_SUBS = qr{ (?(DEFINE)
(?<nv_pair> (?&name) (?&equals) (?&value) )
(?<name> \b (?= \pL ) [\w\-] + (?<= \pL ) \b )
(?<equals> (?&might_white) = (?&might_white) )
(?<value> (?"ed_value) | (?&unquoted_value) )
(?<unwhite_chunk> (?: (?! > ) \S ) + )
(?<unquoted_value> [\w\-] * )
(?<might_white> \s * )
(?<quoted_value>
(?<quote> ["'] )
(?: (?! \k<quote> ) . ) *
\k<quote>
)
(?<start_tag> < (?&might_white) )
(?<end_tag>
(?&might_white)
(?: (?&html_end_tag)
| (?&xhtml_end_tag)
)
)
(?<html_end_tag> > )
(?<xhtml_end_tag> / > )
) }six;
our $Meta_Tag_Rx = qr{ $RX_SUBS
(?<META>
(?&start_tag) meta \b
(?:
(?&might_white) (?&nv_pair)
) +
(?&end_tag)
)
}six;
our $Pull_Attr_Rx = qr{ $RX_SUBS
(?<NAME> (?&name) )
(?&equals)
(?<VALUE> (?&value) )
}six;
our $Input_Tag_Rx = qr{ $RX_SUBS
(?<TAG> (?&input_tag) )
(?(DEFINE)
(?<input_tag>
(?&start_tag)
input
(?&might_white)
(?&attributes)
(?&might_white)
(?&end_tag)
)
(?<attributes>
(?:
(?&might_white)
(?&one_attribute)
) *
)
(?<one_attribute>
\b
(?&legal_attribute)
(?&might_white) = (?&might_white)
(?:
(?"ed_value)
| (?&unquoted_value)
)
)
(?<legal_attribute>
(?: (?&optional_attribute)
| (?&standard_attribute)
| (?&event_attribute)
# for LEGAL parse only, comment out next line
| (?&illegal_attribute)
)
)
(?<illegal_attribute> (?&name) )
(?<required_attribute> (?#no required attributes) )
(?<optional_attribute>
(?&permitted_attribute)
| (?&deprecated_attribute)
)
# NB: The white space in string literals
# below DOES NOT COUNT! It's just
# there for legibility.
(?<permitted_attribute>
accept
| alt
| bottom
| check box
| checked
| disabled
| file
| hidden
| image
| max length
| middle
| name
| password
| radio
| read only
| reset
| right
| size
| src
| submit
| text
| top
| type
| value
)
(?<deprecated_attribute>
align
)
(?<standard_attribute>
access key
| class
| dir
| ltr
| id
| lang
| style
| tab index
| title
| xml:lang
)
(?<event_attribute>
on blur
| on change
| on click
| on dbl click
| on focus
| on mouse down
| on mouse move
| on mouse out
| on mouse over
| on mouse up
| on key down
| on key press
| on key up
| on select
)
)
}six;
}
UNITCHECK {
load_patterns();
}
END {
close(STDOUT)
|| die "can't close stdout: $!";
}
你去!没事!:)
只有 您才能判断您使用正则表达式的技能是否适合任何特定的解析任务。每个人的技能水平都不同,每个新任务也不同。对于具有定义明确的输入集的作业,正则表达式显然是正确的选择,因为当您要处理的HTML子集很有限时,将某些表达式放在一起是很简单的。即使是正则表达式初学者也应该使用正则表达式来处理这些工作。其他任何东西都不过分。
但是,一旦HTML开始变得不那么固定,一旦它以无法预测的方式开始分支,而这是完全合法的,一旦必须匹配更多不同的事物或具有更复杂的依赖关系,最终将达到与使用解析类相比,您必须更加努力地实现使用正则表达式的解决方案。收支平衡点下降的位置再次取决于您对正则表达式的舒适度。
所以我该怎么做?
我不会告诉您您必须做什么或不能做什么。我认为那是错误的。我只想向您介绍各种可能性,请睁开您的眼睛。您可以选择想要做的事情以及想要做的事情。没有绝对的东西,没有人比你自己更了解自己的处境。如果看起来有些工作太多,那么也许是。您知道,编程应该很有趣。如果不是,您可能做错了。
可以html_input_rx
用许多有效的方式查看我的程序。其中之一就是您确实可以使用正则表达式解析HTML。但是另一个是,它比几乎任何人都认为的要困难得多。这很容易得出这样的结论,我的计划是一个证明,你应该什么不能做,因为它真的是太辛苦了。
我不会不同意这一点。当然,如果经过研究后,我在程序中所做的一切对您没有意义,那么您不应该尝试将正则表达式用于此类任务。对于特定的HTML,正则表达式非常有用,但是对于通用HTML,它们相当于疯狂。我一直都在使用解析类,特别是如果它不是我自己生成的HTML。
正则表达式最适合小型 HTML解析问题,正则表达式最适合大型HTML解析问题
即使我的节目被认为是说明性的,为什么你应该不使用正则表达式解析普通HTML -这是OK的,因为我还挺意味着它是☺ -它仍然应该是一个大开眼界让更多的人打破了非常常见的和令人讨厌,讨厌的习惯,即编写无法阅读,无法结构化和无法维护的模式。
模式不必太丑陋,也不必很难。如果您创建丑陋的图案,那是对您的反映,而不是对它们的反映。
出色的正则表达式语言
我被要求指出,我为您的问题提供的解决方案是用Perl编写的。你惊喜吗?你没注意到吗?这个启示是重磅炸弹吗?
的确,就正则表达式而言,并非所有其他工具和编程语言都像Perl一样方便,高效且功能强大。那里的频谱很大,有些频谱比其他频谱更合适。通常,将正则表达式表示为核心语言的一部分而不是库的语言更易于使用。我对正则表达式没有做任何事情,例如PCRE,但是如果使用C,则结构会有所不同。
最终,其他语言将赶上Perl的正则表达式。我之所以这样说,是因为当Perl启动时,没有其他人拥有Perl的正则表达式。随便说什么,但这就是Perl明显赢得胜利的地方:每个人都复制了Perl的正则表达式,尽管它们的发展阶段不同。无论您使用哪种工具或语言,Perl几乎(不是全部,但几乎)都是当今现代模式所依赖的一切的开创者。所以最终其他人会追上。
但是他们只会赶上Perl过去的某个时间,就像现在一样。一切都在进步。在正则表达式中,如果没有别的什么(Perl领导),其他人就会紧随其后。一旦其他所有人最终赶上了Perl的现在,Perl将会在哪里?我不知道,但我知道我们也将搬家。也许我们会更接近Perl₆的手工艺品样式。
如果您喜欢这种东西但想在Perl₅中使用它,您可能会对Damian Conway的精彩 Regexp :: Grammars模块感兴趣。它是非常棒的,并且使我在程序中所做的一切看起来像原始的东西一样,就像我的原始样式使人们在不使用空格或字母标识符的情况下拼凑而成。看看这个!
简单的HTML块
这是我在发布之初显示的核心分析器的完整信息。
我不建议您在经过严格测试的解析类上使用此方法。但是我厌倦了人们假装没有人会因为正则表达式不能解析HTML而使用它们。您显然可以,该程序就是该断言的证明。
当然,这是不容易的,但它是可能的!
尝试这样做会浪费大量时间,因为存在良好的解析类,您可以将其用于此任务。对于试图解析任意 HTML的人们来说,正确的答案并不是不可能。那是一个轻率而轻率的答案。正确和诚实的答案是,他们不应尝试此操作,因为从头开始很难解决。他们不应该为重新设计一个效果很好的车轮而退缩。
另一方面,属于可预测子集的 HTML 非常容易用正则表达式进行解析。难怪人们会尝试使用它们,因为对于小问题,也许是玩具问题,没有什么比这更容易了。这就是为什么区分这两项任务(特定任务与一般任务)如此重要的原因,因为它们不一定需要相同的方法。
我希望将来在这里能看到关于HTML和正则表达式的问题的更公正和诚实的处理。
这是我的HTML词法分析器。它不会尝试进行验证解析;它仅标识词汇元素。您可能将其更多地视为HTML块而不是HTML解析器。尽管它在该方向上允许一些很小的余量,但它并不是很宽容的HTML破损。
即使您自己从来没有解析完整的HTML(为什么要这么做?这也是一个已解决的问题!),该程序也有很多很酷的regex位,我相信很多人可以从中学到很多东西。请享用!
#!/usr/bin/env perl
#
# chunk_HTML - a regex-based HTML chunker
#
# Tom Christiansen <tchrist@perl.com
# Sun Nov 21 19:16:02 MST 2010
########################################
use 5.012;
use strict;
use autodie;
use warnings qw< FATAL all >;
use open qw< IN :bytes OUT :utf8 :std >;
MAIN: {
$| = 1;
lex_html(my $page = slurpy());
exit();
}
########################################################################
sub lex_html {
our $RX_SUBS; ###############
my $html = shift(); # Am I... #
for (;;) { # forgiven? :)#
given ($html) { ###############
last when (pos || 0) >= length;
printf "\@%d=", (pos || 0);
print "doctype " when / \G (?&doctype) $RX_SUBS /xgc;
print "cdata " when / \G (?&cdata) $RX_SUBS /xgc;
print "xml " when / \G (?&xml) $RX_SUBS /xgc;
print "xhook " when / \G (?&xhook) $RX_SUBS /xgc;
print "script " when / \G (?&script) $RX_SUBS /xgc;
print "style " when / \G (?&style) $RX_SUBS /xgc;
print "comment " when / \G (?&comment) $RX_SUBS /xgc;
print "tag " when / \G (?&tag) $RX_SUBS /xgc;
print "untag " when / \G (?&untag) $RX_SUBS /xgc;
print "nasty " when / \G (?&nasty) $RX_SUBS /xgc;
print "text " when / \G (?&nontag) $RX_SUBS /xgc;
default {
die "UNCLASSIFIED: " .
substr($_, pos || 0, (length > 65) ? 65 : length);
}
}
}
say ".";
}
#####################
# Return correctly decoded contents of next complete
# file slurped in from the <ARGV> stream.
#
sub slurpy {
our ($RX_SUBS, $Meta_Tag_Rx);
my $_ = do { local $/; <ARGV> }; # read all input
return unless length;
use Encode qw< decode >;
my $bom = "";
given ($_) {
$bom = "UTF-32LE" when / ^ \xFf \xFe \0 \0 /x; # LE
$bom = "UTF-32BE" when / ^ \0 \0 \xFe \xFf /x; # BE
$bom = "UTF-16LE" when / ^ \xFf \xFe /x; # le
$bom = "UTF-16BE" when / ^ \xFe \xFf /x; # be
$bom = "UTF-8" when / ^ \xEF \xBB \xBF /x; # st00pid
}
if ($bom) {
say "[BOM $bom]";
s/^...// if $bom eq "UTF-8"; # st00pid
# Must use UTF-(16|32) w/o -[BL]E to strip BOM.
$bom =~ s/-[LB]E//;
return decode($bom, $_);
# if BOM found, don't fall through to look
# for embedded encoding spec
}
# Latin1 is web default if not otherwise specified.
# No way to do this correctly if it was overridden
# in the HTTP header, since we assume stream contains
# HTML only, not also the HTTP header.
my $encoding = "iso-8859-1";
while (/ (?&xml) $RX_SUBS /pgx) {
my $xml = ${^MATCH};
next unless $xml =~ m{ $RX_SUBS
(?= encoding ) (?&name)
(?&equals)
(?"e) ?
(?<ENCODING> (?&value) )
}sx;
if (lc $encoding ne lc $+{ENCODING}) {
say "[XML ENCODING $encoding => $+{ENCODING}]";
$encoding = $+{ENCODING};
}
}
while (/$Meta_Tag_Rx/gi) {
my $meta = $+{META};
next unless $meta =~ m{ $RX_SUBS
(?= http-equiv ) (?&name)
(?&equals)
(?= (?"e)? content-type )
(?&value)
}six;
next unless $meta =~ m{ $RX_SUBS
(?= content ) (?&name)
(?&equals)
(?<CONTENT> (?&value) )
}six;
next unless $+{CONTENT} =~ m{ $RX_SUBS
(?= charset ) (?&name)
(?&equals)
(?<CHARSET> (?&value) )
}six;
if (lc $encoding ne lc $+{CHARSET}) {
say "[HTTP-EQUIV ENCODING $encoding => $+{CHARSET}]";
$encoding = $+{CHARSET};
}
}
return decode($encoding, $_);
}
########################################################################
# Make sure to this function is called
# as soon as source unit has been compiled.
UNITCHECK { load_rxsubs() }
# useful regex subroutines for HTML parsing
sub load_rxsubs {
our $RX_SUBS = qr{
(?(DEFINE)
(?<WS> \s * )
(?<any_nv_pair> (?&name) (?&equals) (?&value) )
(?<name> \b (?= \pL ) [\w:\-] + \b )
(?<equals> (?&WS) = (?&WS) )
(?<value> (?"ed_value) | (?&unquoted_value) )
(?<unwhite_chunk> (?: (?! > ) \S ) + )
(?<unquoted_value> [\w:\-] * )
(?<any_quote> ["'] )
(?<quoted_value>
(?<quote> (?&any_quote) )
(?: (?! \k<quote> ) . ) *
\k<quote>
)
(?<start_tag> < (?&WS) )
(?<html_end_tag> > )
(?<xhtml_end_tag> / > )
(?<end_tag>
(?&WS)
(?: (?&html_end_tag)
| (?&xhtml_end_tag) )
)
(?<tag>
(?&start_tag)
(?&name)
(?:
(?&WS)
(?&any_nv_pair)
) *
(?&end_tag)
)
(?<untag> </ (?&name) > )
# starts like a tag, but has screwed up quotes inside it
(?<nasty>
(?&start_tag)
(?&name)
.*?
(?&end_tag)
)
(?<nontag> [^<] + )
(?<string> (?"ed_value) )
(?<word> (?&name) )
(?<doctype>
<!DOCTYPE
# please don't feed me nonHTML
### (?&WS) HTML
[^>]* >
)
(?<cdata> <!\[CDATA\[ .*? \]\] > )
(?<script> (?= <script ) (?&tag) .*? </script> )
(?<style> (?= <style ) (?&tag) .*? </style> )
(?<comment> <!-- .*? --> )
(?<xml>
< \? xml
(?:
(?&WS)
(?&any_nv_pair)
) *
(?&WS)
\? >
)
(?<xhook> < \? .*? \? > )
)
}six;
our $Meta_Tag_Rx = qr{ $RX_SUBS
(?<META>
(?&start_tag) meta \b
(?:
(?&WS) (?&any_nv_pair)
) +
(?&end_tag)
)
}six;
}
# nobody *ever* remembers to do this!
END { close STDOUT }