whatpm/Whatpm/mkhtmlparser.pl

#!/usr/bin/perl 
use strict;

while (<>) {
  s/!!!emit\b/return /;
  s{!!!next-input-character;}{q{
      if (@{$self->{char}}) {
        $self->{next_input_character} = shift @{$self->{char}};
      } else {
        $self->{set_next_input_character}->($self);
      }
  }}ge;
  s{!!!back-next-input-character\b}{q{unshift @{$self->{char}}, }}ge;
  s{!!!parse-error;}{q{$self->{parse_error}->();}}ge;
  s{!!!parse-error\b}{q{$self->{parse_error}->}}ge;
  s{!!!insert-element-t\s*\(([^(),]+),([^(),]+)\)\s*;}{qq{
    {
      my \$el;
      !!!create-element (\$el, $1, $2);
      \$insert->(\$el);
      push \@{\$self->{open_elements}}, [\$el, $1];
    }
  }}ge;
  s{!!!insert-element-t\s*\(([^(),]+)\)\s*;}{qq{
    {
      my \$el;
      !!!create-element (\$el, $1);
      \$insert->(\$el);
      push \@{\$self->{open_elements}}, [\$el, $1];
    }
  }}ge;
  s{!!!insert-element\s*\(([^(),]+),([^(),]+)\)\s*;}{qq{
    {
      my \$el;
      !!!create-element (\$el, $1, $2);
      \$self->{open_elements}->[-1]->[0]->append_child (\$el);
      push \@{\$self->{open_elements}}, [\$el, $1];
    }
  }}ge;
  s{!!!insert-element\s*\(([^(),]+)\)\s*;}{qq{
    {
      my \$el;
      !!!create-element (\$el, $1);
      \$self->{open_elements}->[-1]->[0]->append_child (\$el);
      push \@{\$self->{open_elements}}, [\$el, $1];
    }
  }}ge;
  s{!!!create-element\s*\(([^(),]+),([^(),]+)(?:,([^(),]+))?\)\s*;}{
    my $r = qq{
      $1 = \$self->{document}->create_element_ns
        (q<http://www.w3.org/1999/xhtml>, [undef, $2]);
    };
    if (defined $3) {
      $r .= qq{
        for my \$attr_name (keys %{$3}) {
          $1->set_attribute_ns (undef, [undef, \$attr_name],
                                $3 ->{\$attr_name}->{value});
        }
      };
    }
    $r;
  }ge; # MUST
  s{!!!next-token;}{q{$token = $self->_get_next_token;}}ge;
  s{!!!back-token;}{q{unshift @{$self->{token}}, $token;}}ge;
  s{!!!back-token\s*\(}{q{unshift @{$self->{token}}, (}}ge;
  print;
}
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4			while (<>) {
5			s/!!!emit\b/return /;
6			s{!!!next-input-character;}{q{
7			if (@{$self->{char}}) {
8			$self->{next_input_character} = shift @{$self->{char}};
9			} else {
10			$self->{set_next_input_character}->($self);
11			}
12			}}ge;
13			s{!!!back-next-input-character\b}{q{unshift @{$self->{char}}, }}ge;
14			s{!!!parse-error;}{q{$self->{parse_error}->();}}ge;
15			s{!!!parse-error\b}{q{$self->{parse_error}->}}ge;
16			s{!!!insert-element-t\s\(([^(),]+),([^(),]+)\)\s;}{qq{
17			{
18			my \$el;
19			!!!create-element (\$el, $1, $2);
20			\$insert->(\$el);
21	wakaba	1.2	push \@{\$self->{open_elements}}, [\$el, $1];
22	wakaba	1.1	}
23			}}ge;
24			s{!!!insert-element-t\s\(([^(),]+)\)\s;}{qq{
25			{
26			my \$el;
27			!!!create-element (\$el, $1);
28			\$insert->(\$el);
29	wakaba	1.2	push \@{\$self->{open_elements}}, [\$el, $1];
30	wakaba	1.1	}
31			}}ge;
32			s{!!!insert-element\s\(([^(),]+),([^(),]+)\)\s;}{qq{
33			{
34			my \$el;
35			!!!create-element (\$el, $1, $2);
36	wakaba	1.2	\$self->{open_elements}->[-1]->[0]->append_child (\$el);
37			push \@{\$self->{open_elements}}, [\$el, $1];
38	wakaba	1.1	}
39			}}ge;
40			s{!!!insert-element\s\(([^(),]+)\)\s;}{qq{
41			{
42			my \$el;
43			!!!create-element (\$el, $1);
44	wakaba	1.2	\$self->{open_elements}->[-1]->[0]->append_child (\$el);
45			push \@{\$self->{open_elements}}, [\$el, $1];
46	wakaba	1.1	}
47			}}ge;
48			s{!!!create-element\s\(([^(),]+),([^(),]+)(?:,([^(),]+))?\)\s;}{
49			my $r = qq{
50			$1 = \$self->{document}->create_element_ns
51			(q<http://www.w3.org/1999/xhtml>, [undef, $2]);
52			};
53			if (defined $3) {
54			$r .= qq{
55			for my \$attr_name (keys %{$3}) {
56			$1->set_attribute_ns (undef, [undef, \$attr_name],
57			$3 ->{\$attr_name}->{value});
58			}
59			};
60			}
61			$r;
62			}ge; # MUST
63			s{!!!next-token;}{q{$token = $self->_get_next_token;}}ge;
64			s{!!!back-token;}{q{unshift @{$self->{token}}, $token;}}ge;
65			s{!!!back-token\s*\(}{q{unshift @{$self->{token}}, (}}ge;
66			print;
67			}