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{!!!nack\s*\(\s*'([^']+)'\s*\)\s*;}{
    ($DEBUG ? qq{
      if (\$self->{self_closing}) {
        !!!cp ('$1.2');
      } else {
        !!!cp ('$1.3');
      }
    } : '')
  }ge;
  s{!!!ack\s*(?>\([^)]*\)\s*)?;}{q{delete $self->{self_closing};}}ge;
  s{!!!ack-later\s*(?>\([^)]*\)\s*)?;}{}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, $3);
      \$insert->(\$el);
      push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} || 0];
    }
  }}ge;
  s{!!!insert-element-t\s*\(([^(),]+),\s*,([^(),]+)\)\s*;}{qq{
    {
      my \$el;
      !!!create-element (\$el, $1,, $2);
      \$insert->(\$el);
      push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} || 0];
    }
  }}ge;
  s{!!!insert-element-t\s*\(([^(),]+),([^(),]+)\)\s*;}{qq{
    {
      my \$el;
      !!!create-element (\$el, $1, $2);
      \$insert->(\$el);
      push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} || 0];
    }
  }}ge;
  s{!!!insert-element-t\s*\(([^(),]+)\)\s*;}{qq{
    {
      my \$el;
      !!!create-element (\$el, $1);
      \$insert->(\$el);
      push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} || 0];
    }
  }}ge;
  s{!!!insert-element\s*\(([^(),]+),\s*,([^(),]+)\)\s*;}{qq{
    {
      my \$el;
      !!!create-element (\$el, $1,, $2);
      \$self->{open_elements}->[-1]->[0]->append_child (\$el);
      push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} || 0];
    }
  }}ge;
  s{!!!insert-element\s*\(([^(),]+),([^(),]+),([^(),]+)\)\s*;}{qq{
    {
      my \$el;
      !!!create-element (\$el, $1, $2, $3);
      \$self->{open_elements}->[-1]->[0]->append_child (\$el);
      push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} || 0];
    }
  }}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, \$el_category->{$1} || 0];
    }
  }}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, \$el_category->{$1} || 0];
    }
  }}ge;
  s{!!!create-element\s*\(([^(),]+),([^(),]+)(?:,([^(),]*)(?>,([^(),]+))?)?\)\s*;}{
    my $l_var = $1;
    my $r = qq{
      $l_var = \$self->{document}->create_element_ns
        (q<http://www.w3.org/1999/xhtml>, [undef, $2]);
    };
    if (defined $3 and length $3) {
      $r .= qq{
        for my \$attr_name (keys %{$3}) {
          my \$attr_t = $3\->{\$attr_name};
          my \$attr = \$self->{document}->create_attribute_ns
              (undef, [undef, \$attr_name]);
          \$attr->value (\$attr_t->{value});
          \$attr->set_user_data (manakai_source_line => \$attr_t->{line});
          \$attr->set_user_data (manakai_source_column => \$attr_t->{column});
          $l_var->set_attribute_node_ns (\$attr);
        }
      };
    }
    if (defined $4) {
      my $token_var = $4;
      $token_var =~ s/^\s+//;
      $token_var =~ s/\s+$//;
      $r .= qq{
        $l_var->set_user_data (manakai_source_line => $token_var\->{line})
            if defined $token_var\->{line};
        $l_var->set_user_data (manakai_source_column => $token_var\->{column})
            if defined $token_var\->{column};
      };
      ## TODO: In future version, it should be allowed for an application
      ## developer to choose whether these information should be kept
      ## for tracking or not for performance by some means.
    }
    $r;
  }ge; # MUST
  s{!!!next-token;}{q{$token = $self->_get_next_token;}}ge;
  s{!!!back-token;}{
    q{
      $token->{self_closing} = $self->{self_closing};
      unshift @{$self->{token}}, $token;
      delete $self->{self_closing};
    }
  }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	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4	wakaba	1.4	my $DEBUG = $ENV{DEBUG};
5
6	wakaba	1.1	while (<>) {
7			s/!!!emit\b/return /;
8			s{!!!next-input-character;}{q{
9			if (@{$self->{char}}) {
10	wakaba	1.3	$self->{next_char} = shift @{$self->{char}};
11	wakaba	1.1	} else {
12	wakaba	1.3	$self->{set_next_char}->($self);
13	wakaba	1.1	}
14			}}ge;
15			s{!!!back-next-input-character\b}{q{unshift @{$self->{char}}, }}ge;
16	wakaba	1.10	s{!!!nack\s\(\s'([^']+)'\s\)\s;}{
17			($DEBUG ? qq{
18			if (\$self->{self_closing}) {
19			!!!cp ('$1.2');
20			} else {
21			!!!cp ('$1.3');
22			}
23			} : '')
24			}ge;
25			s{!!!ack\s(?>\([^)]\)\s*)?;}{q{delete $self->{self_closing};}}ge;
26			s{!!!ack-later\s(?>\([^)]\)\s*)?;}{}ge;
27	wakaba	1.1	s{!!!parse-error;}{q{$self->{parse_error}->();}}ge;
28	wakaba	1.6	s{!!!parse-error\s*\(}{
29			q{$self->{parse_error}->(level => $self->{must_level}, }
30			}ge;
31	wakaba	1.7	s{!!!insert-element-t\s\(([^(),]+),([^(),]+),([^(),]+)\)\s;}{qq{
32			{
33			my \$el;
34			!!!create-element (\$el, $1, $2, $3);
35			\$insert->(\$el);
36	wakaba	1.9	push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} \|\| 0];
37	wakaba	1.7	}
38			}}ge;
39			s{!!!insert-element-t\s\(([^(),]+),\s,([^(),]+)\)\s*;}{qq{
40			{
41			my \$el;
42			!!!create-element (\$el, $1,, $2);
43			\$insert->(\$el);
44	wakaba	1.9	push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} \|\| 0];
45	wakaba	1.7	}
46			}}ge;
47	wakaba	1.1	s{!!!insert-element-t\s\(([^(),]+),([^(),]+)\)\s;}{qq{
48			{
49			my \$el;
50			!!!create-element (\$el, $1, $2);
51			\$insert->(\$el);
52	wakaba	1.9	push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} \|\| 0];
53	wakaba	1.1	}
54			}}ge;
55			s{!!!insert-element-t\s\(([^(),]+)\)\s;}{qq{
56			{
57			my \$el;
58			!!!create-element (\$el, $1);
59			\$insert->(\$el);
60	wakaba	1.9	push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} \|\| 0];
61	wakaba	1.1	}
62			}}ge;
63	wakaba	1.7	s{!!!insert-element\s\(([^(),]+),\s,([^(),]+)\)\s*;}{qq{
64			{
65			my \$el;
66			!!!create-element (\$el, $1,, $2);
67			\$self->{open_elements}->[-1]->[0]->append_child (\$el);
68	wakaba	1.9	push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} \|\| 0];
69	wakaba	1.7	}
70			}}ge;
71			s{!!!insert-element\s\(([^(),]+),([^(),]+),([^(),]+)\)\s;}{qq{
72			{
73			my \$el;
74			!!!create-element (\$el, $1, $2, $3);
75			\$self->{open_elements}->[-1]->[0]->append_child (\$el);
76	wakaba	1.9	push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} \|\| 0];
77	wakaba	1.7	}
78			}}ge;
79	wakaba	1.1	s{!!!insert-element\s\(([^(),]+),([^(),]+)\)\s;}{qq{
80			{
81			my \$el;
82			!!!create-element (\$el, $1, $2);
83	wakaba	1.2	\$self->{open_elements}->[-1]->[0]->append_child (\$el);
84	wakaba	1.9	push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} \|\| 0];
85	wakaba	1.1	}
86			}}ge;
87			s{!!!insert-element\s\(([^(),]+)\)\s;}{qq{
88			{
89			my \$el;
90			!!!create-element (\$el, $1);
91	wakaba	1.2	\$self->{open_elements}->[-1]->[0]->append_child (\$el);
92	wakaba	1.9	push \@{\$self->{open_elements}}, [\$el, \$el_category->{$1} \|\| 0];
93	wakaba	1.1	}
94			}}ge;
95	wakaba	1.7	s{!!!create-element\s\(([^(),]+),([^(),]+)(?:,([^(),])(?>,([^(),]+))?)?\)\s*;}{
96			my $l_var = $1;
97	wakaba	1.1	my $r = qq{
98	wakaba	1.7	$l_var = \$self->{document}->create_element_ns
99	wakaba	1.1	(q<http://www.w3.org/1999/xhtml>, [undef, $2]);
100			};
101	wakaba	1.7	if (defined $3 and length $3) {
102	wakaba	1.1	$r .= qq{
103			for my \$attr_name (keys %{$3}) {
104	wakaba	1.8	my \$attr_t = $3\->{\$attr_name};
105			my \$attr = \$self->{document}->create_attribute_ns
106			(undef, [undef, \$attr_name]);
107			\$attr->value (\$attr_t->{value});
108			\$attr->set_user_data (manakai_source_line => \$attr_t->{line});
109			\$attr->set_user_data (manakai_source_column => \$attr_t->{column});
110			$l_var->set_attribute_node_ns (\$attr);
111	wakaba	1.1	}
112			};
113	wakaba	1.7	}
114			if (defined $4) {
115			my $token_var = $4;
116			$token_var =~ s/^\s+//;
117			$token_var =~ s/\s+$//;
118			$r .= qq{
119			$l_var->set_user_data (manakai_source_line => $token_var\->{line})
120			if defined $token_var\->{line};
121			$l_var->set_user_data (manakai_source_column => $token_var\->{column})
122			if defined $token_var\->{column};
123			};
124			## TODO: In future version, it should be allowed for an application
125			## developer to choose whether these information should be kept
126			## for tracking or not for performance by some means.
127	wakaba	1.1	}
128			$r;
129			}ge; # MUST
130			s{!!!next-token;}{q{$token = $self->_get_next_token;}}ge;
131	wakaba	1.10	s{!!!back-token;}{
132			q{
133			$token->{self_closing} = $self->{self_closing};
134			unshift @{$self->{token}}, $token;
135			delete $self->{self_closing};
136			}
137			}ge;
138	wakaba	1.1	s{!!!back-token\s*\(}{q{unshift @{$self->{token}}, (}}ge;
139	wakaba	1.4	s{!!!cp\s\(\s(\S+)\s\)\s;}{
140			$DEBUG ? qq{
141	wakaba	1.5	#print STDERR "$1, ";
142	wakaba	1.4	\$Whatpm::HTML::Debug::cp_pass->($1) if \$Whatpm::HTML::Debug::cp_pass;
143			BEGIN {
144			\$Whatpm::HTML::Debug::cp->{$1} = 1;
145			}
146			} : ''
147			}ge;
148	wakaba	1.1	print;
149			}