whatpm/Whatpm/mkhtmlparser.pl

#!/usr/bin/perl 
use strict;

my $DEBUG = $ENV{DEBUG};

while (<>) {
  s/!!!emit\b/return /;
  s{!!!next-input-character;}{q{
      if (@{$self->{char}}) {
        $self->{next_char} = shift @{$self->{char}};
      } else {
        $self->{set_next_char}->($self);
      }
  }}ge;
  s{!!!back-next-input-character\b}{q{unshift @{$self->{char}}, }}ge;
  s{!!!parse-error;}{q{$self->{parse_error}->();}}ge;
  s{!!!parse-error\s*\(}{
    q{$self->{parse_error}->(level => $self->{must_level}, }
  }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;
  s{!!!cp\s*\(\s*(\S+)\s*\)\s*;}{
    $DEBUG ? qq{
      #print STDERR "$1, ";
      \$Whatpm::HTML::Debug::cp_pass->($1) if \$Whatpm::HTML::Debug::cp_pass;
      BEGIN {
        \$Whatpm::HTML::Debug::cp->{$1} = 1;
      }
    } : ''
  }ge;
  print;
}
1	#!/usr/bin/perl
2	use strict;
3
4	my $DEBUG = $ENV{DEBUG};
5
6	while (<>) {
7	s/!!!emit\b/return /;
8	s{!!!next-input-character;}{q{
9	if (@{$self->{char}}) {
10	$self->{next_char} = shift @{$self->{char}};
11	} else {
12	$self->{set_next_char}->($self);
13	}
14	}}ge;
15	s{!!!back-next-input-character\b}{q{unshift @{$self->{char}}, }}ge;
16	s{!!!parse-error;}{q{$self->{parse_error}->();}}ge;
17	s{!!!parse-error\s*\(}{
18	q{$self->{parse_error}->(level => $self->{must_level}, }
19	}ge;
20	s{!!!insert-element-t\s\(([^(),]+),([^(),]+)\)\s;}{qq{
21	{
22	my \$el;
23	!!!create-element (\$el, $1, $2);
24	\$insert->(\$el);
25	push \@{\$self->{open_elements}}, [\$el, $1];
26	}
27	}}ge;
28	s{!!!insert-element-t\s\(([^(),]+)\)\s;}{qq{
29	{
30	my \$el;
31	!!!create-element (\$el, $1);
32	\$insert->(\$el);
33	push \@{\$self->{open_elements}}, [\$el, $1];
34	}
35	}}ge;
36	s{!!!insert-element\s\(([^(),]+),([^(),]+)\)\s;}{qq{
37	{
38	my \$el;
39	!!!create-element (\$el, $1, $2);
40	\$self->{open_elements}->[-1]->[0]->append_child (\$el);
41	push \@{\$self->{open_elements}}, [\$el, $1];
42	}
43	}}ge;
44	s{!!!insert-element\s\(([^(),]+)\)\s;}{qq{
45	{
46	my \$el;
47	!!!create-element (\$el, $1);
48	\$self->{open_elements}->[-1]->[0]->append_child (\$el);
49	push \@{\$self->{open_elements}}, [\$el, $1];
50	}
51	}}ge;
52	s{!!!create-element\s\(([^(),]+),([^(),]+)(?:,([^(),]+))?\)\s;}{
53	my $r = qq{
54	$1 = \$self->{document}->create_element_ns
55	(q<http://www.w3.org/1999/xhtml>, [undef, $2]);
56	};
57	if (defined $3) {
58	$r .= qq{
59	for my \$attr_name (keys %{$3}) {
60	$1->set_attribute_ns (undef, [undef, \$attr_name],
61	$3 ->{\$attr_name}->{value});
62	}
63	};
64	}
65	$r;
66	}ge; # MUST
67	s{!!!next-token;}{q{$token = $self->_get_next_token;}}ge;
68	s{!!!back-token;}{q{unshift @{$self->{token}}, $token;}}ge;
69	s{!!!back-token\s*\(}{q{unshift @{$self->{token}}, (}}ge;
70	s{!!!cp\s\(\s(\S+)\s\)\s;}{
71	$DEBUG ? qq{
72	#print STDERR "$1, ";
73	\$Whatpm::HTML::Debug::cp_pass->($1) if \$Whatpm::HTML::Debug::cp_pass;
74	BEGIN {
75	\$Whatpm::HTML::Debug::cp->{$1} = 1;
76	}
77	} : ''
78	}ge;
79	print;
80	}