Ồ Có, bạn có thể sử dụng Regexes để phân tích HTML!
Đối với nhiệm vụ bạn đang cố gắng, regexes hoàn toàn tốt!
Đúng là hầu hết mọi người đều đánh giá thấp sự khó khăn của việc phân tích cú pháp HTML bằng các biểu thức thông thường và do đó làm rất kém.
Nhưng đây không phải là một lỗ hổng cơ bản liên quan đến lý thuyết tính toán. Sự điên cuồng đó được vẹt rất nhiều ở đây , nhưng bạn không tin họ.
Vì vậy, trong khi nó chắc chắn có thể được thực hiện (bài đăng này đóng vai trò là bằng chứng tồn tại của thực tế không thể chuyển đổi này), điều đó không có nghĩa là nó phải như vậy.
Bạn phải tự quyết định xem bạn có nhiệm vụ viết số tiền cho một trình phân tích cú pháp HTML chuyên dụng, chuyên dụng ra khỏi các biểu thức chính quy hay không. Hầu hết mọi người không.
Nhưng tôi là. ☻
Các giải pháp phân tích cú pháp HTML dựa trên Regex chung
Đầu tiên tôi sẽ chỉ ra cách dễ dàng phân tích HTML tùy ý với các biểu thức chính quy. Chương trình đầy đủ ở cuối bài đăng này, nhưng trung tâm của trình phân tích cú pháp là:
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);
}
}
}
Xem nó dễ đọc như thế nào?
Như được viết, nó xác định từng đoạn HTML và cho biết nơi nó tìm thấy mảnh đó. Bạn có thể dễ dàng sửa đổi nó để làm bất cứ điều gì khác mà bạn muốn với bất kỳ loại mảnh cụ thể nào, hoặc cho các loại cụ thể hơn loại này.
Tôi không gặp trường hợp thử nghiệm nào (bên trái :): Tôi đã chạy thành công mã này trên hơn 100.000 tệp HTML - mỗi một tệp tôi có thể nhanh chóng và dễ dàng sử dụng. Ngoài những thứ đó, tôi cũng chạy nó trên các tệp được xây dựng đặc biệt để phá vỡ các trình phân tích cú pháp ngây thơ.
Đây không phải là một trình phân tích cú pháp ngây thơ.
Ồ, tôi chắc chắn nó không hoàn hảo, nhưng tôi vẫn chưa thể phá vỡ nó. Tôi nghĩ rằng ngay cả khi một cái gì đó đã làm, sửa chữa sẽ dễ dàng phù hợp vì cấu trúc rõ ràng của chương trình. Ngay cả các chương trình regex-heavy nên có cấu trúc.
Bây giờ đã hết cách, hãy để tôi giải quyết câu hỏi của OP.
Bản trình diễn giải quyết nhiệm vụ của OP bằng cách sử dụng Regexes
html_input_rx
Chương trình nhỏ mà tôi đưa vào dưới đây tạo ra kết quả đầu ra sau đây, để bạn có thể thấy rằng phân tích cú pháp HTML bằng regexes hoạt động tốt cho những gì bạn muốn làm:
% 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"
Thẻ đầu vào phân tích cú pháp, không thấy đầu vào xấu
Đây là nguồn cho chương trình tạo ra đầu ra ở trên.
#!/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: $!";
}
Có bạn đi! Không có gì với nó! :)
Chỉ bạn mới có thể đánh giá xem kỹ năng của bạn với regexes có phụ thuộc vào bất kỳ tác vụ phân tích cụ thể nào không. Trình độ kỹ năng của mọi người là khác nhau, và mọi nhiệm vụ mới đều khác nhau. Đối với các công việc mà bạn có một bộ đầu vào được xác định rõ ràng, regexes rõ ràng là lựa chọn đúng đắn, bởi vì việc kết hợp một số thứ nhỏ lại với nhau khi bạn có một tập hợp con hạn chế của HTML để xử lý. Ngay cả những người mới bắt đầu regex cũng nên xử lý những công việc đó bằng regexes. Bất cứ điều gì khác là quá mức cần thiết.
Tuy nhiên , một khi HTML bắt đầu trở nên ít bị đóng đinh hơn, một khi nó bắt đầu lan man theo những cách bạn không thể dự đoán nhưng hoàn toàn hợp pháp, một khi bạn phải đối chiếu nhiều loại khác nhau hơn hoặc với các phụ thuộc phức tạp hơn, cuối cùng bạn sẽ đạt đến điểm bạn phải làm việc chăm chỉ hơn để tạo ra một giải pháp sử dụng các biểu thức chính quy hơn là bạn phải sử dụng một lớp phân tích cú pháp. Trường hợp điểm hòa vốn rơi lại phụ thuộc vào mức độ thoải mái của bạn với biểu thức chính quy.
Vậy tôi nên làm gì?
Tôi sẽ không nói với bạn những gì bạn phải làm hoặc những gì bạn không thể làm. Tôi nghĩ đó là sai. Tôi chỉ muốn tặng bạn những khả năng, mở mắt ra một chút. Bạn có thể chọn những gì bạn muốn làm và cách bạn muốn làm điều đó. Không có sự tuyệt đối - và không ai khác biết được tình huống của bạn cũng như chính bạn làm. Nếu một cái gì đó có vẻ như quá nhiều công việc, tốt, có lẽ nó là. Lập trình nên vui , bạn biết đấy. Nếu không, bạn có thể làm sai.
Người ta có thể nhìn vào html_input_rx
chương trình của tôi theo bất kỳ số cách hợp lệ nào. Một trong số đó là bạn thực sự có thể phân tích HTML bằng các biểu thức thông thường. Nhưng một điều nữa là nó rất nhiều, rất nhiều, khó hơn nhiều so với hầu hết mọi người từng nghĩ. Điều này có thể dễ dàng dẫn đến kết luận rằng chương trình của tôi là một minh chứng cho những gì bạn không nên làm, bởi vì nó thực sự quá khó.
Tôi sẽ không đồng ý với điều đó. Chắc chắn nếu mọi thứ tôi làm trong chương trình của tôi không có ý nghĩa với bạn sau một số nghiên cứu, thì bạn không nên cố gắng sử dụng regexes cho loại nhiệm vụ này. Đối với HTML cụ thể, biểu thức chính là tuyệt vời, nhưng đối với HTML chung, chúng tương đương với sự điên rồ. Tôi sử dụng các lớp phân tích cú pháp mọi lúc, đặc biệt nếu đó là HTML tôi không tự tạo.
Regexes tối ưu cho các vấn đề phân tích cú pháp HTML nhỏ , bi quan cho những vấn đề lớn
Ngay cả khi chương trình của tôi được lấy làm minh họa cho lý do tại sao bạn không nên sử dụng regexes để phân tích cú pháp HTML chung - điều đó cũng không sao, bởi vì tôi có nghĩa là nó - nó vẫn phải là một công cụ mở rộng để mọi người phá vỡ sự phổ biến khủng khiếp và thói quen khó chịu, khó chịu của việc viết các mẫu không thể đọc được, không có cấu trúc và không thể nhầm lẫn.
Các mẫu không phải là xấu, và chúng không phải là khó. Nếu bạn tạo ra các mẫu xấu xí, đó là một sự phản ánh về bạn, không phải chúng.
Ngôn ngữ Regex tinh tế phi thường
Tôi đã được yêu cầu chỉ ra rằng giải pháp chuyên sâu của tôi cho vấn đề của bạn đã được viết bằng Perl. Bạn có ngạc nhiên không Bạn đã không chú ý? Đây có phải là sự mặc khải?
Đúng là không phải tất cả các công cụ và ngôn ngữ lập trình khác đều khá tiện lợi, biểu cảm và mạnh mẽ khi nói đến regex như Perl. Có một phổ lớn ngoài kia, với một số phù hợp hơn những cái khác. Nói chung, các ngôn ngữ đã thể hiện regex như một phần của ngôn ngữ cốt lõi thay vì như một thư viện sẽ dễ làm việc hơn. Tôi đã không làm gì với các biểu thức mà bạn không thể thực hiện, giả sử, PCRE, mặc dù bạn sẽ cấu trúc chương trình khác đi nếu bạn đang sử dụng C.
Cuối cùng, các ngôn ngữ khác sẽ bắt kịp với nơi Perl hiện đang xét về các biểu thức chính quy. Tôi nói điều này bởi vì khi Perl bắt đầu, không ai khác có bất cứ thứ gì như biểu thức của Perl. Nói bất cứ điều gì bạn thích, nhưng đây là nơi Perl giành chiến thắng rõ ràng: mọi người đều sao chép các biểu thức của Perl mặc dù ở các giai đoạn phát triển khác nhau. Perl đã tiên phong gần như (không hoàn toàn là tất cả, nhưng gần như) tất cả mọi thứ mà bạn đã dựa vào trong các mẫu hiện đại ngày nay, bất kể bạn sử dụng công cụ hay ngôn ngữ nào. Vì vậy, cuối cùng những người khác sẽ bắt kịp.
Nhưng họ sẽ chỉ bắt kịp nơi Perl đã từng ở trong quá khứ, giống như bây giờ. Mọi thứ tiến bộ. Trong regexes nếu không có gì khác, nơi Perl dẫn, những người khác làm theo. Perl sẽ ở đâu khi mọi người cuối cùng cũng bắt kịp nơi Perl đang ở bây giờ? Tôi không có ý tưởng, nhưng tôi biết chúng ta cũng sẽ di chuyển. Có lẽ chúng ta sẽ gần gũi hơn với phong cách chế tạo của Perl₆ .
Nếu bạn thích loại điều đó nhưng muốn sử dụng nó trong Perl₅, bạn có thể quan tâm đến mô-đun Regapi :: Grammars tuyệt vời của Damian Conway . Nó hoàn toàn tuyệt vời, và làm cho những gì tôi đã làm ở đây trong chương trình của tôi có vẻ nguyên thủy như của tôi làm cho các mẫu mà mọi người nhồi nhét vào nhau mà không có khoảng trắng hoặc định danh chữ cái. Kiểm tra nó ra!
Chunker HTML đơn giản
Đây là nguồn hoàn chỉnh cho trình phân tích cú pháp mà tôi đã chỉ ra tâm điểm từ đầu bài đăng này.
Tôi không gợi ý rằng bạn nên sử dụng điều này trên một lớp phân tích cú pháp được kiểm tra nghiêm ngặt. Nhưng tôi mệt mỏi với những người giả vờ rằng không ai có thể phân tích HTML bằng các biểu thức chính chỉ vì họ không thể. Bạn rõ ràng có thể, và chương trình này là bằng chứng cho sự khẳng định đó.
Chắc chắn, nó không phải là dễ dàng, nhưng nó là có thể!
Và cố gắng làm như vậy là một sự lãng phí thời gian khủng khiếp, bởi vì các lớp phân tích cú pháp tốt tồn tại mà bạn nên sử dụng cho nhiệm vụ này. Câu trả lời đúng cho những người cố gắng phân tích HTML tùy ý không phải là không thể. Đó là một câu trả lời dễ hiểu và không lịch sự. Câu trả lời chính xác và trung thực là họ không nên thử nó vì quá bận tâm để tìm ra từ đầu; họ không nên bẻ lưng phấn đấu để tái tạo một bánh xe hoạt động hoàn hảo.
Mặt khác, HTML nằm trong một tập hợp con có thể dự đoán là cực kỳ dễ phân tích cú pháp. Không có gì lạ khi mọi người cố gắng sử dụng chúng, bởi vì đối với các vấn đề nhỏ, có lẽ vấn đề về đồ chơi, không có gì có thể dễ dàng hơn. Đó là lý do tại sao việc phân biệt hai nhiệm vụ - cụ thể và chung chung - vì những điều này không nhất thiết đòi hỏi cùng một cách tiếp cận.
Tôi hy vọng trong tương lai ở đây sẽ thấy một cách đối xử công bằng và trung thực hơn đối với các câu hỏi về HTML và biểu thức chính quy.
Đây là từ điển HTML của tôi. Nó không cố gắng thực hiện một phân tích xác thực; nó chỉ xác định các yếu tố từ vựng. Bạn có thể nghĩ về nó nhiều hơn như một đoạn mã HTML hơn là trình phân tích cú pháp HTML. Nó không tha thứ cho HTML bị hỏng, mặc dù nó tạo ra một số khoản trợ cấp rất nhỏ theo hướng đó.
Ngay cả khi bạn không bao giờ tự phân tích HTML đầy đủ (và tại sao bạn nên giải quyết vấn đề!), Chương trình này có rất nhiều bit regex thú vị mà tôi tin rằng nhiều người có thể học hỏi được rất nhiều. Thưởng thức!
#!/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 }