0
\$\begingroup\$

Is there a more reliable way of getting the content elements for each SVG element?

#-----------------------------------------------------------------------
# Get Element content from SVG specification from:
# http://www.w3.org/TR/2011/REC-SVG11-20110816/single-page.html
# Philip R Brenan at gmail dot com, Appa Apps Ltd, 2013
#-----------------------------------------------------------------------
use feature ":5.16";
use warnings FATAL => qw(all);
use strict;
use Carp;
use Data::Dump qw(dump);

use HTML::TreeBuilder;

my $f = "svgSpecification.html";
open(my $F, "<:encoding(UTF-8)", $f) or die "Cannot open $f for unicode input";

my $t = HTML::TreeBuilder->new->parse_file($F);
my @t;

#-----------------------------------------------------------------------
# Extract relevant nodes
#-----------------------------------------------------------------------

sub list
 {my ($t, $d) = @_; # Element, stack
  if (ref($t))
   {push @$d, $t->tag;
    for($t->content_list)
     {list($_, $d);
     }
    pop @$d;
   }
  elsif (@$d >= 5)
   {my $T = join("_", @$d) ."=". ($t =~ s/[\x{2018}\x{2019}]//gr);
    if 
     ($T =~ /html_body_div_div_dl_dd_ul_li_span_a_span/ or
      $T =~ /html_body_div_div_dl_dt/                   or
      $T =~ /html_body_div_div_div_span/ or
      $T =~ /html_body_div_div_dl_dd_ul_li_a_span/ # Linear gradient
     )

     {push @t, $T; 
     }
   }
 }

list($t, []);

#-----------------------------------------------------------------------
# Compile content list
#-----------------------------------------------------------------------

my $c;

if (1)
 {my $s = 0;
  my $e;
  for(@t)
   {if ($s == 0 and /html_body_div_div_div_span=([\w_:-]+)/)
     {$e = $1;
      $s = 1;
     }
    elsif ($s == 1 and /html_body_div_div_dl_dt=Content model:/)
     {$s = 2;
     } 
    elsif ($s == 2)
     {if (/(?:html_body_div_div_dl_dd_ul_li_span_a_span|html_body_div_div_dl_dd_ul_li_a_span)=([\w_:-]+)/)
       {push @{$c->{$e}}, $1;
       } 
      elsif (/html_body_div_div_dl_dt=Attributes:/)
       {$s = 0; $e = undef;
       } 
     }
   } 
 } 

say dump($c);
\$\endgroup\$
  • \$\begingroup\$ Isn't this exactly the kind of problem that XML::XPath solves? \$\endgroup\$ – 200_success Sep 11 '13 at 22:47
  • \$\begingroup\$ @200_success Yes, this problem can be solved with XPath, once a DOM is created from the HTML. However, the specifics are more complex than a single XPath expression. If you scroll to the bottom of my answer, you'll see a solution with CSS selectors, which is only slightly more complicated than a hypothetical XPath solution. \$\endgroup\$ – amon Sep 11 '13 at 22:58
3
\$\begingroup\$

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.

\$\endgroup\$
  • \$\begingroup\$ I should have mentioned that I am on Windows, and so far, after an hour or so, I have been unable to install Mojo on Windows - for all the usual reason - no module at activeState, strange errors from gnu make when one tries to install from cpan etc. I am thus forced to use the tools at hand. So I would like to use Mojo, but the cost of dumping the existing environment is too high. \$\endgroup\$ – user29581 Sep 12 '13 at 14:55
  • \$\begingroup\$ @phil Indeed, it seems that AS only provides Mojo builds up to perl 5.10. That does suck. (On Windows, I always use Strawberry Perl, which comes with a complete toolchain). You could try Web::Query instead which has a nearly identical API to Mojo::DOM. \$\endgroup\$ – amon Sep 12 '13 at 15:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy