First a general code review, not specific to your “is there a more reliable way”. Later, I will show a superiour solution. But first, a lengthy rant.
I see you have a very unique coding style. This is not good: Every piece of code has two audiences: The computer, and a maintainer. Everybody can write code a computer understands, but writing for humans is an art. Do the maintainer a favour and write understandable, easy code – it could be you! In fact, your coding style slightly reminds me of the horrors of the “perlish coding style” which is neither perlish, nor recommendable, although completely logical. See here for an example. Do not imitate! Your single-space indent isn't recommendable either.
You have a knack for single letter variable names. Heck, you even have a comment explaining what each variable means: my ($t, $d) = @_; # Element, stack
. This is completely and utterly silly, just name them my ($element, $stack)
already. Code ought to be self-documenting.
Otherwise, comments explaining what you are doing is suspiciously absent.
When opening a file, always include the reason for failure $!
in the error message, or use automatic error handling with the autodie
pragma.
UTF-8 is not the default encoding for HTML documents. If your document is guaranteed to be encoded in UTF-8, then opening the file with such a layer is the correct thing. Otherwise, you can pass the filename to the parse_file
method. You should check if the return value of parse_file
is defined. If not, you'll find a reason for failure in $!
.
You can shorten the :encoding(UTF-8)
layer as :uft8
. Technically, they are slightly different. Most importantly, the latter is more relaxed.
I see how you used a recursive solution for your misnomed list
sub, which traverses the document. You should comment this more thoroughly – it took me a moment to realize that if (ref $t)
, then it is a tag, possibly with childs, otherwise a text node.
You have two stacks: @t
and $d
. Why do you carry one around as an argument, but not the other? Your code is actually quite hard to grok, because different branches in the tree append elements to the same $d
arrayref. If I understand your code correctly, then a tree like
html
/ \
head body
/ \
div div
/ \ /|\
h1 p p p p
|
em
would produce the flattening $d = [qw/html head body div h1 p div p p em p/]
.
[type type type] Now I see I don't understand the code correctly – you always pop the last element of the stack after traversing into childs. As each child also pops one element of the stack, each node removes itself. I think this is utterly silly, and it would be better to pass each recursion a copy of the stack. Otherwise, comment this shit! Recursion has the advantage that it is easier to reason about code. You loose this advantage when you use mutable variables.
Another problem is that your search is too wide. First, you want the HTML element. Then only the body. Then all divs. Then another one. Then a definition list or another div. However, you search the whole tree. This is wasteful.
You have a magic number in that code: 5
. Which is wrong, because your regexes can only match starting at positions 6 tags deep! Oh, and all those regexes could be combined into one, which would be more efficient. You can also anchor the match at the beginning of the string with the ^
or \A
operators, which lets the regex fail faster. You also might want to assert that your path ends with a =
(or, if you heed the advice of the next paragraph, with the end of the string $
or \z
).
You combine the element path and the text value by concatenating them with an =
in between. Later, you use captures to fiddle that value out again. I would rather use an two-element arrayref.
But why even have the @t
stack? If you look closely, you'll see that there is a lot repeated code, e.g. regexes in the else
path of list
, and the if(1)
later. You could just do the processing right there, and save that memory.
Why is there an if(1)
? If you, for some reason, want to enter a new scope, just use a plain block:
my $x = 1; { my $x = 2 } say $x; # 1
This is Ok on the statement level. On the expression level, you can use a do {BLOCK}
to include more complex calculations. This evaluates to the result of the last statement in the block.
Here is a refactoring of your code. It tries to fix many issues mentioned above.
# tested, works
use strict; use warnings; use 5.016;
use autodie;
use Data::Dump;
use HTML::TreeBuilder;
open my $fh, "<:utf8", "svgSpecification.html";
my $tree_builder = HTML::TreeBuilder->new;
my $document = $tree_builder->parse_file($fh) or die $!;
my (%elements, $element);
my $state = 0;
# state = 0: want element
# state = 1: want dt "Content model"
# state = 2: want value
find($document, {
body => { div => { div => {
div => { span => sub {
return unless $state == 0;
$element = shift->as_trimmed_text =~ s/\pP//gr;
$state++;
}},
dl => {
dt => sub {
my $content = shift->as_trimmed_text;
if ($state == 1 and $content =~ /Content model:/) {
$state++;
} elsif ($content =~ /Attributes:/) {
$state = 0;
}
},
dd => { ul => { li => {
span => { a => { span => sub {
return unless $state == 2;
push @{ $elements{$element} }, shift->as_trimmed_text =~ s/\pP//gr;
}}},
a => { span => sub {
return unless $state == 2;
push @{ $elements{$element} }, shift->as_trimmed_text =~ s/\pP//gr;
}},
}}},
},
}}},
});
dd \%elements;
sub find {
my ($tag, $path) = @_;
for my $child ($tag->content_list) {
next unless ref $child; # skip text contents
next unless my $nextpath = $path->{$child->tag};
if (ref($nextpath) eq 'CODE') {
$nextpath->($child);
} else {
find($child, $nextpath);
}
}
}
As you see, the actual recursion logic is decoupled from your data extraction. The find
function is guided by a hashes-of-hashes data structure, which keeps the search space minimal. The formerly implicit state machine is now documented and quite explicit. No unneccessary regexes are used.
One problem with my solution is that the data structure is extremely verbose. I used unusual formatting to battle insanely deep intendation, and it does have a slightly DSL-esque feeling. However, automatic formatting will destroy this.
Of course, such recursion is absolutely silly in this day and age. Modules like Mojo::DOM
and Web::Query
allow us to use CSS selectors, which makes this a breeze.
# tested, works
use strict; use warnings; use 5.016;
use Data::Dump;
use File::Slurp;
use Mojo::DOM;
my $contents = read_file "svgSpecification.html", { binmode => ":utf8" };
my $dom = Mojo::DOM->new($contents) or die "Can't parse input";
my %elems;
for my $summary ($dom->find('.element-summary')->each) {
my $name = $summary->at('.element-summary-name')->all_text;
$name =~ s/[\pP\s]//g; # remove all punctuation and spaces
# Getting the correct section is tricky, as it is only identified by text.
# We get around this by filtering manually for the correct text,
# then continuing with the next sibling node
my ($child_headline) = grep { $_->all_text =~ /Content model/ } $summary->find('dt')->each;
next unless $child_headline;
my @childs = map { $_->all_text =~ s/[\pP\s]//gr } $child_headline->next->find('.element-name')->each;
push @{ $elems{$name} }, @childs;
}
dd \%elems;
Both of these solutions have the same speed. The 2nd solution will also put elements without childs into the hash, while the first solution ignores them. My scripts were tested with the SVG 1.1 spec on a single page.
XML::XPath
solves? \$\endgroup\$