ওহ হ্যাঁ আপনি এইচটিএমএল পার্স করতে রেজেক্সস ব্যবহার করতে পারেন !
আপনি যে কাজের জন্য চেষ্টা করছেন তার জন্য, রেজেক্সগুলি পুরোপুরি ঠিক আছে!
এটা তোলে হয় সত্য যে অধিকাংশ লোক রেগুলার এক্সপ্রেশনের সাথে পার্সিং 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);
}
}
}
এটি পড়তে কত সহজ ?
যেমনটি লেখা আছে, এটি এইচটিএমএল এর প্রতিটি টুকরো চিহ্নিত করে এবং এটি কোথায় টুকরোটি খুঁজে পেয়েছে তা জানায়। আপনি যে কোনও প্রকারের টুকরো দিয়ে যা চান তা করতে বা এগুলির চেয়ে আরও বিশেষ ধরণের জন্য খুব সহজেই এটি পরিবর্তন করতে পারেন।
আমার কোনও ব্যর্থ পরীক্ষার কেস নেই (বাম :): আমি এই কোডটি সফলভাবে 100,000 এরও বেশি এইচটিএমএল ফাইলে চালিয়েছি - প্রত্যেকটিই আমি দ্রুত এবং সহজেই আমার হাত পেতে পারি। এর বাইরেও আমি এটিকে বিশেষত ভ্রান্ত পার্সার ভাঙার জন্য নির্মিত ফাইলগুলিতে চালিয়েছি।
এই না একটি সাদাসিধা পার্সার।
ওহ, আমি নিশ্চিত এটি নিখুঁত নয়, তবে আমি এখনও এটি ভেঙে ফেলতে পারি নি। আমি অনুমান করেছি যে কিছু করা হলেও, সমাধানটি প্রোগ্রামের সুস্পষ্ট কাঠামোর কারণে মাপসই করা সহজ হবে। এমনকি রিজেক্স-ভারী প্রোগ্রামগুলির স্টাকচার হওয়া উচিত।
এখন যে উপায় বাইরে, আমাকে ওপি এর প্রশ্নে সম্বোধন করা যাক।
রেজিক্সগুলি ব্যবহার করে ওপির টাস্ক সলভ করার ডেমো
html_input_rx
আমি নীচে অন্তর্ভুক্ত করা ছোট্ট প্রোগ্রামটি নিম্নলিখিত আউটপুট উত্পাদন করে, যাতে আপনি দেখতে পাচ্ছেন যে রেজেক্সেস সহ পার্সিং এইচটিএমএল আপনি যা করতে চান তার জন্য ঠিক কাজ করে:
% 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: $!";
}
এই নাও! কিছুই নেই! :)
রেগেক্সেস সহ আপনার দক্ষতা কোনও বিশেষ পার্সিংয়ের উপর নির্ভর করে কিনা তা আপনি কেবল বিচার করতে পারেন। প্রত্যেকের দক্ষতার স্তর আলাদা এবং প্রতিটি নতুন কাজ আলাদা। যে কাজের ক্ষেত্রে আপনার সু-সংজ্ঞায়িত ইনপুট সেট রয়েছে, রেজিক্সগুলি স্পষ্টতই সঠিক পছন্দ, কারণ যখন আপনার সাথে ডিল করার জন্য এইচটিএমএলের একটি সীমাবদ্ধ সাবসেট থাকে তখন কিছু একসাথে রাখা তুচ্ছ। এমনকি রিজেক্স নব্বইয়েরদেরও সেই কাজগুলি রেজিক্স সহ পরিচালনা করা উচিত। আর কিছু হ'ল ওভারকিল।
যাইহোক , এইচটিএমএল একবারে কম পেরেক হয়ে উঠতে শুরু করলে, একবার আপনি যেভাবে ভবিষ্যদ্বাণী করতে পারবেন না এমনভাবে ছড়িয়ে পড়তে শুরু করে তবে যা পুরোপুরি আইনী, একবার আপনাকে আরও বিভিন্ন ধরণের জিনিস বা আরও জটিল নির্ভরতার সাথে মিলিয়ে ফেললে আপনি অবশেষে এমন একটি জায়গায় পৌঁছে যাবেন where পার্সিং ক্লাসটি ব্যবহার করার চেয়ে আপনাকে রেজিক্সগুলি ব্যবহার করে এমন একটি সমাধান কার্যকর করতে আপনাকে আরও কঠোর পরিশ্রম করতে হবে। যেখানে বিরতি-সমান পয়েন্ট ফলস আবার আপনার নিজের স্বাচ্ছন্দ্যের স্তরের উপর পুনরায় নির্ভর করে ge
তো এখন আমার কি করা উচিৎ?
আপনাকে কী করতে হবে বা আপনি কী করতে পারবেন না তা আমি আপনাকে বলব না। আমি মনে করি এটি ভুল। আমি আপনাকে কেবল সম্ভাব্যতার সাথে উপস্থাপন করতে চাই, আপনার চোখ কিছুটা খুলুন। আপনি কী করতে চান এবং আপনি এটি কীভাবে করতে চান তা চয়ন করতে পারেন। কোনও রহস্য নেই - এবং আপনি নিজের মতো করে নিজের পরিস্থিতি অন্য কেউ জানে না। যদি কিছু মনে হয় এটি খুব বেশি কাজ, ভাল, সম্ভবত এটি। প্রোগ্রামিং মজা করা উচিত , আপনি জানেন। যদি এটি না হয় তবে আপনি এটি ভুল করছেন।
আমার html_input_rx
প্রোগ্রামটি যে কোনও সংখ্যক বৈধ উপায়ে দেখে নেওয়া যেতে পারে। এর মধ্যে একটি হ'ল আপনি অবশ্যই নিয়মিত প্রকাশের সাথে এইচটিএমএলকে বিশ্লেষণ করতে পারেন । তবে আরেকটি হ'ল এটি যে প্রায় কেউ কখনও কখনও এটি মনে করে তার চেয়ে অনেক বেশি, অনেক বেশি। এটি সহজেই এই সিদ্ধান্তে পৌঁছে দিতে পারে যে আমার প্রোগ্রামটি আপনাকে যা করা উচিত নয় তার একটি প্রমাণ হিসাবে এটি সত্যিই খুব শক্ত।
আমি এর সাথে একমত হইব না। অবশ্যই আমি যদি আমার প্রোগ্রামে যা কিছু করি তা কিছু অধ্যয়নের পরে যদি আপনার কাছে তা বোঝায় না, তবে আপনাকে এই ধরণের কাজের জন্য রেজিেক্সগুলি ব্যবহার করার চেষ্টা করা উচিত নয়। নির্দিষ্ট এইচটিএমএল-এর জন্য, রেজেক্সগুলি দুর্দান্ত তবে জেনেরিক এইচটিএমএল-এর জন্য এগুলি উন্মাদনার সমতুল্য। আমি সমস্ত সময় পার্সিং ক্লাস ব্যবহার করি, বিশেষত এটি যদি এইচটিএমএল আমি নিজেই উত্পন্ন না করি।
ছোট এইচটিএমএল পার্সিং সমস্যাগুলির জন্য সর্বোত্তম রেজিেক্সস, বড়গুলির জন্য প্যাসিমাল
এমনকি যদি আমার প্রোগ্রামটি সাধারণ এইচটিএমএল পার্স করার জন্য কেন রেজিেক্সগুলি ব্যবহার করবেন না - উদাহরণস্বরূপ নেওয়া হয় - যা ঠিক আছে, কারণ আমি এটির জন্য এটি বোঝাতে চাইছিলাম - এটি এখনও একটি চোখ খোলা হওয়া উচিত যাতে আরও লোকেরা মারাত্মক সাধারণকে ভেঙে দেয় এবং অপঠনযোগ্য, কাঠামোগত, এবং অপ্রত্যাশিত নিদর্শনগুলি লেখার বাজে, বাজে অভ্যাস।
প্যাটার্নগুলি কুরুচিপূর্ণ হতে হবে না এবং তাদের কঠোর হতে হবে না। আপনি যদি কুৎসিত নিদর্শন তৈরি করেন তবে এটি আপনার প্রতিফলন, সেগুলি নয়।
উদ্ভট উত্সাহী রেজেক্স ভাষা
আমাকে উল্লেখ করতে বলা হয়েছে যে আপনার সমস্যার প্রতি আমার নিখুঁত সমাধান পার্লে লেখা হয়েছে। আপনি বিস্মিত? আপনি খেয়াল করেননি? এই উদ্ঘাটন কি একটি বোমাশেল?
এটি সত্য যে পার্লের মতো রেজিওসের ক্ষেত্রে অন্যান্য সমস্ত সরঞ্জাম এবং প্রোগ্রামিং ল্যাঙ্গুয়েজগুলি যথেষ্ট সুবিধাজনক, অভিব্যক্তিপূর্ণ এবং শক্তিশালী নয়। সেখানে একটি বড় বর্ণালী আছে, কিছু অন্যদের চেয়ে বেশি উপযুক্ত। সাধারণভাবে, যে ভাষাগুলি গ্রন্থাগার হিসাবে পরিবর্তে মূল ভাষার অংশ হিসাবে পুনরায় প্রকাশ করেছে তাদের সাথে কাজ করা সহজ। রেগেক্সেসের সাথে আমি এমন কিছুই করিনি যা আপনি করতে পারেননি, বলুন, পিসিআরই, যদিও আপনি সি ব্যবহার করছেন যদি আপনি প্রোগ্রামটি অন্যভাবে গঠন করেন although
শেষ পর্যন্ত অন্যান্য ভাষাগুলি যেখানে রেজেক্সেসের ক্ষেত্রে পার্ল এখন সেখানে তা ধরা পড়বে। আমি এটি বলছি কারণ যখন পার্ল শুরু হয়েছিল তখন কারও কারও কাছে পারেলের রেজিজেসের মতো কিছুই ছিল না। আপনার পছন্দের যেকোন কিছু বলুন, তবে পার্ল স্পষ্টতই এখানে জিতেছিলেন: প্রত্যেকে তাদের বিকাশের বিভিন্ন পর্যায়ে পার্লের রেজিজেসগুলি অনুলিপি করেছিল। পার্ল আপনি আজ যে কোনও সরঞ্জাম বা ভাষা ব্যবহার না করেই আধুনিক নকশায় নির্ভর করতে এসেছেন এমন প্রায় সমস্ত কিছু (প্রায় সবই নয়, প্রায়) অগ্রণীত করেছিলেন। তাই অবশেষে অন্যদের হবে ধরতে।
তবে তারা কেবল যেখানে পার্ল আগে একসময় ছিল ঠিক তেমনই ধরবে, যেমনটি এখন রয়েছে। সবকিছু অগ্রসর। রেজিজেসগুলিতে অন্য কিছু না থাকলে, যেখানে পার্ল নেতৃত্ব দেয়, অন্যরা অনুসরণ করে। পার্ল একবারে কোথায় থাকবে অন্য সবার শেষে অবশেষে পার্ল এখন কোথায় থাকবে? আমার কোনও ধারণা নেই, তবে আমি জানি আমরাও চলে এসেছি। সম্ভবত আমরা কারুকার্যকার্য ধরণের পার্লির স্টাইলের আরও কাছাকাছি থাকব ।
আপনি যদি এই ধরণের জিনিস পছন্দ করেন তবে এটি পার্লিতে ব্যবহার করতে চান, আপনি দামিয়ান কনওয়ের দুর্দান্ত রেজিএক্সএক্স :: ব্যাকরণ মডিউলটিতে আগ্রহী হতে পারেন । এটি সম্পূর্ণ দুর্দান্ত, এবং আমি এখানে আমার প্রোগ্রামে যা করেছি তা ঠিক আমার মতো আদিম বলে মনে হয় যে লোকেরা সাদা স্থান বা বর্ণমালা শনাক্তকারী ছাড়া একসাথে ক্র্যাম করে। এটা দেখ!
সাধারণ এইচটিএমএল চুনকার
এই পোস্টিংটির শুরুতে আমি কেন্দ্রীভূমিটি দেখিয়েছি পার্সারের সম্পূর্ণ উত্স।
আমি প্রস্তাব দিচ্ছি না যে আপনার এটি কঠোরভাবে পরীক্ষিত পার্সিং ক্লাসে ব্যবহার করা উচিত। কিন্তু আমি যে কেউ কিছু করতে পারেন পার্স এইচটিএমএল regexes মাত্র কারণ সঙ্গে ভান মানুষের ক্লান্ত তারা করতে পারেন না। আপনি পরিষ্কারভাবে পারেন এবং এই প্রোগ্রামটি সেই দৃ that়তার প্রমাণ।
নিশ্চিত, এটা সহজ নয়, কিন্তু এটা হয় সম্ভব!
এবং এটি করার চেষ্টা করা হ'ল একটি সময় নষ্ট করা, কারণ ভাল পার্সিং ক্লাস রয়েছে যা আপনার এই কাজের জন্য ব্যবহার করা উচিত । পার্স বের করার চেষ্টা লোকদের সঠিক উত্তর নির্বিচারে এইচটিএমএল হয় না এটি অসম্ভব। এটি একটি সহজ এবং জঘন্য উত্তর। সঠিক এবং সৎ উত্তরটি হ'ল তাদের চেষ্টা করা উচিত নয় কারণ স্ক্র্যাচ থেকে বের করা খুব বেশি বিরক্তিকর; পুরোপুরি ভালভাবে কাজ করে এমন একটি চাকা পুনরায় আবিষ্কার করার জন্য তাদের পিছনে ভাঙা উচিত নয়।
অন্যদিকে, এইচটিএমএল যা অনুমানযোগ্য সাবসেটের মধ্যে পড়ে তা হ'ল রেজিজেসগুলির সাথে পার্স করা অতি-সহজ। এতে আশ্চর্য হওয়ার কিছু নেই যে লোকেরা এগুলি ব্যবহার করার চেষ্টা করে, কারণ ছোট সমস্যাগুলির জন্য, খেলনা সমস্যার জন্য সম্ভবত কোনও কিছুই সহজ হতে পারে না। এই কারণেই দুটি কার্যের মধ্যে পার্থক্য করা এত গুরুত্বপূর্ণ - নির্দিষ্ট বনাম জেনেরিক - কারণ এগুলি অগত্যা একই পদ্ধতির চাহিদা রাখে না।
আমি ভবিষ্যতে আশা করি এইচটিএমএল এবং রেজিজেস সম্পর্কে প্রশ্নের আরও সুষ্ঠু ও সৎ আচরণ দেখতে।
এখানে আমার এইচটিএমএল লেক্সার। এটি একটি বৈধতা বিশ্লেষণ করার চেষ্টা করে না; এটি কেবল লেজিক উপাদানগুলি সনাক্ত করে। আপনি এটি HTML পার্সারের চেয়ে এইচটিএমএল চুনকার হিসাবে বেশি ভাবেন । এটি ভাঙা এইচটিএমএলকে খুব ক্ষমা করে না, যদিও এটি কিছু দিক দিয়ে খুব সামান্য ভাতা দেয়।
এমনকি যদি আপনি কখনই সম্পূর্ণ এইচটিএমএলকে নিজের করে না করেন (এবং কেন আপনার উচিত? এটি একটি সমাধান হওয়া সমস্যা!), এই প্রোগ্রামটিতে প্রচুর শীতকালীন রেগেক্স বিট রয়েছে যা আমি বিশ্বাস করি যে অনেক লোক এখান থেকে অনেক কিছু শিখতে পারে। উপভোগ করুন!
#!/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 }