/[suikacvs]/markup/html/whatpm/Whatpm/HTML.pm
Suika

Contents of /markup/html/whatpm/Whatpm/HTML.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.36 - (hide annotations) (download)
Mon Jul 16 04:51:22 2007 UTC (19 years ago) by wakaba
Branch: MAIN
Changes since 1.35: +136 -197 lines
++ whatpm/t/ChangeLog	16 Jul 2007 04:51:17 -0000
	* tree-test-1.dat: Tests for |<html>| in trailing
	end phase and |</frameset>| in after frameset mode
	are added.

	* tree-test-2.dat: Tests for |</frameset>|
	in |frameset| fragment parsing are added.

2007-07-16  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/Whatpm/ChangeLog	16 Jul 2007 04:49:33 -0000
	* HTML.pm.src (main and trailin end phases): Token
	types |DOCTYPE|, |comment|, |end-of-file|, and |<html>| are
	factored out.  Error types |in html:#DOCTYPE|
	and |after html:#DOCTYPE| are merged
	into |DOCTYPE in the middle|.  |</frameset>|
	in fragment parsing mode changed the
	insertion mode.

2007-07-16  Wakaba  <wakaba@suika.fam.cx>

1 wakaba 1.2 package Whatpm::HTML;
2 wakaba 1.1 use strict;
3 wakaba 1.36 our $VERSION=do{my @r=(q$Revision: 1.35 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4 wakaba 1.1
5 wakaba 1.18 ## ISSUE:
6     ## var doc = implementation.createDocument (null, null, null);
7     ## doc.write ('');
8     ## alert (doc.compatMode);
9 wakaba 1.1
10 wakaba 1.31 ## ISSUE: HTML5 revision 967 says that the encoding layer MUST NOT
11     ## strip BOM and the HTML layer MUST ignore it. Whether we can do it
12     ## is not yet clear.
13     ## "{U+FEFF}..." in UTF-16BE/UTF-16LE is three or four characters?
14     ## "{U+FEFF}..." in GB18030?
15    
16 wakaba 1.1 my $permitted_slash_tag_name = {
17     base => 1,
18     link => 1,
19     meta => 1,
20     hr => 1,
21     br => 1,
22     img=> 1,
23     embed => 1,
24     param => 1,
25     area => 1,
26     col => 1,
27     input => 1,
28     };
29    
30 wakaba 1.4 my $c1_entity_char = {
31 wakaba 1.9 0x80 => 0x20AC,
32     0x81 => 0xFFFD,
33     0x82 => 0x201A,
34     0x83 => 0x0192,
35     0x84 => 0x201E,
36     0x85 => 0x2026,
37     0x86 => 0x2020,
38     0x87 => 0x2021,
39     0x88 => 0x02C6,
40     0x89 => 0x2030,
41     0x8A => 0x0160,
42     0x8B => 0x2039,
43     0x8C => 0x0152,
44     0x8D => 0xFFFD,
45     0x8E => 0x017D,
46     0x8F => 0xFFFD,
47     0x90 => 0xFFFD,
48     0x91 => 0x2018,
49     0x92 => 0x2019,
50     0x93 => 0x201C,
51     0x94 => 0x201D,
52     0x95 => 0x2022,
53     0x96 => 0x2013,
54     0x97 => 0x2014,
55     0x98 => 0x02DC,
56     0x99 => 0x2122,
57     0x9A => 0x0161,
58     0x9B => 0x203A,
59     0x9C => 0x0153,
60     0x9D => 0xFFFD,
61     0x9E => 0x017E,
62     0x9F => 0x0178,
63 wakaba 1.4 }; # $c1_entity_char
64 wakaba 1.1
65     my $special_category = {
66     address => 1, area => 1, base => 1, basefont => 1, bgsound => 1,
67     blockquote => 1, body => 1, br => 1, center => 1, col => 1, colgroup => 1,
68     dd => 1, dir => 1, div => 1, dl => 1, dt => 1, embed => 1, fieldset => 1,
69     form => 1, frame => 1, frameset => 1, h1 => 1, h2 => 1, h3 => 1,
70     h4 => 1, h5 => 1, h6 => 1, head => 1, hr => 1, iframe => 1, image => 1,
71     img => 1, input => 1, isindex => 1, li => 1, link => 1, listing => 1,
72     menu => 1, meta => 1, noembed => 1, noframes => 1, noscript => 1,
73     ol => 1, optgroup => 1, option => 1, p => 1, param => 1, plaintext => 1,
74     pre => 1, script => 1, select => 1, spacer => 1, style => 1, tbody => 1,
75     textarea => 1, tfoot => 1, thead => 1, title => 1, tr => 1, ul => 1, wbr => 1,
76     };
77     my $scoping_category = {
78     button => 1, caption => 1, html => 1, marquee => 1, object => 1,
79     table => 1, td => 1, th => 1,
80     };
81     my $formatting_category = {
82     a => 1, b => 1, big => 1, em => 1, font => 1, i => 1, nobr => 1,
83     s => 1, small => 1, strile => 1, strong => 1, tt => 1, u => 1,
84     };
85     # $phrasing_category: all other elements
86    
87     sub parse_string ($$$;$) {
88     my $self = shift->new;
89     my $s = \$_[0];
90     $self->{document} = $_[1];
91    
92 wakaba 1.3 ## NOTE: |set_inner_html| copies most of this method's code
93    
94 wakaba 1.1 my $i = 0;
95 wakaba 1.3 my $line = 1;
96     my $column = 0;
97 wakaba 1.1 $self->{set_next_input_character} = sub {
98     my $self = shift;
99 wakaba 1.13
100     pop @{$self->{prev_input_character}};
101     unshift @{$self->{prev_input_character}}, $self->{next_input_character};
102    
103 wakaba 1.1 $self->{next_input_character} = -1 and return if $i >= length $$s;
104     $self->{next_input_character} = ord substr $$s, $i++, 1;
105 wakaba 1.3 $column++;
106 wakaba 1.1
107 wakaba 1.4 if ($self->{next_input_character} == 0x000A) { # LF
108     $line++;
109     $column = 0;
110     } elsif ($self->{next_input_character} == 0x000D) { # CR
111 wakaba 1.15 $i++ if substr ($$s, $i, 1) eq "\x0A";
112 wakaba 1.1 $self->{next_input_character} = 0x000A; # LF # MUST
113 wakaba 1.3 $line++;
114 wakaba 1.4 $column = 0;
115 wakaba 1.1 } elsif ($self->{next_input_character} > 0x10FFFF) {
116     $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
117     } elsif ($self->{next_input_character} == 0x0000) { # NULL
118 wakaba 1.8 $self->{parse_error}-> (type => 'NULL');
119 wakaba 1.1 $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
120     }
121     };
122 wakaba 1.13 $self->{prev_input_character} = [-1, -1, -1];
123     $self->{next_input_character} = -1;
124 wakaba 1.1
125 wakaba 1.3 my $onerror = $_[2] || sub {
126     my (%opt) = @_;
127     warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n";
128     };
129     $self->{parse_error} = sub {
130     $onerror->(@_, line => $line, column => $column);
131 wakaba 1.1 };
132    
133     $self->_initialize_tokenizer;
134     $self->_initialize_tree_constructor;
135     $self->_construct_tree;
136     $self->_terminate_tree_constructor;
137    
138     return $self->{document};
139     } # parse_string
140    
141     sub new ($) {
142     my $class = shift;
143     my $self = bless {}, $class;
144     $self->{set_next_input_character} = sub {
145     $self->{next_input_character} = -1;
146     };
147     $self->{parse_error} = sub {
148     #
149     };
150     return $self;
151     } # new
152    
153     ## Implementations MUST act as if state machine in the spec
154    
155     sub _initialize_tokenizer ($) {
156     my $self = shift;
157     $self->{state} = 'data'; # MUST
158     $self->{content_model_flag} = 'PCDATA'; # be
159     undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE
160     undef $self->{current_attribute};
161     undef $self->{last_emitted_start_tag_name};
162     undef $self->{last_attribute_value_state};
163     $self->{char} = [];
164     # $self->{next_input_character}
165    
166     if (@{$self->{char}}) {
167     $self->{next_input_character} = shift @{$self->{char}};
168     } else {
169     $self->{set_next_input_character}->($self);
170     }
171    
172     $self->{token} = [];
173 wakaba 1.18 # $self->{escape}
174 wakaba 1.1 } # _initialize_tokenizer
175    
176     ## A token has:
177     ## ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',
178     ## 'character', or 'end-of-file'
179 wakaba 1.18 ## ->{name} (DOCTYPE, start tag (tag name), end tag (tag name))
180     ## ->{public_identifier} (DOCTYPE)
181     ## ->{system_identifier} (DOCTYPE)
182     ## ->{correct} == 1 or 0 (DOCTYPE)
183 wakaba 1.1 ## ->{attributes} isa HASH (start tag, end tag)
184     ## ->{data} (comment, character)
185    
186     ## Emitted token MUST immediately be handled by the tree construction state.
187    
188     ## Before each step, UA MAY check to see if either one of the scripts in
189     ## "list of scripts that will execute as soon as possible" or the first
190     ## script in the "list of scripts that will execute asynchronously",
191     ## has completed loading. If one has, then it MUST be executed
192     ## and removed from the list.
193    
194     sub _get_next_token ($) {
195     my $self = shift;
196     if (@{$self->{token}}) {
197     return shift @{$self->{token}};
198     }
199    
200     A: {
201     if ($self->{state} eq 'data') {
202     if ($self->{next_input_character} == 0x0026) { # &
203     if ($self->{content_model_flag} eq 'PCDATA' or
204     $self->{content_model_flag} eq 'RCDATA') {
205     $self->{state} = 'entity data';
206    
207     if (@{$self->{char}}) {
208     $self->{next_input_character} = shift @{$self->{char}};
209     } else {
210     $self->{set_next_input_character}->($self);
211     }
212    
213     redo A;
214     } else {
215     #
216     }
217 wakaba 1.13 } elsif ($self->{next_input_character} == 0x002D) { # -
218     if ($self->{content_model_flag} eq 'RCDATA' or
219     $self->{content_model_flag} eq 'CDATA') {
220     unless ($self->{escape}) {
221     if ($self->{prev_input_character}->[0] == 0x002D and # -
222     $self->{prev_input_character}->[1] == 0x0021 and # !
223     $self->{prev_input_character}->[2] == 0x003C) { # <
224     $self->{escape} = 1;
225     }
226     }
227     }
228    
229     #
230 wakaba 1.1 } elsif ($self->{next_input_character} == 0x003C) { # <
231 wakaba 1.13 if ($self->{content_model_flag} eq 'PCDATA' or
232     (($self->{content_model_flag} eq 'CDATA' or
233     $self->{content_model_flag} eq 'RCDATA') and
234     not $self->{escape})) {
235 wakaba 1.1 $self->{state} = 'tag open';
236    
237     if (@{$self->{char}}) {
238     $self->{next_input_character} = shift @{$self->{char}};
239     } else {
240     $self->{set_next_input_character}->($self);
241     }
242    
243     redo A;
244     } else {
245     #
246     }
247 wakaba 1.13 } elsif ($self->{next_input_character} == 0x003E) { # >
248     if ($self->{escape} and
249     ($self->{content_model_flag} eq 'RCDATA' or
250     $self->{content_model_flag} eq 'CDATA')) {
251     if ($self->{prev_input_character}->[0] == 0x002D and # -
252     $self->{prev_input_character}->[1] == 0x002D) { # -
253     delete $self->{escape};
254     }
255     }
256    
257     #
258 wakaba 1.1 } elsif ($self->{next_input_character} == -1) {
259     return ({type => 'end-of-file'});
260     last A; ## TODO: ok?
261     }
262     # Anything else
263     my $token = {type => 'character',
264     data => chr $self->{next_input_character}};
265     ## Stay in the data state
266    
267     if (@{$self->{char}}) {
268     $self->{next_input_character} = shift @{$self->{char}};
269     } else {
270     $self->{set_next_input_character}->($self);
271     }
272    
273    
274     return ($token);
275    
276     redo A;
277     } elsif ($self->{state} eq 'entity data') {
278     ## (cannot happen in CDATA state)
279    
280 wakaba 1.26 my $token = $self->_tokenize_attempt_to_consume_an_entity (0);
281 wakaba 1.1
282     $self->{state} = 'data';
283     # next-input-character is already done
284    
285     unless (defined $token) {
286     return ({type => 'character', data => '&'});
287     } else {
288     return ($token);
289     }
290    
291     redo A;
292     } elsif ($self->{state} eq 'tag open') {
293     if ($self->{content_model_flag} eq 'RCDATA' or
294     $self->{content_model_flag} eq 'CDATA') {
295     if ($self->{next_input_character} == 0x002F) { # /
296    
297     if (@{$self->{char}}) {
298     $self->{next_input_character} = shift @{$self->{char}};
299     } else {
300     $self->{set_next_input_character}->($self);
301     }
302    
303     $self->{state} = 'close tag open';
304     redo A;
305     } else {
306     ## reconsume
307     $self->{state} = 'data';
308    
309     return ({type => 'character', data => '<'});
310    
311     redo A;
312     }
313     } elsif ($self->{content_model_flag} eq 'PCDATA') {
314     if ($self->{next_input_character} == 0x0021) { # !
315     $self->{state} = 'markup declaration open';
316    
317     if (@{$self->{char}}) {
318     $self->{next_input_character} = shift @{$self->{char}};
319     } else {
320     $self->{set_next_input_character}->($self);
321     }
322    
323     redo A;
324     } elsif ($self->{next_input_character} == 0x002F) { # /
325     $self->{state} = 'close tag open';
326    
327     if (@{$self->{char}}) {
328     $self->{next_input_character} = shift @{$self->{char}};
329     } else {
330     $self->{set_next_input_character}->($self);
331     }
332    
333     redo A;
334     } elsif (0x0041 <= $self->{next_input_character} and
335     $self->{next_input_character} <= 0x005A) { # A..Z
336     $self->{current_token}
337     = {type => 'start tag',
338     tag_name => chr ($self->{next_input_character} + 0x0020)};
339     $self->{state} = 'tag name';
340    
341     if (@{$self->{char}}) {
342     $self->{next_input_character} = shift @{$self->{char}};
343     } else {
344     $self->{set_next_input_character}->($self);
345     }
346    
347     redo A;
348     } elsif (0x0061 <= $self->{next_input_character} and
349     $self->{next_input_character} <= 0x007A) { # a..z
350     $self->{current_token} = {type => 'start tag',
351     tag_name => chr ($self->{next_input_character})};
352     $self->{state} = 'tag name';
353    
354     if (@{$self->{char}}) {
355     $self->{next_input_character} = shift @{$self->{char}};
356     } else {
357     $self->{set_next_input_character}->($self);
358     }
359    
360     redo A;
361     } elsif ($self->{next_input_character} == 0x003E) { # >
362 wakaba 1.3 $self->{parse_error}-> (type => 'empty start tag');
363 wakaba 1.1 $self->{state} = 'data';
364    
365     if (@{$self->{char}}) {
366     $self->{next_input_character} = shift @{$self->{char}};
367     } else {
368     $self->{set_next_input_character}->($self);
369     }
370    
371    
372     return ({type => 'character', data => '<>'});
373    
374     redo A;
375     } elsif ($self->{next_input_character} == 0x003F) { # ?
376 wakaba 1.3 $self->{parse_error}-> (type => 'pio');
377 wakaba 1.1 $self->{state} = 'bogus comment';
378     ## $self->{next_input_character} is intentionally left as is
379     redo A;
380     } else {
381 wakaba 1.3 $self->{parse_error}-> (type => 'bare stago');
382 wakaba 1.1 $self->{state} = 'data';
383     ## reconsume
384    
385     return ({type => 'character', data => '<'});
386    
387     redo A;
388     }
389     } else {
390     die "$0: $self->{content_model_flag}: Unknown content model flag";
391     }
392     } elsif ($self->{state} eq 'close tag open') {
393     if ($self->{content_model_flag} eq 'RCDATA' or
394     $self->{content_model_flag} eq 'CDATA') {
395 wakaba 1.23 if (defined $self->{last_emitted_start_tag_name}) {
396 wakaba 1.30 ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>
397 wakaba 1.23 my @next_char;
398     TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {
399     push @next_char, $self->{next_input_character};
400     my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);
401     my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;
402     if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {
403    
404 wakaba 1.1 if (@{$self->{char}}) {
405     $self->{next_input_character} = shift @{$self->{char}};
406     } else {
407     $self->{set_next_input_character}->($self);
408     }
409    
410 wakaba 1.23 next TAGNAME;
411     } else {
412     $self->{next_input_character} = shift @next_char; # reconsume
413     unshift @{$self->{char}}, (@next_char);
414     $self->{state} = 'data';
415    
416     return ({type => 'character', data => '</'});
417    
418     redo A;
419     }
420     }
421     push @next_char, $self->{next_input_character};
422    
423     unless ($self->{next_input_character} == 0x0009 or # HT
424     $self->{next_input_character} == 0x000A or # LF
425     $self->{next_input_character} == 0x000B or # VT
426     $self->{next_input_character} == 0x000C or # FF
427     $self->{next_input_character} == 0x0020 or # SP
428     $self->{next_input_character} == 0x003E or # >
429     $self->{next_input_character} == 0x002F or # /
430     $self->{next_input_character} == -1) {
431 wakaba 1.1 $self->{next_input_character} = shift @next_char; # reconsume
432     unshift @{$self->{char}}, (@next_char);
433     $self->{state} = 'data';
434     return ({type => 'character', data => '</'});
435     redo A;
436 wakaba 1.23 } else {
437     $self->{next_input_character} = shift @next_char;
438     unshift @{$self->{char}}, (@next_char);
439     # and consume...
440 wakaba 1.1 }
441 wakaba 1.23 } else {
442     ## No start tag token has ever been emitted
443     # next-input-character is already done
444 wakaba 1.1 $self->{state} = 'data';
445     return ({type => 'character', data => '</'});
446     redo A;
447     }
448     }
449    
450     if (0x0041 <= $self->{next_input_character} and
451     $self->{next_input_character} <= 0x005A) { # A..Z
452     $self->{current_token} = {type => 'end tag',
453     tag_name => chr ($self->{next_input_character} + 0x0020)};
454     $self->{state} = 'tag name';
455    
456     if (@{$self->{char}}) {
457     $self->{next_input_character} = shift @{$self->{char}};
458     } else {
459     $self->{set_next_input_character}->($self);
460     }
461    
462     redo A;
463     } elsif (0x0061 <= $self->{next_input_character} and
464     $self->{next_input_character} <= 0x007A) { # a..z
465     $self->{current_token} = {type => 'end tag',
466     tag_name => chr ($self->{next_input_character})};
467     $self->{state} = 'tag name';
468    
469     if (@{$self->{char}}) {
470     $self->{next_input_character} = shift @{$self->{char}};
471     } else {
472     $self->{set_next_input_character}->($self);
473     }
474    
475     redo A;
476     } elsif ($self->{next_input_character} == 0x003E) { # >
477 wakaba 1.3 $self->{parse_error}-> (type => 'empty end tag');
478 wakaba 1.1 $self->{state} = 'data';
479    
480     if (@{$self->{char}}) {
481     $self->{next_input_character} = shift @{$self->{char}};
482     } else {
483     $self->{set_next_input_character}->($self);
484     }
485    
486     redo A;
487     } elsif ($self->{next_input_character} == -1) {
488 wakaba 1.3 $self->{parse_error}-> (type => 'bare etago');
489 wakaba 1.1 $self->{state} = 'data';
490     # reconsume
491    
492     return ({type => 'character', data => '</'});
493    
494     redo A;
495     } else {
496 wakaba 1.3 $self->{parse_error}-> (type => 'bogus end tag');
497 wakaba 1.1 $self->{state} = 'bogus comment';
498     ## $self->{next_input_character} is intentionally left as is
499     redo A;
500     }
501     } elsif ($self->{state} eq 'tag name') {
502     if ($self->{next_input_character} == 0x0009 or # HT
503     $self->{next_input_character} == 0x000A or # LF
504     $self->{next_input_character} == 0x000B or # VT
505     $self->{next_input_character} == 0x000C or # FF
506     $self->{next_input_character} == 0x0020) { # SP
507     $self->{state} = 'before attribute name';
508    
509     if (@{$self->{char}}) {
510     $self->{next_input_character} = shift @{$self->{char}};
511     } else {
512     $self->{set_next_input_character}->($self);
513     }
514    
515     redo A;
516     } elsif ($self->{next_input_character} == 0x003E) { # >
517     if ($self->{current_token}->{type} eq 'start tag') {
518 wakaba 1.28 $self->{current_token}->{first_start_tag}
519     = not defined $self->{last_emitted_start_tag_name};
520 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
521     } elsif ($self->{current_token}->{type} eq 'end tag') {
522     $self->{content_model_flag} = 'PCDATA'; # MUST
523     if ($self->{current_token}->{attributes}) {
524 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
525 wakaba 1.1 }
526     } else {
527     die "$0: $self->{current_token}->{type}: Unknown token type";
528     }
529     $self->{state} = 'data';
530    
531     if (@{$self->{char}}) {
532     $self->{next_input_character} = shift @{$self->{char}};
533     } else {
534     $self->{set_next_input_character}->($self);
535     }
536    
537    
538     return ($self->{current_token}); # start tag or end tag
539    
540     redo A;
541     } elsif (0x0041 <= $self->{next_input_character} and
542     $self->{next_input_character} <= 0x005A) { # A..Z
543     $self->{current_token}->{tag_name} .= chr ($self->{next_input_character} + 0x0020);
544     # start tag or end tag
545     ## Stay in this state
546    
547     if (@{$self->{char}}) {
548     $self->{next_input_character} = shift @{$self->{char}};
549     } else {
550     $self->{set_next_input_character}->($self);
551     }
552    
553     redo A;
554 wakaba 1.17 } elsif ($self->{next_input_character} == -1) {
555 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed tag');
556 wakaba 1.1 if ($self->{current_token}->{type} eq 'start tag') {
557 wakaba 1.28 $self->{current_token}->{first_start_tag}
558     = not defined $self->{last_emitted_start_tag_name};
559 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
560     } elsif ($self->{current_token}->{type} eq 'end tag') {
561     $self->{content_model_flag} = 'PCDATA'; # MUST
562     if ($self->{current_token}->{attributes}) {
563 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
564 wakaba 1.1 }
565     } else {
566     die "$0: $self->{current_token}->{type}: Unknown token type";
567     }
568     $self->{state} = 'data';
569     # reconsume
570    
571     return ($self->{current_token}); # start tag or end tag
572    
573     redo A;
574     } elsif ($self->{next_input_character} == 0x002F) { # /
575    
576     if (@{$self->{char}}) {
577     $self->{next_input_character} = shift @{$self->{char}};
578     } else {
579     $self->{set_next_input_character}->($self);
580     }
581    
582     if ($self->{next_input_character} == 0x003E and # >
583     $self->{current_token}->{type} eq 'start tag' and
584     $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {
585     # permitted slash
586     #
587     } else {
588 wakaba 1.3 $self->{parse_error}-> (type => 'nestc');
589 wakaba 1.1 }
590     $self->{state} = 'before attribute name';
591     # next-input-character is already done
592     redo A;
593     } else {
594     $self->{current_token}->{tag_name} .= chr $self->{next_input_character};
595     # start tag or end tag
596     ## Stay in the state
597    
598     if (@{$self->{char}}) {
599     $self->{next_input_character} = shift @{$self->{char}};
600     } else {
601     $self->{set_next_input_character}->($self);
602     }
603    
604     redo A;
605     }
606     } elsif ($self->{state} eq 'before attribute name') {
607     if ($self->{next_input_character} == 0x0009 or # HT
608     $self->{next_input_character} == 0x000A or # LF
609     $self->{next_input_character} == 0x000B or # VT
610     $self->{next_input_character} == 0x000C or # FF
611     $self->{next_input_character} == 0x0020) { # SP
612     ## Stay in the state
613    
614     if (@{$self->{char}}) {
615     $self->{next_input_character} = shift @{$self->{char}};
616     } else {
617     $self->{set_next_input_character}->($self);
618     }
619    
620     redo A;
621     } elsif ($self->{next_input_character} == 0x003E) { # >
622     if ($self->{current_token}->{type} eq 'start tag') {
623 wakaba 1.28 $self->{current_token}->{first_start_tag}
624     = not defined $self->{last_emitted_start_tag_name};
625 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
626     } elsif ($self->{current_token}->{type} eq 'end tag') {
627     $self->{content_model_flag} = 'PCDATA'; # MUST
628     if ($self->{current_token}->{attributes}) {
629 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
630 wakaba 1.1 }
631     } else {
632     die "$0: $self->{current_token}->{type}: Unknown token type";
633     }
634     $self->{state} = 'data';
635    
636     if (@{$self->{char}}) {
637     $self->{next_input_character} = shift @{$self->{char}};
638     } else {
639     $self->{set_next_input_character}->($self);
640     }
641    
642    
643     return ($self->{current_token}); # start tag or end tag
644    
645     redo A;
646     } elsif (0x0041 <= $self->{next_input_character} and
647     $self->{next_input_character} <= 0x005A) { # A..Z
648     $self->{current_attribute} = {name => chr ($self->{next_input_character} + 0x0020),
649     value => ''};
650     $self->{state} = 'attribute name';
651    
652     if (@{$self->{char}}) {
653     $self->{next_input_character} = shift @{$self->{char}};
654     } else {
655     $self->{set_next_input_character}->($self);
656     }
657    
658     redo A;
659     } elsif ($self->{next_input_character} == 0x002F) { # /
660    
661     if (@{$self->{char}}) {
662     $self->{next_input_character} = shift @{$self->{char}};
663     } else {
664     $self->{set_next_input_character}->($self);
665     }
666    
667     if ($self->{next_input_character} == 0x003E and # >
668     $self->{current_token}->{type} eq 'start tag' and
669     $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {
670     # permitted slash
671     #
672     } else {
673 wakaba 1.3 $self->{parse_error}-> (type => 'nestc');
674 wakaba 1.1 }
675     ## Stay in the state
676     # next-input-character is already done
677     redo A;
678 wakaba 1.17 } elsif ($self->{next_input_character} == -1) {
679 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed tag');
680 wakaba 1.1 if ($self->{current_token}->{type} eq 'start tag') {
681 wakaba 1.28 $self->{current_token}->{first_start_tag}
682     = not defined $self->{last_emitted_start_tag_name};
683 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
684     } elsif ($self->{current_token}->{type} eq 'end tag') {
685     $self->{content_model_flag} = 'PCDATA'; # MUST
686     if ($self->{current_token}->{attributes}) {
687 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
688 wakaba 1.1 }
689     } else {
690     die "$0: $self->{current_token}->{type}: Unknown token type";
691     }
692     $self->{state} = 'data';
693     # reconsume
694    
695     return ($self->{current_token}); # start tag or end tag
696    
697     redo A;
698     } else {
699     $self->{current_attribute} = {name => chr ($self->{next_input_character}),
700     value => ''};
701     $self->{state} = 'attribute name';
702    
703     if (@{$self->{char}}) {
704     $self->{next_input_character} = shift @{$self->{char}};
705     } else {
706     $self->{set_next_input_character}->($self);
707     }
708    
709     redo A;
710     }
711     } elsif ($self->{state} eq 'attribute name') {
712     my $before_leave = sub {
713     if (exists $self->{current_token}->{attributes} # start tag or end tag
714     ->{$self->{current_attribute}->{name}}) { # MUST
715 wakaba 1.3 $self->{parse_error}-> (type => 'dupulicate attribute');
716 wakaba 1.1 ## Discard $self->{current_attribute} # MUST
717     } else {
718     $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}}
719     = $self->{current_attribute};
720     }
721     }; # $before_leave
722    
723     if ($self->{next_input_character} == 0x0009 or # HT
724     $self->{next_input_character} == 0x000A or # LF
725     $self->{next_input_character} == 0x000B or # VT
726     $self->{next_input_character} == 0x000C or # FF
727     $self->{next_input_character} == 0x0020) { # SP
728     $before_leave->();
729     $self->{state} = 'after attribute name';
730    
731     if (@{$self->{char}}) {
732     $self->{next_input_character} = shift @{$self->{char}};
733     } else {
734     $self->{set_next_input_character}->($self);
735     }
736    
737     redo A;
738     } elsif ($self->{next_input_character} == 0x003D) { # =
739     $before_leave->();
740     $self->{state} = 'before attribute value';
741    
742     if (@{$self->{char}}) {
743     $self->{next_input_character} = shift @{$self->{char}};
744     } else {
745     $self->{set_next_input_character}->($self);
746     }
747    
748     redo A;
749     } elsif ($self->{next_input_character} == 0x003E) { # >
750     $before_leave->();
751     if ($self->{current_token}->{type} eq 'start tag') {
752 wakaba 1.28 $self->{current_token}->{first_start_tag}
753     = not defined $self->{last_emitted_start_tag_name};
754 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
755     } elsif ($self->{current_token}->{type} eq 'end tag') {
756     $self->{content_model_flag} = 'PCDATA'; # MUST
757     if ($self->{current_token}->{attributes}) {
758 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
759 wakaba 1.1 }
760     } else {
761     die "$0: $self->{current_token}->{type}: Unknown token type";
762     }
763     $self->{state} = 'data';
764    
765     if (@{$self->{char}}) {
766     $self->{next_input_character} = shift @{$self->{char}};
767     } else {
768     $self->{set_next_input_character}->($self);
769     }
770    
771    
772     return ($self->{current_token}); # start tag or end tag
773    
774     redo A;
775     } elsif (0x0041 <= $self->{next_input_character} and
776     $self->{next_input_character} <= 0x005A) { # A..Z
777     $self->{current_attribute}->{name} .= chr ($self->{next_input_character} + 0x0020);
778     ## Stay in the state
779    
780     if (@{$self->{char}}) {
781     $self->{next_input_character} = shift @{$self->{char}};
782     } else {
783     $self->{set_next_input_character}->($self);
784     }
785    
786     redo A;
787     } elsif ($self->{next_input_character} == 0x002F) { # /
788     $before_leave->();
789    
790     if (@{$self->{char}}) {
791     $self->{next_input_character} = shift @{$self->{char}};
792     } else {
793     $self->{set_next_input_character}->($self);
794     }
795    
796     if ($self->{next_input_character} == 0x003E and # >
797     $self->{current_token}->{type} eq 'start tag' and
798     $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {
799     # permitted slash
800     #
801     } else {
802 wakaba 1.3 $self->{parse_error}-> (type => 'nestc');
803 wakaba 1.1 }
804     $self->{state} = 'before attribute name';
805     # next-input-character is already done
806     redo A;
807 wakaba 1.17 } elsif ($self->{next_input_character} == -1) {
808 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed tag');
809 wakaba 1.1 $before_leave->();
810     if ($self->{current_token}->{type} eq 'start tag') {
811 wakaba 1.28 $self->{current_token}->{first_start_tag}
812     = not defined $self->{last_emitted_start_tag_name};
813 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
814     } elsif ($self->{current_token}->{type} eq 'end tag') {
815     $self->{content_model_flag} = 'PCDATA'; # MUST
816     if ($self->{current_token}->{attributes}) {
817 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
818 wakaba 1.1 }
819     } else {
820     die "$0: $self->{current_token}->{type}: Unknown token type";
821     }
822     $self->{state} = 'data';
823     # reconsume
824    
825     return ($self->{current_token}); # start tag or end tag
826    
827     redo A;
828     } else {
829     $self->{current_attribute}->{name} .= chr ($self->{next_input_character});
830     ## Stay in the state
831    
832     if (@{$self->{char}}) {
833     $self->{next_input_character} = shift @{$self->{char}};
834     } else {
835     $self->{set_next_input_character}->($self);
836     }
837    
838     redo A;
839     }
840     } elsif ($self->{state} eq 'after attribute name') {
841     if ($self->{next_input_character} == 0x0009 or # HT
842     $self->{next_input_character} == 0x000A or # LF
843     $self->{next_input_character} == 0x000B or # VT
844     $self->{next_input_character} == 0x000C or # FF
845     $self->{next_input_character} == 0x0020) { # SP
846     ## Stay in the state
847    
848     if (@{$self->{char}}) {
849     $self->{next_input_character} = shift @{$self->{char}};
850     } else {
851     $self->{set_next_input_character}->($self);
852     }
853    
854     redo A;
855     } elsif ($self->{next_input_character} == 0x003D) { # =
856     $self->{state} = 'before attribute value';
857    
858     if (@{$self->{char}}) {
859     $self->{next_input_character} = shift @{$self->{char}};
860     } else {
861     $self->{set_next_input_character}->($self);
862     }
863    
864     redo A;
865     } elsif ($self->{next_input_character} == 0x003E) { # >
866     if ($self->{current_token}->{type} eq 'start tag') {
867 wakaba 1.28 $self->{current_token}->{first_start_tag}
868     = not defined $self->{last_emitted_start_tag_name};
869 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
870     } elsif ($self->{current_token}->{type} eq 'end tag') {
871     $self->{content_model_flag} = 'PCDATA'; # MUST
872     if ($self->{current_token}->{attributes}) {
873 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
874 wakaba 1.1 }
875     } else {
876     die "$0: $self->{current_token}->{type}: Unknown token type";
877     }
878     $self->{state} = 'data';
879    
880     if (@{$self->{char}}) {
881     $self->{next_input_character} = shift @{$self->{char}};
882     } else {
883     $self->{set_next_input_character}->($self);
884     }
885    
886    
887     return ($self->{current_token}); # start tag or end tag
888    
889     redo A;
890     } elsif (0x0041 <= $self->{next_input_character} and
891     $self->{next_input_character} <= 0x005A) { # A..Z
892     $self->{current_attribute} = {name => chr ($self->{next_input_character} + 0x0020),
893     value => ''};
894     $self->{state} = 'attribute name';
895    
896     if (@{$self->{char}}) {
897     $self->{next_input_character} = shift @{$self->{char}};
898     } else {
899     $self->{set_next_input_character}->($self);
900     }
901    
902     redo A;
903     } elsif ($self->{next_input_character} == 0x002F) { # /
904    
905     if (@{$self->{char}}) {
906     $self->{next_input_character} = shift @{$self->{char}};
907     } else {
908     $self->{set_next_input_character}->($self);
909     }
910    
911     if ($self->{next_input_character} == 0x003E and # >
912     $self->{current_token}->{type} eq 'start tag' and
913     $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {
914     # permitted slash
915     #
916     } else {
917 wakaba 1.3 $self->{parse_error}-> (type => 'nestc');
918 wakaba 1.33 ## TODO: Different error type for <aa / bb> than <aa/>
919 wakaba 1.1 }
920     $self->{state} = 'before attribute name';
921     # next-input-character is already done
922     redo A;
923 wakaba 1.17 } elsif ($self->{next_input_character} == -1) {
924 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed tag');
925 wakaba 1.1 if ($self->{current_token}->{type} eq 'start tag') {
926 wakaba 1.28 $self->{current_token}->{first_start_tag}
927     = not defined $self->{last_emitted_start_tag_name};
928 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
929     } elsif ($self->{current_token}->{type} eq 'end tag') {
930     $self->{content_model_flag} = 'PCDATA'; # MUST
931     if ($self->{current_token}->{attributes}) {
932 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
933 wakaba 1.1 }
934     } else {
935     die "$0: $self->{current_token}->{type}: Unknown token type";
936     }
937     $self->{state} = 'data';
938     # reconsume
939    
940     return ($self->{current_token}); # start tag or end tag
941    
942     redo A;
943     } else {
944     $self->{current_attribute} = {name => chr ($self->{next_input_character}),
945     value => ''};
946     $self->{state} = 'attribute name';
947    
948     if (@{$self->{char}}) {
949     $self->{next_input_character} = shift @{$self->{char}};
950     } else {
951     $self->{set_next_input_character}->($self);
952     }
953    
954     redo A;
955     }
956     } elsif ($self->{state} eq 'before attribute value') {
957     if ($self->{next_input_character} == 0x0009 or # HT
958     $self->{next_input_character} == 0x000A or # LF
959     $self->{next_input_character} == 0x000B or # VT
960     $self->{next_input_character} == 0x000C or # FF
961     $self->{next_input_character} == 0x0020) { # SP
962     ## Stay in the state
963    
964     if (@{$self->{char}}) {
965     $self->{next_input_character} = shift @{$self->{char}};
966     } else {
967     $self->{set_next_input_character}->($self);
968     }
969    
970     redo A;
971     } elsif ($self->{next_input_character} == 0x0022) { # "
972     $self->{state} = 'attribute value (double-quoted)';
973    
974     if (@{$self->{char}}) {
975     $self->{next_input_character} = shift @{$self->{char}};
976     } else {
977     $self->{set_next_input_character}->($self);
978     }
979    
980     redo A;
981     } elsif ($self->{next_input_character} == 0x0026) { # &
982     $self->{state} = 'attribute value (unquoted)';
983     ## reconsume
984     redo A;
985     } elsif ($self->{next_input_character} == 0x0027) { # '
986     $self->{state} = 'attribute value (single-quoted)';
987    
988     if (@{$self->{char}}) {
989     $self->{next_input_character} = shift @{$self->{char}};
990     } else {
991     $self->{set_next_input_character}->($self);
992     }
993    
994     redo A;
995     } elsif ($self->{next_input_character} == 0x003E) { # >
996     if ($self->{current_token}->{type} eq 'start tag') {
997 wakaba 1.28 $self->{current_token}->{first_start_tag}
998     = not defined $self->{last_emitted_start_tag_name};
999 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1000     } elsif ($self->{current_token}->{type} eq 'end tag') {
1001     $self->{content_model_flag} = 'PCDATA'; # MUST
1002     if ($self->{current_token}->{attributes}) {
1003 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
1004 wakaba 1.1 }
1005     } else {
1006     die "$0: $self->{current_token}->{type}: Unknown token type";
1007     }
1008     $self->{state} = 'data';
1009    
1010     if (@{$self->{char}}) {
1011     $self->{next_input_character} = shift @{$self->{char}};
1012     } else {
1013     $self->{set_next_input_character}->($self);
1014     }
1015    
1016    
1017     return ($self->{current_token}); # start tag or end tag
1018    
1019     redo A;
1020 wakaba 1.17 } elsif ($self->{next_input_character} == -1) {
1021 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed tag');
1022 wakaba 1.1 if ($self->{current_token}->{type} eq 'start tag') {
1023 wakaba 1.28 $self->{current_token}->{first_start_tag}
1024     = not defined $self->{last_emitted_start_tag_name};
1025 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1026     } elsif ($self->{current_token}->{type} eq 'end tag') {
1027     $self->{content_model_flag} = 'PCDATA'; # MUST
1028     if ($self->{current_token}->{attributes}) {
1029 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
1030 wakaba 1.1 }
1031     } else {
1032     die "$0: $self->{current_token}->{type}: Unknown token type";
1033     }
1034     $self->{state} = 'data';
1035     ## reconsume
1036    
1037     return ($self->{current_token}); # start tag or end tag
1038    
1039     redo A;
1040     } else {
1041     $self->{current_attribute}->{value} .= chr ($self->{next_input_character});
1042     $self->{state} = 'attribute value (unquoted)';
1043    
1044     if (@{$self->{char}}) {
1045     $self->{next_input_character} = shift @{$self->{char}};
1046     } else {
1047     $self->{set_next_input_character}->($self);
1048     }
1049    
1050     redo A;
1051     }
1052     } elsif ($self->{state} eq 'attribute value (double-quoted)') {
1053     if ($self->{next_input_character} == 0x0022) { # "
1054     $self->{state} = 'before attribute name';
1055    
1056     if (@{$self->{char}}) {
1057     $self->{next_input_character} = shift @{$self->{char}};
1058     } else {
1059     $self->{set_next_input_character}->($self);
1060     }
1061    
1062     redo A;
1063     } elsif ($self->{next_input_character} == 0x0026) { # &
1064     $self->{last_attribute_value_state} = 'attribute value (double-quoted)';
1065     $self->{state} = 'entity in attribute value';
1066    
1067     if (@{$self->{char}}) {
1068     $self->{next_input_character} = shift @{$self->{char}};
1069     } else {
1070     $self->{set_next_input_character}->($self);
1071     }
1072    
1073     redo A;
1074     } elsif ($self->{next_input_character} == -1) {
1075 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed attribute value');
1076 wakaba 1.1 if ($self->{current_token}->{type} eq 'start tag') {
1077 wakaba 1.28 $self->{current_token}->{first_start_tag}
1078     = not defined $self->{last_emitted_start_tag_name};
1079 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1080     } elsif ($self->{current_token}->{type} eq 'end tag') {
1081     $self->{content_model_flag} = 'PCDATA'; # MUST
1082     if ($self->{current_token}->{attributes}) {
1083 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
1084 wakaba 1.1 }
1085     } else {
1086     die "$0: $self->{current_token}->{type}: Unknown token type";
1087     }
1088     $self->{state} = 'data';
1089     ## reconsume
1090    
1091     return ($self->{current_token}); # start tag or end tag
1092    
1093     redo A;
1094     } else {
1095     $self->{current_attribute}->{value} .= chr ($self->{next_input_character});
1096     ## Stay in the state
1097    
1098     if (@{$self->{char}}) {
1099     $self->{next_input_character} = shift @{$self->{char}};
1100     } else {
1101     $self->{set_next_input_character}->($self);
1102     }
1103    
1104     redo A;
1105     }
1106     } elsif ($self->{state} eq 'attribute value (single-quoted)') {
1107     if ($self->{next_input_character} == 0x0027) { # '
1108     $self->{state} = 'before attribute name';
1109    
1110     if (@{$self->{char}}) {
1111     $self->{next_input_character} = shift @{$self->{char}};
1112     } else {
1113     $self->{set_next_input_character}->($self);
1114     }
1115    
1116     redo A;
1117     } elsif ($self->{next_input_character} == 0x0026) { # &
1118     $self->{last_attribute_value_state} = 'attribute value (single-quoted)';
1119     $self->{state} = 'entity in attribute value';
1120    
1121     if (@{$self->{char}}) {
1122     $self->{next_input_character} = shift @{$self->{char}};
1123     } else {
1124     $self->{set_next_input_character}->($self);
1125     }
1126    
1127     redo A;
1128     } elsif ($self->{next_input_character} == -1) {
1129 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed attribute value');
1130 wakaba 1.1 if ($self->{current_token}->{type} eq 'start tag') {
1131 wakaba 1.28 $self->{current_token}->{first_start_tag}
1132     = not defined $self->{last_emitted_start_tag_name};
1133 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1134     } elsif ($self->{current_token}->{type} eq 'end tag') {
1135     $self->{content_model_flag} = 'PCDATA'; # MUST
1136     if ($self->{current_token}->{attributes}) {
1137 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
1138 wakaba 1.1 }
1139     } else {
1140     die "$0: $self->{current_token}->{type}: Unknown token type";
1141     }
1142     $self->{state} = 'data';
1143     ## reconsume
1144    
1145     return ($self->{current_token}); # start tag or end tag
1146    
1147     redo A;
1148     } else {
1149     $self->{current_attribute}->{value} .= chr ($self->{next_input_character});
1150     ## Stay in the state
1151    
1152     if (@{$self->{char}}) {
1153     $self->{next_input_character} = shift @{$self->{char}};
1154     } else {
1155     $self->{set_next_input_character}->($self);
1156     }
1157    
1158     redo A;
1159     }
1160     } elsif ($self->{state} eq 'attribute value (unquoted)') {
1161     if ($self->{next_input_character} == 0x0009 or # HT
1162     $self->{next_input_character} == 0x000A or # LF
1163     $self->{next_input_character} == 0x000B or # HT
1164     $self->{next_input_character} == 0x000C or # FF
1165     $self->{next_input_character} == 0x0020) { # SP
1166     $self->{state} = 'before attribute name';
1167    
1168     if (@{$self->{char}}) {
1169     $self->{next_input_character} = shift @{$self->{char}};
1170     } else {
1171     $self->{set_next_input_character}->($self);
1172     }
1173    
1174     redo A;
1175     } elsif ($self->{next_input_character} == 0x0026) { # &
1176     $self->{last_attribute_value_state} = 'attribute value (unquoted)';
1177     $self->{state} = 'entity in attribute value';
1178    
1179     if (@{$self->{char}}) {
1180     $self->{next_input_character} = shift @{$self->{char}};
1181     } else {
1182     $self->{set_next_input_character}->($self);
1183     }
1184    
1185     redo A;
1186     } elsif ($self->{next_input_character} == 0x003E) { # >
1187     if ($self->{current_token}->{type} eq 'start tag') {
1188 wakaba 1.28 $self->{current_token}->{first_start_tag}
1189     = not defined $self->{last_emitted_start_tag_name};
1190 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1191     } elsif ($self->{current_token}->{type} eq 'end tag') {
1192     $self->{content_model_flag} = 'PCDATA'; # MUST
1193     if ($self->{current_token}->{attributes}) {
1194 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
1195 wakaba 1.1 }
1196     } else {
1197     die "$0: $self->{current_token}->{type}: Unknown token type";
1198     }
1199     $self->{state} = 'data';
1200    
1201     if (@{$self->{char}}) {
1202     $self->{next_input_character} = shift @{$self->{char}};
1203     } else {
1204     $self->{set_next_input_character}->($self);
1205     }
1206    
1207    
1208     return ($self->{current_token}); # start tag or end tag
1209    
1210     redo A;
1211 wakaba 1.17 } elsif ($self->{next_input_character} == -1) {
1212 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed tag');
1213 wakaba 1.1 if ($self->{current_token}->{type} eq 'start tag') {
1214 wakaba 1.28 $self->{current_token}->{first_start_tag}
1215     = not defined $self->{last_emitted_start_tag_name};
1216 wakaba 1.1 $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1217     } elsif ($self->{current_token}->{type} eq 'end tag') {
1218     $self->{content_model_flag} = 'PCDATA'; # MUST
1219     if ($self->{current_token}->{attributes}) {
1220 wakaba 1.3 $self->{parse_error}-> (type => 'end tag attribute');
1221 wakaba 1.1 }
1222     } else {
1223     die "$0: $self->{current_token}->{type}: Unknown token type";
1224     }
1225     $self->{state} = 'data';
1226     ## reconsume
1227    
1228     return ($self->{current_token}); # start tag or end tag
1229    
1230     redo A;
1231     } else {
1232     $self->{current_attribute}->{value} .= chr ($self->{next_input_character});
1233     ## Stay in the state
1234    
1235     if (@{$self->{char}}) {
1236     $self->{next_input_character} = shift @{$self->{char}};
1237     } else {
1238     $self->{set_next_input_character}->($self);
1239     }
1240    
1241     redo A;
1242     }
1243     } elsif ($self->{state} eq 'entity in attribute value') {
1244 wakaba 1.26 my $token = $self->_tokenize_attempt_to_consume_an_entity (1);
1245 wakaba 1.1
1246     unless (defined $token) {
1247     $self->{current_attribute}->{value} .= '&';
1248     } else {
1249     $self->{current_attribute}->{value} .= $token->{data};
1250     ## ISSUE: spec says "append the returned character token to the current attribute's value"
1251     }
1252    
1253     $self->{state} = $self->{last_attribute_value_state};
1254     # next-input-character is already done
1255     redo A;
1256     } elsif ($self->{state} eq 'bogus comment') {
1257     ## (only happen if PCDATA state)
1258    
1259     my $token = {type => 'comment', data => ''};
1260    
1261     BC: {
1262     if ($self->{next_input_character} == 0x003E) { # >
1263     $self->{state} = 'data';
1264    
1265     if (@{$self->{char}}) {
1266     $self->{next_input_character} = shift @{$self->{char}};
1267     } else {
1268     $self->{set_next_input_character}->($self);
1269     }
1270    
1271    
1272     return ($token);
1273    
1274     redo A;
1275     } elsif ($self->{next_input_character} == -1) {
1276     $self->{state} = 'data';
1277     ## reconsume
1278    
1279     return ($token);
1280    
1281     redo A;
1282     } else {
1283     $token->{data} .= chr ($self->{next_input_character});
1284    
1285     if (@{$self->{char}}) {
1286     $self->{next_input_character} = shift @{$self->{char}};
1287     } else {
1288     $self->{set_next_input_character}->($self);
1289     }
1290    
1291     redo BC;
1292     }
1293     } # BC
1294     } elsif ($self->{state} eq 'markup declaration open') {
1295     ## (only happen if PCDATA state)
1296    
1297     my @next_char;
1298     push @next_char, $self->{next_input_character};
1299    
1300     if ($self->{next_input_character} == 0x002D) { # -
1301    
1302     if (@{$self->{char}}) {
1303     $self->{next_input_character} = shift @{$self->{char}};
1304     } else {
1305     $self->{set_next_input_character}->($self);
1306     }
1307    
1308     push @next_char, $self->{next_input_character};
1309     if ($self->{next_input_character} == 0x002D) { # -
1310     $self->{current_token} = {type => 'comment', data => ''};
1311 wakaba 1.23 $self->{state} = 'comment start';
1312 wakaba 1.1
1313     if (@{$self->{char}}) {
1314     $self->{next_input_character} = shift @{$self->{char}};
1315     } else {
1316     $self->{set_next_input_character}->($self);
1317     }
1318    
1319     redo A;
1320     }
1321     } elsif ($self->{next_input_character} == 0x0044 or # D
1322     $self->{next_input_character} == 0x0064) { # d
1323    
1324     if (@{$self->{char}}) {
1325     $self->{next_input_character} = shift @{$self->{char}};
1326     } else {
1327     $self->{set_next_input_character}->($self);
1328     }
1329    
1330     push @next_char, $self->{next_input_character};
1331     if ($self->{next_input_character} == 0x004F or # O
1332     $self->{next_input_character} == 0x006F) { # o
1333    
1334     if (@{$self->{char}}) {
1335     $self->{next_input_character} = shift @{$self->{char}};
1336     } else {
1337     $self->{set_next_input_character}->($self);
1338     }
1339    
1340     push @next_char, $self->{next_input_character};
1341     if ($self->{next_input_character} == 0x0043 or # C
1342     $self->{next_input_character} == 0x0063) { # c
1343    
1344     if (@{$self->{char}}) {
1345     $self->{next_input_character} = shift @{$self->{char}};
1346     } else {
1347     $self->{set_next_input_character}->($self);
1348     }
1349    
1350     push @next_char, $self->{next_input_character};
1351     if ($self->{next_input_character} == 0x0054 or # T
1352     $self->{next_input_character} == 0x0074) { # t
1353    
1354     if (@{$self->{char}}) {
1355     $self->{next_input_character} = shift @{$self->{char}};
1356     } else {
1357     $self->{set_next_input_character}->($self);
1358     }
1359    
1360     push @next_char, $self->{next_input_character};
1361     if ($self->{next_input_character} == 0x0059 or # Y
1362     $self->{next_input_character} == 0x0079) { # y
1363    
1364     if (@{$self->{char}}) {
1365     $self->{next_input_character} = shift @{$self->{char}};
1366     } else {
1367     $self->{set_next_input_character}->($self);
1368     }
1369    
1370     push @next_char, $self->{next_input_character};
1371     if ($self->{next_input_character} == 0x0050 or # P
1372     $self->{next_input_character} == 0x0070) { # p
1373    
1374     if (@{$self->{char}}) {
1375     $self->{next_input_character} = shift @{$self->{char}};
1376     } else {
1377     $self->{set_next_input_character}->($self);
1378     }
1379    
1380     push @next_char, $self->{next_input_character};
1381     if ($self->{next_input_character} == 0x0045 or # E
1382     $self->{next_input_character} == 0x0065) { # e
1383     ## ISSUE: What a stupid code this is!
1384     $self->{state} = 'DOCTYPE';
1385    
1386     if (@{$self->{char}}) {
1387     $self->{next_input_character} = shift @{$self->{char}};
1388     } else {
1389     $self->{set_next_input_character}->($self);
1390     }
1391    
1392     redo A;
1393     }
1394     }
1395     }
1396     }
1397     }
1398     }
1399     }
1400    
1401 wakaba 1.30 $self->{parse_error}-> (type => 'bogus comment');
1402 wakaba 1.1 $self->{next_input_character} = shift @next_char;
1403     unshift @{$self->{char}}, (@next_char);
1404     $self->{state} = 'bogus comment';
1405     redo A;
1406    
1407     ## ISSUE: typos in spec: chacacters, is is a parse error
1408     ## ISSUE: spec is somewhat unclear on "is the first character that will be in the comment"; what is "that will be in the comment" is what the algorithm defines, isn't it?
1409 wakaba 1.23 } elsif ($self->{state} eq 'comment start') {
1410     if ($self->{next_input_character} == 0x002D) { # -
1411     $self->{state} = 'comment start dash';
1412    
1413     if (@{$self->{char}}) {
1414     $self->{next_input_character} = shift @{$self->{char}};
1415     } else {
1416     $self->{set_next_input_character}->($self);
1417     }
1418    
1419     redo A;
1420     } elsif ($self->{next_input_character} == 0x003E) { # >
1421     $self->{parse_error}-> (type => 'bogus comment');
1422     $self->{state} = 'data';
1423    
1424     if (@{$self->{char}}) {
1425     $self->{next_input_character} = shift @{$self->{char}};
1426     } else {
1427     $self->{set_next_input_character}->($self);
1428     }
1429    
1430    
1431     return ($self->{current_token}); # comment
1432    
1433     redo A;
1434     } elsif ($self->{next_input_character} == -1) {
1435     $self->{parse_error}-> (type => 'unclosed comment');
1436     $self->{state} = 'data';
1437     ## reconsume
1438    
1439     return ($self->{current_token}); # comment
1440    
1441     redo A;
1442     } else {
1443     $self->{current_token}->{data} # comment
1444     .= chr ($self->{next_input_character});
1445     $self->{state} = 'comment';
1446    
1447     if (@{$self->{char}}) {
1448     $self->{next_input_character} = shift @{$self->{char}};
1449     } else {
1450     $self->{set_next_input_character}->($self);
1451     }
1452    
1453     redo A;
1454     }
1455     } elsif ($self->{state} eq 'comment start dash') {
1456     if ($self->{next_input_character} == 0x002D) { # -
1457     $self->{state} = 'comment end';
1458    
1459     if (@{$self->{char}}) {
1460     $self->{next_input_character} = shift @{$self->{char}};
1461     } else {
1462     $self->{set_next_input_character}->($self);
1463     }
1464    
1465     redo A;
1466     } elsif ($self->{next_input_character} == 0x003E) { # >
1467     $self->{parse_error}-> (type => 'bogus comment');
1468     $self->{state} = 'data';
1469    
1470     if (@{$self->{char}}) {
1471     $self->{next_input_character} = shift @{$self->{char}};
1472     } else {
1473     $self->{set_next_input_character}->($self);
1474     }
1475    
1476    
1477     return ($self->{current_token}); # comment
1478    
1479     redo A;
1480     } elsif ($self->{next_input_character} == -1) {
1481     $self->{parse_error}-> (type => 'unclosed comment');
1482     $self->{state} = 'data';
1483     ## reconsume
1484    
1485     return ($self->{current_token}); # comment
1486    
1487     redo A;
1488     } else {
1489     $self->{current_token}->{data} # comment
1490 wakaba 1.33 .= '-' . chr ($self->{next_input_character});
1491 wakaba 1.23 $self->{state} = 'comment';
1492    
1493     if (@{$self->{char}}) {
1494     $self->{next_input_character} = shift @{$self->{char}};
1495     } else {
1496     $self->{set_next_input_character}->($self);
1497     }
1498    
1499     redo A;
1500     }
1501 wakaba 1.1 } elsif ($self->{state} eq 'comment') {
1502     if ($self->{next_input_character} == 0x002D) { # -
1503 wakaba 1.23 $self->{state} = 'comment end dash';
1504 wakaba 1.1
1505     if (@{$self->{char}}) {
1506     $self->{next_input_character} = shift @{$self->{char}};
1507     } else {
1508     $self->{set_next_input_character}->($self);
1509     }
1510    
1511     redo A;
1512     } elsif ($self->{next_input_character} == -1) {
1513 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed comment');
1514 wakaba 1.1 $self->{state} = 'data';
1515     ## reconsume
1516    
1517     return ($self->{current_token}); # comment
1518    
1519     redo A;
1520     } else {
1521     $self->{current_token}->{data} .= chr ($self->{next_input_character}); # comment
1522     ## Stay in the state
1523    
1524     if (@{$self->{char}}) {
1525     $self->{next_input_character} = shift @{$self->{char}};
1526     } else {
1527     $self->{set_next_input_character}->($self);
1528     }
1529    
1530     redo A;
1531     }
1532 wakaba 1.23 } elsif ($self->{state} eq 'comment end dash') {
1533 wakaba 1.1 if ($self->{next_input_character} == 0x002D) { # -
1534     $self->{state} = 'comment end';
1535    
1536     if (@{$self->{char}}) {
1537     $self->{next_input_character} = shift @{$self->{char}};
1538     } else {
1539     $self->{set_next_input_character}->($self);
1540     }
1541    
1542     redo A;
1543     } elsif ($self->{next_input_character} == -1) {
1544 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed comment');
1545 wakaba 1.1 $self->{state} = 'data';
1546     ## reconsume
1547    
1548     return ($self->{current_token}); # comment
1549    
1550     redo A;
1551     } else {
1552     $self->{current_token}->{data} .= '-' . chr ($self->{next_input_character}); # comment
1553     $self->{state} = 'comment';
1554    
1555     if (@{$self->{char}}) {
1556     $self->{next_input_character} = shift @{$self->{char}};
1557     } else {
1558     $self->{set_next_input_character}->($self);
1559     }
1560    
1561     redo A;
1562     }
1563     } elsif ($self->{state} eq 'comment end') {
1564     if ($self->{next_input_character} == 0x003E) { # >
1565     $self->{state} = 'data';
1566    
1567     if (@{$self->{char}}) {
1568     $self->{next_input_character} = shift @{$self->{char}};
1569     } else {
1570     $self->{set_next_input_character}->($self);
1571     }
1572    
1573    
1574     return ($self->{current_token}); # comment
1575    
1576     redo A;
1577     } elsif ($self->{next_input_character} == 0x002D) { # -
1578 wakaba 1.3 $self->{parse_error}-> (type => 'dash in comment');
1579 wakaba 1.1 $self->{current_token}->{data} .= '-'; # comment
1580     ## Stay in the state
1581    
1582     if (@{$self->{char}}) {
1583     $self->{next_input_character} = shift @{$self->{char}};
1584     } else {
1585     $self->{set_next_input_character}->($self);
1586     }
1587    
1588     redo A;
1589     } elsif ($self->{next_input_character} == -1) {
1590 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed comment');
1591 wakaba 1.1 $self->{state} = 'data';
1592     ## reconsume
1593    
1594     return ($self->{current_token}); # comment
1595    
1596     redo A;
1597     } else {
1598 wakaba 1.3 $self->{parse_error}-> (type => 'dash in comment');
1599 wakaba 1.1 $self->{current_token}->{data} .= '--' . chr ($self->{next_input_character}); # comment
1600     $self->{state} = 'comment';
1601    
1602     if (@{$self->{char}}) {
1603     $self->{next_input_character} = shift @{$self->{char}};
1604     } else {
1605     $self->{set_next_input_character}->($self);
1606     }
1607    
1608     redo A;
1609     }
1610     } elsif ($self->{state} eq 'DOCTYPE') {
1611     if ($self->{next_input_character} == 0x0009 or # HT
1612     $self->{next_input_character} == 0x000A or # LF
1613     $self->{next_input_character} == 0x000B or # VT
1614     $self->{next_input_character} == 0x000C or # FF
1615     $self->{next_input_character} == 0x0020) { # SP
1616     $self->{state} = 'before DOCTYPE name';
1617    
1618     if (@{$self->{char}}) {
1619     $self->{next_input_character} = shift @{$self->{char}};
1620     } else {
1621     $self->{set_next_input_character}->($self);
1622     }
1623    
1624     redo A;
1625     } else {
1626 wakaba 1.3 $self->{parse_error}-> (type => 'no space before DOCTYPE name');
1627 wakaba 1.1 $self->{state} = 'before DOCTYPE name';
1628     ## reconsume
1629     redo A;
1630     }
1631     } elsif ($self->{state} eq 'before DOCTYPE name') {
1632     if ($self->{next_input_character} == 0x0009 or # HT
1633     $self->{next_input_character} == 0x000A or # LF
1634     $self->{next_input_character} == 0x000B or # VT
1635     $self->{next_input_character} == 0x000C or # FF
1636     $self->{next_input_character} == 0x0020) { # SP
1637     ## Stay in the state
1638    
1639     if (@{$self->{char}}) {
1640     $self->{next_input_character} = shift @{$self->{char}};
1641     } else {
1642     $self->{set_next_input_character}->($self);
1643     }
1644    
1645     redo A;
1646 wakaba 1.18 } elsif ($self->{next_input_character} == 0x003E) { # >
1647     $self->{parse_error}-> (type => 'no DOCTYPE name');
1648     $self->{state} = 'data';
1649    
1650     if (@{$self->{char}}) {
1651     $self->{next_input_character} = shift @{$self->{char}};
1652     } else {
1653     $self->{set_next_input_character}->($self);
1654     }
1655    
1656    
1657     return ({type => 'DOCTYPE'}); # incorrect
1658    
1659     redo A;
1660     } elsif ($self->{next_input_character} == -1) {
1661     $self->{parse_error}-> (type => 'no DOCTYPE name');
1662     $self->{state} = 'data';
1663     ## reconsume
1664    
1665     return ({type => 'DOCTYPE'}); # incorrect
1666    
1667     redo A;
1668     } else {
1669     $self->{current_token}
1670     = {type => 'DOCTYPE',
1671     name => chr ($self->{next_input_character}),
1672     correct => 1};
1673 wakaba 1.4 ## ISSUE: "Set the token's name name to the" in the spec
1674 wakaba 1.1 $self->{state} = 'DOCTYPE name';
1675    
1676     if (@{$self->{char}}) {
1677     $self->{next_input_character} = shift @{$self->{char}};
1678     } else {
1679     $self->{set_next_input_character}->($self);
1680     }
1681    
1682     redo A;
1683 wakaba 1.18 }
1684     } elsif ($self->{state} eq 'DOCTYPE name') {
1685     ## ISSUE: Redundant "First," in the spec.
1686     if ($self->{next_input_character} == 0x0009 or # HT
1687     $self->{next_input_character} == 0x000A or # LF
1688     $self->{next_input_character} == 0x000B or # VT
1689     $self->{next_input_character} == 0x000C or # FF
1690     $self->{next_input_character} == 0x0020) { # SP
1691     $self->{state} = 'after DOCTYPE name';
1692    
1693     if (@{$self->{char}}) {
1694     $self->{next_input_character} = shift @{$self->{char}};
1695     } else {
1696     $self->{set_next_input_character}->($self);
1697     }
1698    
1699     redo A;
1700 wakaba 1.1 } elsif ($self->{next_input_character} == 0x003E) { # >
1701     $self->{state} = 'data';
1702    
1703     if (@{$self->{char}}) {
1704     $self->{next_input_character} = shift @{$self->{char}};
1705     } else {
1706     $self->{set_next_input_character}->($self);
1707     }
1708    
1709    
1710 wakaba 1.18 return ($self->{current_token}); # DOCTYPE
1711 wakaba 1.1
1712     redo A;
1713 wakaba 1.18 } elsif ($self->{next_input_character} == -1) {
1714     $self->{parse_error}-> (type => 'unclosed DOCTYPE');
1715 wakaba 1.1 $self->{state} = 'data';
1716     ## reconsume
1717    
1718 wakaba 1.18 delete $self->{current_token}->{correct};
1719     return ($self->{current_token}); # DOCTYPE
1720 wakaba 1.1
1721     redo A;
1722     } else {
1723 wakaba 1.18 $self->{current_token}->{name}
1724     .= chr ($self->{next_input_character}); # DOCTYPE
1725     ## Stay in the state
1726 wakaba 1.1
1727     if (@{$self->{char}}) {
1728     $self->{next_input_character} = shift @{$self->{char}};
1729     } else {
1730     $self->{set_next_input_character}->($self);
1731     }
1732    
1733     redo A;
1734     }
1735 wakaba 1.18 } elsif ($self->{state} eq 'after DOCTYPE name') {
1736 wakaba 1.1 if ($self->{next_input_character} == 0x0009 or # HT
1737     $self->{next_input_character} == 0x000A or # LF
1738     $self->{next_input_character} == 0x000B or # VT
1739     $self->{next_input_character} == 0x000C or # FF
1740     $self->{next_input_character} == 0x0020) { # SP
1741 wakaba 1.18 ## Stay in the state
1742 wakaba 1.1
1743     if (@{$self->{char}}) {
1744     $self->{next_input_character} = shift @{$self->{char}};
1745     } else {
1746     $self->{set_next_input_character}->($self);
1747     }
1748    
1749     redo A;
1750     } elsif ($self->{next_input_character} == 0x003E) { # >
1751     $self->{state} = 'data';
1752    
1753     if (@{$self->{char}}) {
1754     $self->{next_input_character} = shift @{$self->{char}};
1755     } else {
1756     $self->{set_next_input_character}->($self);
1757     }
1758    
1759    
1760     return ($self->{current_token}); # DOCTYPE
1761    
1762     redo A;
1763 wakaba 1.18 } elsif ($self->{next_input_character} == -1) {
1764     $self->{parse_error}-> (type => 'unclosed DOCTYPE');
1765     $self->{state} = 'data';
1766     ## reconsume
1767    
1768     delete $self->{current_token}->{correct};
1769     return ($self->{current_token}); # DOCTYPE
1770    
1771     redo A;
1772     } elsif ($self->{next_input_character} == 0x0050 or # P
1773     $self->{next_input_character} == 0x0070) { # p
1774    
1775     if (@{$self->{char}}) {
1776     $self->{next_input_character} = shift @{$self->{char}};
1777     } else {
1778     $self->{set_next_input_character}->($self);
1779     }
1780    
1781     if ($self->{next_input_character} == 0x0055 or # U
1782     $self->{next_input_character} == 0x0075) { # u
1783    
1784     if (@{$self->{char}}) {
1785     $self->{next_input_character} = shift @{$self->{char}};
1786     } else {
1787     $self->{set_next_input_character}->($self);
1788     }
1789    
1790     if ($self->{next_input_character} == 0x0042 or # B
1791     $self->{next_input_character} == 0x0062) { # b
1792    
1793     if (@{$self->{char}}) {
1794     $self->{next_input_character} = shift @{$self->{char}};
1795     } else {
1796     $self->{set_next_input_character}->($self);
1797     }
1798    
1799     if ($self->{next_input_character} == 0x004C or # L
1800     $self->{next_input_character} == 0x006C) { # l
1801    
1802     if (@{$self->{char}}) {
1803     $self->{next_input_character} = shift @{$self->{char}};
1804     } else {
1805     $self->{set_next_input_character}->($self);
1806     }
1807    
1808     if ($self->{next_input_character} == 0x0049 or # I
1809     $self->{next_input_character} == 0x0069) { # i
1810    
1811     if (@{$self->{char}}) {
1812     $self->{next_input_character} = shift @{$self->{char}};
1813     } else {
1814     $self->{set_next_input_character}->($self);
1815     }
1816    
1817     if ($self->{next_input_character} == 0x0043 or # C
1818     $self->{next_input_character} == 0x0063) { # c
1819     $self->{state} = 'before DOCTYPE public identifier';
1820    
1821     if (@{$self->{char}}) {
1822     $self->{next_input_character} = shift @{$self->{char}};
1823     } else {
1824     $self->{set_next_input_character}->($self);
1825     }
1826    
1827     redo A;
1828     }
1829     }
1830     }
1831     }
1832     }
1833    
1834     #
1835     } elsif ($self->{next_input_character} == 0x0053 or # S
1836     $self->{next_input_character} == 0x0073) { # s
1837    
1838     if (@{$self->{char}}) {
1839     $self->{next_input_character} = shift @{$self->{char}};
1840     } else {
1841     $self->{set_next_input_character}->($self);
1842     }
1843    
1844     if ($self->{next_input_character} == 0x0059 or # Y
1845     $self->{next_input_character} == 0x0079) { # y
1846    
1847     if (@{$self->{char}}) {
1848     $self->{next_input_character} = shift @{$self->{char}};
1849     } else {
1850     $self->{set_next_input_character}->($self);
1851     }
1852    
1853     if ($self->{next_input_character} == 0x0053 or # S
1854     $self->{next_input_character} == 0x0073) { # s
1855    
1856     if (@{$self->{char}}) {
1857     $self->{next_input_character} = shift @{$self->{char}};
1858     } else {
1859     $self->{set_next_input_character}->($self);
1860     }
1861    
1862     if ($self->{next_input_character} == 0x0054 or # T
1863     $self->{next_input_character} == 0x0074) { # t
1864    
1865     if (@{$self->{char}}) {
1866     $self->{next_input_character} = shift @{$self->{char}};
1867     } else {
1868     $self->{set_next_input_character}->($self);
1869     }
1870    
1871     if ($self->{next_input_character} == 0x0045 or # E
1872     $self->{next_input_character} == 0x0065) { # e
1873    
1874     if (@{$self->{char}}) {
1875     $self->{next_input_character} = shift @{$self->{char}};
1876     } else {
1877     $self->{set_next_input_character}->($self);
1878     }
1879    
1880     if ($self->{next_input_character} == 0x004D or # M
1881     $self->{next_input_character} == 0x006D) { # m
1882     $self->{state} = 'before DOCTYPE system identifier';
1883    
1884     if (@{$self->{char}}) {
1885     $self->{next_input_character} = shift @{$self->{char}};
1886     } else {
1887     $self->{set_next_input_character}->($self);
1888     }
1889    
1890     redo A;
1891     }
1892     }
1893     }
1894     }
1895     }
1896    
1897     #
1898     } else {
1899    
1900     if (@{$self->{char}}) {
1901     $self->{next_input_character} = shift @{$self->{char}};
1902     } else {
1903     $self->{set_next_input_character}->($self);
1904     }
1905    
1906     #
1907     }
1908    
1909     $self->{parse_error}-> (type => 'string after DOCTYPE name');
1910     $self->{state} = 'bogus DOCTYPE';
1911     # next-input-character is already done
1912     redo A;
1913     } elsif ($self->{state} eq 'before DOCTYPE public identifier') {
1914     if ({
1915     0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1916     #0x000D => 1, # HT, LF, VT, FF, SP, CR
1917     }->{$self->{next_input_character}}) {
1918 wakaba 1.1 ## Stay in the state
1919    
1920     if (@{$self->{char}}) {
1921     $self->{next_input_character} = shift @{$self->{char}};
1922     } else {
1923     $self->{set_next_input_character}->($self);
1924     }
1925    
1926     redo A;
1927 wakaba 1.18 } elsif ($self->{next_input_character} eq 0x0022) { # "
1928     $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1929     $self->{state} = 'DOCTYPE public identifier (double-quoted)';
1930    
1931     if (@{$self->{char}}) {
1932     $self->{next_input_character} = shift @{$self->{char}};
1933     } else {
1934     $self->{set_next_input_character}->($self);
1935     }
1936    
1937     redo A;
1938     } elsif ($self->{next_input_character} eq 0x0027) { # '
1939     $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1940     $self->{state} = 'DOCTYPE public identifier (single-quoted)';
1941    
1942     if (@{$self->{char}}) {
1943     $self->{next_input_character} = shift @{$self->{char}};
1944     } else {
1945     $self->{set_next_input_character}->($self);
1946     }
1947    
1948     redo A;
1949     } elsif ($self->{next_input_character} eq 0x003E) { # >
1950     $self->{parse_error}-> (type => 'no PUBLIC literal');
1951    
1952     $self->{state} = 'data';
1953    
1954     if (@{$self->{char}}) {
1955     $self->{next_input_character} = shift @{$self->{char}};
1956     } else {
1957     $self->{set_next_input_character}->($self);
1958     }
1959    
1960    
1961     delete $self->{current_token}->{correct};
1962     return ($self->{current_token}); # DOCTYPE
1963    
1964     redo A;
1965 wakaba 1.1 } elsif ($self->{next_input_character} == -1) {
1966 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed DOCTYPE');
1967 wakaba 1.18
1968 wakaba 1.1 $self->{state} = 'data';
1969     ## reconsume
1970    
1971 wakaba 1.18 delete $self->{current_token}->{correct};
1972     return ($self->{current_token}); # DOCTYPE
1973 wakaba 1.1
1974     redo A;
1975     } else {
1976 wakaba 1.18 $self->{parse_error}-> (type => 'string after PUBLIC');
1977     $self->{state} = 'bogus DOCTYPE';
1978    
1979     if (@{$self->{char}}) {
1980     $self->{next_input_character} = shift @{$self->{char}};
1981     } else {
1982     $self->{set_next_input_character}->($self);
1983     }
1984    
1985     redo A;
1986     }
1987     } elsif ($self->{state} eq 'DOCTYPE public identifier (double-quoted)') {
1988     if ($self->{next_input_character} == 0x0022) { # "
1989     $self->{state} = 'after DOCTYPE public identifier';
1990    
1991     if (@{$self->{char}}) {
1992     $self->{next_input_character} = shift @{$self->{char}};
1993     } else {
1994     $self->{set_next_input_character}->($self);
1995     }
1996    
1997     redo A;
1998     } elsif ($self->{next_input_character} == -1) {
1999     $self->{parse_error}-> (type => 'unclosed PUBLIC literal');
2000    
2001     $self->{state} = 'data';
2002     ## reconsume
2003    
2004     delete $self->{current_token}->{correct};
2005     return ($self->{current_token}); # DOCTYPE
2006    
2007     redo A;
2008     } else {
2009     $self->{current_token}->{public_identifier} # DOCTYPE
2010     .= chr $self->{next_input_character};
2011     ## Stay in the state
2012    
2013     if (@{$self->{char}}) {
2014     $self->{next_input_character} = shift @{$self->{char}};
2015     } else {
2016     $self->{set_next_input_character}->($self);
2017     }
2018    
2019     redo A;
2020     }
2021     } elsif ($self->{state} eq 'DOCTYPE public identifier (single-quoted)') {
2022     if ($self->{next_input_character} == 0x0027) { # '
2023     $self->{state} = 'after DOCTYPE public identifier';
2024    
2025     if (@{$self->{char}}) {
2026     $self->{next_input_character} = shift @{$self->{char}};
2027     } else {
2028     $self->{set_next_input_character}->($self);
2029     }
2030    
2031     redo A;
2032     } elsif ($self->{next_input_character} == -1) {
2033     $self->{parse_error}-> (type => 'unclosed PUBLIC literal');
2034    
2035     $self->{state} = 'data';
2036     ## reconsume
2037    
2038     delete $self->{current_token}->{correct};
2039     return ($self->{current_token}); # DOCTYPE
2040    
2041     redo A;
2042     } else {
2043     $self->{current_token}->{public_identifier} # DOCTYPE
2044     .= chr $self->{next_input_character};
2045     ## Stay in the state
2046    
2047     if (@{$self->{char}}) {
2048     $self->{next_input_character} = shift @{$self->{char}};
2049     } else {
2050     $self->{set_next_input_character}->($self);
2051     }
2052    
2053     redo A;
2054     }
2055     } elsif ($self->{state} eq 'after DOCTYPE public identifier') {
2056     if ({
2057     0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
2058     #0x000D => 1, # HT, LF, VT, FF, SP, CR
2059     }->{$self->{next_input_character}}) {
2060 wakaba 1.1 ## Stay in the state
2061    
2062     if (@{$self->{char}}) {
2063     $self->{next_input_character} = shift @{$self->{char}};
2064     } else {
2065     $self->{set_next_input_character}->($self);
2066     }
2067    
2068     redo A;
2069 wakaba 1.18 } elsif ($self->{next_input_character} == 0x0022) { # "
2070     $self->{current_token}->{system_identifier} = ''; # DOCTYPE
2071     $self->{state} = 'DOCTYPE system identifier (double-quoted)';
2072    
2073     if (@{$self->{char}}) {
2074     $self->{next_input_character} = shift @{$self->{char}};
2075     } else {
2076     $self->{set_next_input_character}->($self);
2077     }
2078    
2079     redo A;
2080     } elsif ($self->{next_input_character} == 0x0027) { # '
2081     $self->{current_token}->{system_identifier} = ''; # DOCTYPE
2082     $self->{state} = 'DOCTYPE system identifier (single-quoted)';
2083    
2084     if (@{$self->{char}}) {
2085     $self->{next_input_character} = shift @{$self->{char}};
2086     } else {
2087     $self->{set_next_input_character}->($self);
2088     }
2089    
2090     redo A;
2091     } elsif ($self->{next_input_character} == 0x003E) { # >
2092     $self->{state} = 'data';
2093    
2094     if (@{$self->{char}}) {
2095     $self->{next_input_character} = shift @{$self->{char}};
2096     } else {
2097     $self->{set_next_input_character}->($self);
2098     }
2099    
2100    
2101     return ($self->{current_token}); # DOCTYPE
2102    
2103     redo A;
2104     } elsif ($self->{next_input_character} == -1) {
2105     $self->{parse_error}-> (type => 'unclosed DOCTYPE');
2106    
2107     $self->{state} = 'data';
2108 wakaba 1.26 ## reconsume
2109 wakaba 1.18
2110     delete $self->{current_token}->{correct};
2111     return ($self->{current_token}); # DOCTYPE
2112    
2113     redo A;
2114     } else {
2115     $self->{parse_error}-> (type => 'string after PUBLIC literal');
2116     $self->{state} = 'bogus DOCTYPE';
2117    
2118     if (@{$self->{char}}) {
2119     $self->{next_input_character} = shift @{$self->{char}};
2120     } else {
2121     $self->{set_next_input_character}->($self);
2122     }
2123    
2124     redo A;
2125 wakaba 1.1 }
2126 wakaba 1.18 } elsif ($self->{state} eq 'before DOCTYPE system identifier') {
2127     if ({
2128     0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
2129     #0x000D => 1, # HT, LF, VT, FF, SP, CR
2130     }->{$self->{next_input_character}}) {
2131 wakaba 1.1 ## Stay in the state
2132    
2133     if (@{$self->{char}}) {
2134     $self->{next_input_character} = shift @{$self->{char}};
2135     } else {
2136     $self->{set_next_input_character}->($self);
2137     }
2138    
2139     redo A;
2140 wakaba 1.18 } elsif ($self->{next_input_character} == 0x0022) { # "
2141     $self->{current_token}->{system_identifier} = ''; # DOCTYPE
2142     $self->{state} = 'DOCTYPE system identifier (double-quoted)';
2143    
2144     if (@{$self->{char}}) {
2145     $self->{next_input_character} = shift @{$self->{char}};
2146     } else {
2147     $self->{set_next_input_character}->($self);
2148     }
2149    
2150     redo A;
2151     } elsif ($self->{next_input_character} == 0x0027) { # '
2152     $self->{current_token}->{system_identifier} = ''; # DOCTYPE
2153     $self->{state} = 'DOCTYPE system identifier (single-quoted)';
2154    
2155     if (@{$self->{char}}) {
2156     $self->{next_input_character} = shift @{$self->{char}};
2157     } else {
2158     $self->{set_next_input_character}->($self);
2159     }
2160    
2161     redo A;
2162 wakaba 1.1 } elsif ($self->{next_input_character} == 0x003E) { # >
2163 wakaba 1.18 $self->{parse_error}-> (type => 'no SYSTEM literal');
2164 wakaba 1.1 $self->{state} = 'data';
2165    
2166     if (@{$self->{char}}) {
2167     $self->{next_input_character} = shift @{$self->{char}};
2168     } else {
2169     $self->{set_next_input_character}->($self);
2170     }
2171    
2172    
2173 wakaba 1.18 delete $self->{current_token}->{correct};
2174 wakaba 1.1 return ($self->{current_token}); # DOCTYPE
2175    
2176     redo A;
2177     } elsif ($self->{next_input_character} == -1) {
2178 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed DOCTYPE');
2179 wakaba 1.18
2180     $self->{state} = 'data';
2181 wakaba 1.26 ## reconsume
2182 wakaba 1.18
2183     delete $self->{current_token}->{correct};
2184     return ($self->{current_token}); # DOCTYPE
2185    
2186     redo A;
2187     } else {
2188 wakaba 1.30 $self->{parse_error}-> (type => 'string after SYSTEM');
2189 wakaba 1.18 $self->{state} = 'bogus DOCTYPE';
2190    
2191     if (@{$self->{char}}) {
2192     $self->{next_input_character} = shift @{$self->{char}};
2193     } else {
2194     $self->{set_next_input_character}->($self);
2195     }
2196    
2197     redo A;
2198     }
2199     } elsif ($self->{state} eq 'DOCTYPE system identifier (double-quoted)') {
2200     if ($self->{next_input_character} == 0x0022) { # "
2201     $self->{state} = 'after DOCTYPE system identifier';
2202    
2203     if (@{$self->{char}}) {
2204     $self->{next_input_character} = shift @{$self->{char}};
2205     } else {
2206     $self->{set_next_input_character}->($self);
2207     }
2208    
2209     redo A;
2210     } elsif ($self->{next_input_character} == -1) {
2211     $self->{parse_error}-> (type => 'unclosed SYSTEM literal');
2212    
2213 wakaba 1.1 $self->{state} = 'data';
2214     ## reconsume
2215    
2216 wakaba 1.18 delete $self->{current_token}->{correct};
2217 wakaba 1.1 return ($self->{current_token}); # DOCTYPE
2218    
2219     redo A;
2220     } else {
2221 wakaba 1.18 $self->{current_token}->{system_identifier} # DOCTYPE
2222     .= chr $self->{next_input_character};
2223     ## Stay in the state
2224    
2225     if (@{$self->{char}}) {
2226     $self->{next_input_character} = shift @{$self->{char}};
2227     } else {
2228     $self->{set_next_input_character}->($self);
2229     }
2230    
2231     redo A;
2232     }
2233     } elsif ($self->{state} eq 'DOCTYPE system identifier (single-quoted)') {
2234     if ($self->{next_input_character} == 0x0027) { # '
2235     $self->{state} = 'after DOCTYPE system identifier';
2236    
2237     if (@{$self->{char}}) {
2238     $self->{next_input_character} = shift @{$self->{char}};
2239     } else {
2240     $self->{set_next_input_character}->($self);
2241     }
2242    
2243     redo A;
2244     } elsif ($self->{next_input_character} == -1) {
2245     $self->{parse_error}-> (type => 'unclosed SYSTEM literal');
2246    
2247     $self->{state} = 'data';
2248     ## reconsume
2249    
2250     delete $self->{current_token}->{correct};
2251     return ($self->{current_token}); # DOCTYPE
2252    
2253     redo A;
2254     } else {
2255     $self->{current_token}->{system_identifier} # DOCTYPE
2256     .= chr $self->{next_input_character};
2257     ## Stay in the state
2258    
2259     if (@{$self->{char}}) {
2260     $self->{next_input_character} = shift @{$self->{char}};
2261     } else {
2262     $self->{set_next_input_character}->($self);
2263     }
2264    
2265     redo A;
2266     }
2267     } elsif ($self->{state} eq 'after DOCTYPE system identifier') {
2268     if ({
2269     0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
2270     #0x000D => 1, # HT, LF, VT, FF, SP, CR
2271     }->{$self->{next_input_character}}) {
2272     ## Stay in the state
2273    
2274     if (@{$self->{char}}) {
2275     $self->{next_input_character} = shift @{$self->{char}};
2276     } else {
2277     $self->{set_next_input_character}->($self);
2278     }
2279    
2280     redo A;
2281     } elsif ($self->{next_input_character} == 0x003E) { # >
2282     $self->{state} = 'data';
2283    
2284     if (@{$self->{char}}) {
2285     $self->{next_input_character} = shift @{$self->{char}};
2286     } else {
2287     $self->{set_next_input_character}->($self);
2288     }
2289    
2290    
2291     return ($self->{current_token}); # DOCTYPE
2292    
2293     redo A;
2294     } elsif ($self->{next_input_character} == -1) {
2295     $self->{parse_error}-> (type => 'unclosed DOCTYPE');
2296    
2297     $self->{state} = 'data';
2298 wakaba 1.26 ## reconsume
2299 wakaba 1.18
2300     delete $self->{current_token}->{correct};
2301     return ($self->{current_token}); # DOCTYPE
2302    
2303     redo A;
2304     } else {
2305     $self->{parse_error}-> (type => 'string after SYSTEM literal');
2306 wakaba 1.1 $self->{state} = 'bogus DOCTYPE';
2307    
2308     if (@{$self->{char}}) {
2309     $self->{next_input_character} = shift @{$self->{char}};
2310     } else {
2311     $self->{set_next_input_character}->($self);
2312     }
2313    
2314     redo A;
2315     }
2316     } elsif ($self->{state} eq 'bogus DOCTYPE') {
2317     if ($self->{next_input_character} == 0x003E) { # >
2318     $self->{state} = 'data';
2319    
2320     if (@{$self->{char}}) {
2321     $self->{next_input_character} = shift @{$self->{char}};
2322     } else {
2323     $self->{set_next_input_character}->($self);
2324     }
2325    
2326    
2327 wakaba 1.18 delete $self->{current_token}->{correct};
2328 wakaba 1.1 return ($self->{current_token}); # DOCTYPE
2329    
2330     redo A;
2331     } elsif ($self->{next_input_character} == -1) {
2332 wakaba 1.3 $self->{parse_error}-> (type => 'unclosed DOCTYPE');
2333 wakaba 1.1 $self->{state} = 'data';
2334     ## reconsume
2335    
2336 wakaba 1.18 delete $self->{current_token}->{correct};
2337 wakaba 1.1 return ($self->{current_token}); # DOCTYPE
2338    
2339     redo A;
2340     } else {
2341     ## Stay in the state
2342    
2343     if (@{$self->{char}}) {
2344     $self->{next_input_character} = shift @{$self->{char}};
2345     } else {
2346     $self->{set_next_input_character}->($self);
2347     }
2348    
2349     redo A;
2350     }
2351     } else {
2352     die "$0: $self->{state}: Unknown state";
2353     }
2354     } # A
2355    
2356     die "$0: _get_next_token: unexpected case";
2357     } # _get_next_token
2358    
2359 wakaba 1.26 sub _tokenize_attempt_to_consume_an_entity ($$) {
2360     my ($self, $in_attr) = @_;
2361 wakaba 1.20
2362     if ({
2363     0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
2364     0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR
2365     }->{$self->{next_input_character}}) {
2366     ## Don't consume
2367     ## No error
2368     return undef;
2369     } elsif ($self->{next_input_character} == 0x0023) { # #
2370 wakaba 1.1
2371     if (@{$self->{char}}) {
2372     $self->{next_input_character} = shift @{$self->{char}};
2373     } else {
2374     $self->{set_next_input_character}->($self);
2375     }
2376    
2377     if ($self->{next_input_character} == 0x0078 or # x
2378     $self->{next_input_character} == 0x0058) { # X
2379 wakaba 1.26 my $code;
2380 wakaba 1.1 X: {
2381     my $x_char = $self->{next_input_character};
2382    
2383     if (@{$self->{char}}) {
2384     $self->{next_input_character} = shift @{$self->{char}};
2385     } else {
2386     $self->{set_next_input_character}->($self);
2387     }
2388    
2389     if (0x0030 <= $self->{next_input_character} and
2390     $self->{next_input_character} <= 0x0039) { # 0..9
2391 wakaba 1.26 $code ||= 0;
2392     $code *= 0x10;
2393     $code += $self->{next_input_character} - 0x0030;
2394 wakaba 1.1 redo X;
2395     } elsif (0x0061 <= $self->{next_input_character} and
2396     $self->{next_input_character} <= 0x0066) { # a..f
2397 wakaba 1.26 $code ||= 0;
2398     $code *= 0x10;
2399     $code += $self->{next_input_character} - 0x0060 + 9;
2400 wakaba 1.1 redo X;
2401     } elsif (0x0041 <= $self->{next_input_character} and
2402     $self->{next_input_character} <= 0x0046) { # A..F
2403 wakaba 1.26 $code ||= 0;
2404     $code *= 0x10;
2405     $code += $self->{next_input_character} - 0x0040 + 9;
2406 wakaba 1.1 redo X;
2407 wakaba 1.26 } elsif (not defined $code) { # no hexadecimal digit
2408 wakaba 1.3 $self->{parse_error}-> (type => 'bare hcro');
2409 wakaba 1.1 $self->{next_input_character} = 0x0023; # #
2410     unshift @{$self->{char}}, ($x_char);
2411     return undef;
2412     } elsif ($self->{next_input_character} == 0x003B) { # ;
2413    
2414     if (@{$self->{char}}) {
2415     $self->{next_input_character} = shift @{$self->{char}};
2416     } else {
2417     $self->{set_next_input_character}->($self);
2418     }
2419    
2420     } else {
2421 wakaba 1.3 $self->{parse_error}-> (type => 'no refc');
2422 wakaba 1.1 }
2423    
2424 wakaba 1.26 if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
2425     $self->{parse_error}-> (type => sprintf 'invalid character reference:U+%04X', $code);
2426     $code = 0xFFFD;
2427     } elsif ($code > 0x10FFFF) {
2428     $self->{parse_error}-> (type => sprintf 'invalid character reference:U-%08X', $code);
2429     $code = 0xFFFD;
2430     } elsif ($code == 0x000D) {
2431     $self->{parse_error}-> (type => 'CR character reference');
2432     $code = 0x000A;
2433     } elsif (0x80 <= $code and $code <= 0x9F) {
2434 wakaba 1.30 $self->{parse_error}-> (type => sprintf 'C1 character reference:U+%04X', $code);
2435 wakaba 1.26 $code = $c1_entity_char->{$code};
2436 wakaba 1.1 }
2437    
2438 wakaba 1.26 return {type => 'character', data => chr $code};
2439 wakaba 1.1 } # X
2440     } elsif (0x0030 <= $self->{next_input_character} and
2441     $self->{next_input_character} <= 0x0039) { # 0..9
2442     my $code = $self->{next_input_character} - 0x0030;
2443    
2444     if (@{$self->{char}}) {
2445     $self->{next_input_character} = shift @{$self->{char}};
2446     } else {
2447     $self->{set_next_input_character}->($self);
2448     }
2449    
2450    
2451     while (0x0030 <= $self->{next_input_character} and
2452     $self->{next_input_character} <= 0x0039) { # 0..9
2453     $code *= 10;
2454     $code += $self->{next_input_character} - 0x0030;
2455    
2456    
2457     if (@{$self->{char}}) {
2458     $self->{next_input_character} = shift @{$self->{char}};
2459     } else {
2460     $self->{set_next_input_character}->($self);
2461     }
2462    
2463     }
2464    
2465     if ($self->{next_input_character} == 0x003B) { # ;
2466    
2467     if (@{$self->{char}}) {
2468     $self->{next_input_character} = shift @{$self->{char}};
2469     } else {
2470     $self->{set_next_input_character}->($self);
2471     }
2472    
2473     } else {
2474 wakaba 1.3 $self->{parse_error}-> (type => 'no refc');
2475 wakaba 1.1 }
2476    
2477 wakaba 1.26 if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
2478     $self->{parse_error}-> (type => sprintf 'invalid character reference:U+%04X', $code);
2479     $code = 0xFFFD;
2480     } elsif ($code > 0x10FFFF) {
2481     $self->{parse_error}-> (type => sprintf 'invalid character reference:U-%08X', $code);
2482     $code = 0xFFFD;
2483     } elsif ($code == 0x000D) {
2484     $self->{parse_error}-> (type => 'CR character reference');
2485     $code = 0x000A;
2486 wakaba 1.4 } elsif (0x80 <= $code and $code <= 0x9F) {
2487 wakaba 1.30 $self->{parse_error}-> (type => sprintf 'C1 character reference:U+%04X', $code);
2488 wakaba 1.4 $code = $c1_entity_char->{$code};
2489 wakaba 1.1 }
2490    
2491     return {type => 'character', data => chr $code};
2492     } else {
2493 wakaba 1.3 $self->{parse_error}-> (type => 'bare nero');
2494 wakaba 1.1 unshift @{$self->{char}}, ($self->{next_input_character});
2495     $self->{next_input_character} = 0x0023; # #
2496     return undef;
2497     }
2498     } elsif ((0x0041 <= $self->{next_input_character} and
2499     $self->{next_input_character} <= 0x005A) or
2500     (0x0061 <= $self->{next_input_character} and
2501     $self->{next_input_character} <= 0x007A)) {
2502     my $entity_name = chr $self->{next_input_character};
2503    
2504     if (@{$self->{char}}) {
2505     $self->{next_input_character} = shift @{$self->{char}};
2506     } else {
2507     $self->{set_next_input_character}->($self);
2508     }
2509    
2510    
2511     my $value = $entity_name;
2512     my $match;
2513 wakaba 1.16 require Whatpm::_NamedEntityList;
2514     our $EntityChar;
2515 wakaba 1.1
2516     while (length $entity_name < 10 and
2517     ## NOTE: Some number greater than the maximum length of entity name
2518 wakaba 1.16 ((0x0041 <= $self->{next_input_character} and # a
2519     $self->{next_input_character} <= 0x005A) or # x
2520     (0x0061 <= $self->{next_input_character} and # a
2521     $self->{next_input_character} <= 0x007A) or # z
2522     (0x0030 <= $self->{next_input_character} and # 0
2523     $self->{next_input_character} <= 0x0039) or # 9
2524     $self->{next_input_character} == 0x003B)) { # ;
2525 wakaba 1.1 $entity_name .= chr $self->{next_input_character};
2526 wakaba 1.16 if (defined $EntityChar->{$entity_name}) {
2527     if ($self->{next_input_character} == 0x003B) { # ;
2528 wakaba 1.26 $value = $EntityChar->{$entity_name};
2529 wakaba 1.16 $match = 1;
2530    
2531     if (@{$self->{char}}) {
2532     $self->{next_input_character} = shift @{$self->{char}};
2533     } else {
2534     $self->{set_next_input_character}->($self);
2535     }
2536    
2537     last;
2538 wakaba 1.26 } elsif (not $in_attr) {
2539     $value = $EntityChar->{$entity_name};
2540     $match = -1;
2541 wakaba 1.16 } else {
2542 wakaba 1.26 $value .= chr $self->{next_input_character};
2543 wakaba 1.16 }
2544 wakaba 1.1 } else {
2545     $value .= chr $self->{next_input_character};
2546     }
2547    
2548     if (@{$self->{char}}) {
2549     $self->{next_input_character} = shift @{$self->{char}};
2550     } else {
2551     $self->{set_next_input_character}->($self);
2552     }
2553    
2554     }
2555    
2556 wakaba 1.16 if ($match > 0) {
2557     return {type => 'character', data => $value};
2558     } elsif ($match < 0) {
2559 wakaba 1.30 $self->{parse_error}-> (type => 'no refc');
2560 wakaba 1.1 return {type => 'character', data => $value};
2561     } else {
2562 wakaba 1.3 $self->{parse_error}-> (type => 'bare ero');
2563 wakaba 1.1 ## NOTE: No characters are consumed in the spec.
2564 wakaba 1.26 return {type => 'character', data => '&'.$value};
2565 wakaba 1.1 }
2566     } else {
2567     ## no characters are consumed
2568 wakaba 1.3 $self->{parse_error}-> (type => 'bare ero');
2569 wakaba 1.1 return undef;
2570     }
2571     } # _tokenize_attempt_to_consume_an_entity
2572    
2573     sub _initialize_tree_constructor ($) {
2574     my $self = shift;
2575     ## NOTE: $self->{document} MUST be specified before this method is called
2576     $self->{document}->strict_error_checking (0);
2577     ## TODO: Turn mutation events off # MUST
2578     ## TODO: Turn loose Document option (manakai extension) on
2579 wakaba 1.18 $self->{document}->manakai_is_html (1); # MUST
2580 wakaba 1.1 } # _initialize_tree_constructor
2581    
2582     sub _terminate_tree_constructor ($) {
2583     my $self = shift;
2584     $self->{document}->strict_error_checking (1);
2585     ## TODO: Turn mutation events on
2586     } # _terminate_tree_constructor
2587    
2588     ## ISSUE: Should append_child (for example) in script executed in tree construction stage fire mutation events?
2589    
2590 wakaba 1.3 { # tree construction stage
2591     my $token;
2592    
2593 wakaba 1.1 sub _construct_tree ($) {
2594     my ($self) = @_;
2595    
2596     ## When an interactive UA render the $self->{document} available
2597     ## to the user, or when it begin accepting user input, are
2598     ## not defined.
2599    
2600     ## Append a character: collect it and all subsequent consecutive
2601     ## characters and insert one Text node whose data is concatenation
2602     ## of all those characters. # MUST
2603    
2604     $token = $self->_get_next_token;
2605    
2606 wakaba 1.3 $self->{insertion_mode} = 'before head';
2607     undef $self->{form_element};
2608     undef $self->{head_element};
2609     $self->{open_elements} = [];
2610     undef $self->{inner_html_node};
2611    
2612     $self->_tree_construction_initial; # MUST
2613     $self->_tree_construction_root_element;
2614     $self->_tree_construction_main;
2615     } # _construct_tree
2616    
2617     sub _tree_construction_initial ($) {
2618     my $self = shift;
2619 wakaba 1.18 INITIAL: {
2620     if ($token->{type} eq 'DOCTYPE') {
2621     ## NOTE: Conformance checkers MAY, instead of reporting "not HTML5"
2622     ## error, switch to a conformance checking mode for another
2623     ## language.
2624     my $doctype_name = $token->{name};
2625     $doctype_name = '' unless defined $doctype_name;
2626     $doctype_name =~ tr/a-z/A-Z/;
2627     if (not defined $token->{name} or # <!DOCTYPE>
2628     defined $token->{public_identifier} or
2629     defined $token->{system_identifier}) {
2630     $self->{parse_error}-> (type => 'not HTML5');
2631     } elsif ($doctype_name ne 'HTML') {
2632     ## ISSUE: ASCII case-insensitive? (in fact it does not matter)
2633     $self->{parse_error}-> (type => 'not HTML5');
2634     }
2635    
2636     my $doctype = $self->{document}->create_document_type_definition
2637     ($token->{name}); ## ISSUE: If name is missing (e.g. <!DOCTYPE>)?
2638     $doctype->public_id ($token->{public_identifier})
2639     if defined $token->{public_identifier};
2640     $doctype->system_id ($token->{system_identifier})
2641     if defined $token->{system_identifier};
2642     ## NOTE: Other DocumentType attributes are null or empty lists.
2643     ## ISSUE: internalSubset = null??
2644     $self->{document}->append_child ($doctype);
2645    
2646     if (not $token->{correct} or $doctype_name ne 'HTML') {
2647     $self->{document}->manakai_compat_mode ('quirks');
2648     } elsif (defined $token->{public_identifier}) {
2649     my $pubid = $token->{public_identifier};
2650     $pubid =~ tr/a-z/A-z/;
2651     if ({
2652     "+//SILMARIL//DTD HTML PRO V0R11 19970101//EN" => 1,
2653     "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
2654     "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
2655     "-//IETF//DTD HTML 2.0 LEVEL 1//EN" => 1,
2656     "-//IETF//DTD HTML 2.0 LEVEL 2//EN" => 1,
2657     "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//EN" => 1,
2658     "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//EN" => 1,
2659     "-//IETF//DTD HTML 2.0 STRICT//EN" => 1,
2660     "-//IETF//DTD HTML 2.0//EN" => 1,
2661     "-//IETF//DTD HTML 2.1E//EN" => 1,
2662     "-//IETF//DTD HTML 3.0//EN" => 1,
2663     "-//IETF//DTD HTML 3.0//EN//" => 1,
2664     "-//IETF//DTD HTML 3.2 FINAL//EN" => 1,
2665     "-//IETF//DTD HTML 3.2//EN" => 1,
2666     "-//IETF//DTD HTML 3//EN" => 1,
2667     "-//IETF//DTD HTML LEVEL 0//EN" => 1,
2668     "-//IETF//DTD HTML LEVEL 0//EN//2.0" => 1,
2669     "-//IETF//DTD HTML LEVEL 1//EN" => 1,
2670     "-//IETF//DTD HTML LEVEL 1//EN//2.0" => 1,
2671     "-//IETF//DTD HTML LEVEL 2//EN" => 1,
2672     "-//IETF//DTD HTML LEVEL 2//EN//2.0" => 1,
2673     "-//IETF//DTD HTML LEVEL 3//EN" => 1,
2674     "-//IETF//DTD HTML LEVEL 3//EN//3.0" => 1,
2675     "-//IETF//DTD HTML STRICT LEVEL 0//EN" => 1,
2676     "-//IETF//DTD HTML STRICT LEVEL 0//EN//2.0" => 1,
2677     "-//IETF//DTD HTML STRICT LEVEL 1//EN" => 1,
2678     "-//IETF//DTD HTML STRICT LEVEL 1//EN//2.0" => 1,
2679     "-//IETF//DTD HTML STRICT LEVEL 2//EN" => 1,
2680     "-//IETF//DTD HTML STRICT LEVEL 2//EN//2.0" => 1,
2681     "-//IETF//DTD HTML STRICT LEVEL 3//EN" => 1,
2682     "-//IETF//DTD HTML STRICT LEVEL 3//EN//3.0" => 1,
2683     "-//IETF//DTD HTML STRICT//EN" => 1,
2684     "-//IETF//DTD HTML STRICT//EN//2.0" => 1,
2685     "-//IETF//DTD HTML STRICT//EN//3.0" => 1,
2686     "-//IETF//DTD HTML//EN" => 1,
2687     "-//IETF//DTD HTML//EN//2.0" => 1,
2688     "-//IETF//DTD HTML//EN//3.0" => 1,
2689     "-//METRIUS//DTD METRIUS PRESENTATIONAL//EN" => 1,
2690     "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//EN" => 1,
2691     "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//EN" => 1,
2692     "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//EN" => 1,
2693     "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//EN" => 1,
2694     "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//EN" => 1,
2695     "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//EN" => 1,
2696     "-//NETSCAPE COMM. CORP.//DTD HTML//EN" => 1,
2697     "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//EN" => 1,
2698     "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//EN" => 1,
2699     "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//EN" => 1,
2700     "-//SPYGLASS//DTD HTML 2.0 EXTENDED//EN" => 1,
2701     "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//EN" => 1,
2702     "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//EN" => 1,
2703     "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//EN" => 1,
2704     "-//W3C//DTD HTML 3 1995-03-24//EN" => 1,
2705     "-//W3C//DTD HTML 3.2 DRAFT//EN" => 1,
2706     "-//W3C//DTD HTML 3.2 FINAL//EN" => 1,
2707     "-//W3C//DTD HTML 3.2//EN" => 1,
2708     "-//W3C//DTD HTML 3.2S DRAFT//EN" => 1,
2709     "-//W3C//DTD HTML 4.0 FRAMESET//EN" => 1,
2710     "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN" => 1,
2711     "-//W3C//DTD HTML EXPERIMETNAL 19960712//EN" => 1,
2712     "-//W3C//DTD HTML EXPERIMENTAL 970421//EN" => 1,
2713     "-//W3C//DTD W3 HTML//EN" => 1,
2714     "-//W3O//DTD W3 HTML 3.0//EN" => 1,
2715     "-//W3O//DTD W3 HTML 3.0//EN//" => 1,
2716     "-//W3O//DTD W3 HTML STRICT 3.0//EN//" => 1,
2717     "-//WEBTECHS//DTD MOZILLA HTML 2.0//EN" => 1,
2718     "-//WEBTECHS//DTD MOZILLA HTML//EN" => 1,
2719     "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" => 1,
2720     "HTML" => 1,
2721     }->{$pubid}) {
2722     $self->{document}->manakai_compat_mode ('quirks');
2723     } elsif ($pubid eq "-//W3C//DTD HTML 4.01 FRAMESET//EN" or
2724     $pubid eq "-//W3C//DTD HTML 4.01 TRANSITIONAL//EN") {
2725     if (defined $token->{system_identifier}) {
2726     $self->{document}->manakai_compat_mode ('quirks');
2727     } else {
2728     $self->{document}->manakai_compat_mode ('limited quirks');
2729 wakaba 1.3 }
2730 wakaba 1.18 } elsif ($pubid eq "-//W3C//DTD XHTML 1.0 Frameset//EN" or
2731     $pubid eq "-//W3C//DTD XHTML 1.0 Transitional//EN") {
2732     $self->{document}->manakai_compat_mode ('limited quirks');
2733     }
2734     }
2735     if (defined $token->{system_identifier}) {
2736     my $sysid = $token->{system_identifier};
2737     $sysid =~ tr/A-Z/a-z/;
2738     if ($sysid eq "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd") {
2739     $self->{document}->manakai_compat_mode ('quirks');
2740     }
2741     }
2742    
2743     ## Go to the root element phase.
2744     $token = $self->_get_next_token;
2745     return;
2746     } elsif ({
2747     'start tag' => 1,
2748     'end tag' => 1,
2749     'end-of-file' => 1,
2750     }->{$token->{type}}) {
2751     $self->{parse_error}-> (type => 'no DOCTYPE');
2752     $self->{document}->manakai_compat_mode ('quirks');
2753     ## Go to the root element phase
2754     ## reprocess
2755     return;
2756     } elsif ($token->{type} eq 'character') {
2757     if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
2758     ## Ignore the token
2759 wakaba 1.26
2760 wakaba 1.18 unless (length $token->{data}) {
2761     ## Stay in the phase
2762     $token = $self->_get_next_token;
2763     redo INITIAL;
2764 wakaba 1.3 }
2765     }
2766 wakaba 1.18
2767     $self->{parse_error}-> (type => 'no DOCTYPE');
2768     $self->{document}->manakai_compat_mode ('quirks');
2769     ## Go to the root element phase
2770     ## reprocess
2771     return;
2772     } elsif ($token->{type} eq 'comment') {
2773     my $comment = $self->{document}->create_comment ($token->{data});
2774     $self->{document}->append_child ($comment);
2775    
2776     ## Stay in the phase.
2777     $token = $self->_get_next_token;
2778     redo INITIAL;
2779     } else {
2780     die "$0: $token->{type}: Unknown token";
2781     }
2782     } # INITIAL
2783 wakaba 1.3 } # _tree_construction_initial
2784    
2785     sub _tree_construction_root_element ($) {
2786     my $self = shift;
2787    
2788     B: {
2789     if ($token->{type} eq 'DOCTYPE') {
2790     $self->{parse_error}-> (type => 'in html:#DOCTYPE');
2791     ## Ignore the token
2792     ## Stay in the phase
2793     $token = $self->_get_next_token;
2794     redo B;
2795     } elsif ($token->{type} eq 'comment') {
2796     my $comment = $self->{document}->create_comment ($token->{data});
2797     $self->{document}->append_child ($comment);
2798     ## Stay in the phase
2799     $token = $self->_get_next_token;
2800     redo B;
2801     } elsif ($token->{type} eq 'character') {
2802 wakaba 1.26 if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
2803     ## Ignore the token.
2804    
2805 wakaba 1.3 unless (length $token->{data}) {
2806     ## Stay in the phase
2807     $token = $self->_get_next_token;
2808     redo B;
2809     }
2810     }
2811     #
2812     } elsif ({
2813     'start tag' => 1,
2814     'end tag' => 1,
2815     'end-of-file' => 1,
2816     }->{$token->{type}}) {
2817     ## ISSUE: There is an issue in the spec
2818     #
2819     } else {
2820     die "$0: $token->{type}: Unknown token";
2821     }
2822     my $root_element;
2823     $root_element = $self->{document}->create_element_ns
2824     (q<http://www.w3.org/1999/xhtml>, [undef, 'html']);
2825    
2826     $self->{document}->append_child ($root_element);
2827     push @{$self->{open_elements}}, [$root_element, 'html'];
2828     ## reprocess
2829     #redo B;
2830 wakaba 1.35 return; ## Go to the main phase.
2831 wakaba 1.3 } # B
2832     } # _tree_construction_root_element
2833    
2834     sub _reset_insertion_mode ($) {
2835     my $self = shift;
2836    
2837     ## Step 1
2838     my $last;
2839    
2840     ## Step 2
2841     my $i = -1;
2842     my $node = $self->{open_elements}->[$i];
2843    
2844     ## Step 3
2845     S3: {
2846 wakaba 1.29 ## ISSUE: Oops! "If node is the first node in the stack of open
2847     ## elements, then set last to true. If the context element of the
2848     ## HTML fragment parsing algorithm is neither a td element nor a
2849     ## th element, then set node to the context element. (fragment case)":
2850     ## The second "if" is in the scope of the first "if"!?
2851     if ($self->{open_elements}->[0]->[0] eq $node->[0]) {
2852     $last = 1;
2853     if (defined $self->{inner_html_node}) {
2854     if ($self->{inner_html_node}->[1] eq 'td' or
2855     $self->{inner_html_node}->[1] eq 'th') {
2856     #
2857     } else {
2858     $node = $self->{inner_html_node};
2859     }
2860 wakaba 1.3 }
2861     }
2862    
2863     ## Step 4..13
2864     my $new_mode = {
2865     select => 'in select',
2866     td => 'in cell',
2867     th => 'in cell',
2868     tr => 'in row',
2869     tbody => 'in table body',
2870     thead => 'in table head',
2871     tfoot => 'in table foot',
2872     caption => 'in caption',
2873     colgroup => 'in column group',
2874     table => 'in table',
2875     head => 'in body', # not in head!
2876     body => 'in body',
2877     frameset => 'in frameset',
2878     }->{$node->[1]};
2879     $self->{insertion_mode} = $new_mode and return if defined $new_mode;
2880    
2881     ## Step 14
2882     if ($node->[1] eq 'html') {
2883     unless (defined $self->{head_element}) {
2884     $self->{insertion_mode} = 'before head';
2885     } else {
2886     $self->{insertion_mode} = 'after head';
2887     }
2888     return;
2889     }
2890    
2891     ## Step 15
2892     $self->{insertion_mode} = 'in body' and return if $last;
2893    
2894     ## Step 16
2895     $i--;
2896     $node = $self->{open_elements}->[$i];
2897    
2898     ## Step 17
2899     redo S3;
2900     } # S3
2901     } # _reset_insertion_mode
2902    
2903     sub _tree_construction_main ($) {
2904     my $self = shift;
2905    
2906 wakaba 1.35 my $previous_insertion_mode;
2907 wakaba 1.1
2908     my $active_formatting_elements = [];
2909    
2910     my $reconstruct_active_formatting_elements = sub { # MUST
2911     my $insert = shift;
2912    
2913     ## Step 1
2914     return unless @$active_formatting_elements;
2915    
2916     ## Step 3
2917     my $i = -1;
2918     my $entry = $active_formatting_elements->[$i];
2919    
2920     ## Step 2
2921     return if $entry->[0] eq '#marker';
2922 wakaba 1.3 for (@{$self->{open_elements}}) {
2923 wakaba 1.1 if ($entry->[0] eq $_->[0]) {
2924     return;
2925     }
2926     }
2927    
2928     S4: {
2929     ## Step 4
2930     last S4 if $active_formatting_elements->[0]->[0] eq $entry->[0];
2931    
2932     ## Step 5
2933     $i--;
2934     $entry = $active_formatting_elements->[$i];
2935    
2936     ## Step 6
2937     if ($entry->[0] eq '#marker') {
2938     #
2939     } else {
2940     my $in_open_elements;
2941 wakaba 1.3 OE: for (@{$self->{open_elements}}) {
2942 wakaba 1.1 if ($entry->[0] eq $_->[0]) {
2943     $in_open_elements = 1;
2944     last OE;
2945     }
2946     }
2947     if ($in_open_elements) {
2948     #
2949     } else {
2950     redo S4;
2951     }
2952     }
2953    
2954     ## Step 7
2955     $i++;
2956     $entry = $active_formatting_elements->[$i];
2957     } # S4
2958    
2959     S7: {
2960     ## Step 8
2961     my $clone = [$entry->[0]->clone_node (0), $entry->[1]];
2962    
2963     ## Step 9
2964     $insert->($clone->[0]);
2965 wakaba 1.3 push @{$self->{open_elements}}, $clone;
2966 wakaba 1.1
2967     ## Step 10
2968 wakaba 1.3 $active_formatting_elements->[$i] = $self->{open_elements}->[-1];
2969 wakaba 1.1
2970     ## Step 11
2971     unless ($clone->[0] eq $active_formatting_elements->[-1]->[0]) {
2972     ## Step 7'
2973     $i++;
2974     $entry = $active_formatting_elements->[$i];
2975    
2976     redo S7;
2977     }
2978     } # S7
2979     }; # $reconstruct_active_formatting_elements
2980    
2981     my $clear_up_to_marker = sub {
2982     for (reverse 0..$#$active_formatting_elements) {
2983     if ($active_formatting_elements->[$_]->[0] eq '#marker') {
2984     splice @$active_formatting_elements, $_;
2985     return;
2986     }
2987     }
2988     }; # $clear_up_to_marker
2989    
2990 wakaba 1.25 my $parse_rcdata = sub ($$) {
2991     my ($content_model_flag, $insert) = @_;
2992    
2993     ## Step 1
2994     my $start_tag_name = $token->{tag_name};
2995     my $el;
2996    
2997     $el = $self->{document}->create_element_ns
2998     (q<http://www.w3.org/1999/xhtml>, [undef, $start_tag_name]);
2999 wakaba 1.1
3000 wakaba 1.6 for my $attr_name (keys %{ $token->{attributes}}) {
3001 wakaba 1.25 $el->set_attribute_ns (undef, [undef, $attr_name],
3002 wakaba 1.6 $token->{attributes} ->{$attr_name}->{value});
3003     }
3004    
3005 wakaba 1.25
3006     ## Step 2
3007     $insert->($el); # /context node/->append_child ($el)
3008    
3009     ## Step 3
3010     $self->{content_model_flag} = $content_model_flag; # CDATA or RCDATA
3011 wakaba 1.13 delete $self->{escape}; # MUST
3012 wakaba 1.25
3013     ## Step 4
3014 wakaba 1.1 my $text = '';
3015     $token = $self->_get_next_token;
3016 wakaba 1.25 while ($token->{type} eq 'character') { # or until stop tokenizing
3017 wakaba 1.1 $text .= $token->{data};
3018     $token = $self->_get_next_token;
3019 wakaba 1.25 }
3020    
3021     ## Step 5
3022 wakaba 1.1 if (length $text) {
3023 wakaba 1.25 my $text = $self->{document}->create_text_node ($text);
3024     $el->append_child ($text);
3025 wakaba 1.1 }
3026 wakaba 1.25
3027     ## Step 6
3028 wakaba 1.1 $self->{content_model_flag} = 'PCDATA';
3029 wakaba 1.25
3030     ## Step 7
3031     if ($token->{type} eq 'end tag' and $token->{tag_name} eq $start_tag_name) {
3032 wakaba 1.1 ## Ignore the token
3033     } else {
3034 wakaba 1.25 $self->{parse_error}-> (type => 'in '.$content_model_flag.':#'.$token->{type});
3035 wakaba 1.1 }
3036     $token = $self->_get_next_token;
3037 wakaba 1.25 }; # $parse_rcdata
3038 wakaba 1.1
3039 wakaba 1.25 my $script_start_tag = sub ($) {
3040     my $insert = $_[0];
3041 wakaba 1.1 my $script_el;
3042    
3043     $script_el = $self->{document}->create_element_ns
3044     (q<http://www.w3.org/1999/xhtml>, [undef, 'script']);
3045    
3046     for my $attr_name (keys %{ $token->{attributes}}) {
3047     $script_el->set_attribute_ns (undef, [undef, $attr_name],
3048     $token->{attributes} ->{$attr_name}->{value});
3049     }
3050    
3051     ## TODO: mark as "parser-inserted"
3052    
3053     $self->{content_model_flag} = 'CDATA';
3054 wakaba 1.13 delete $self->{escape}; # MUST
3055 wakaba 1.1
3056     my $text = '';
3057     $token = $self->_get_next_token;
3058     while ($token->{type} eq 'character') {
3059     $text .= $token->{data};
3060     $token = $self->_get_next_token;
3061     } # stop if non-character token or tokenizer stops tokenising
3062     if (length $text) {
3063     $script_el->manakai_append_text ($text);
3064     }
3065    
3066     $self->{content_model_flag} = 'PCDATA';
3067    
3068     if ($token->{type} eq 'end tag' and
3069     $token->{tag_name} eq 'script') {
3070     ## Ignore the token
3071     } else {
3072 wakaba 1.3 $self->{parse_error}-> (type => 'in CDATA:#'.$token->{type});
3073 wakaba 1.1 ## ISSUE: And ignore?
3074     ## TODO: mark as "already executed"
3075     }
3076    
3077 wakaba 1.3 if (defined $self->{inner_html_node}) {
3078     ## TODO: mark as "already executed"
3079     } else {
3080 wakaba 1.1 ## TODO: $old_insertion_point = current insertion point
3081     ## TODO: insertion point = just before the next input character
3082 wakaba 1.25
3083     $insert->($script_el);
3084 wakaba 1.1
3085     ## TODO: insertion point = $old_insertion_point (might be "undefined")
3086    
3087     ## TODO: if there is a script that will execute as soon as the parser resume, then...
3088     }
3089    
3090     $token = $self->_get_next_token;
3091     }; # $script_start_tag
3092    
3093     my $formatting_end_tag = sub {
3094     my $tag_name = shift;
3095    
3096     FET: {
3097     ## Step 1
3098     my $formatting_element;
3099     my $formatting_element_i_in_active;
3100     AFE: for (reverse 0..$#$active_formatting_elements) {
3101     if ($active_formatting_elements->[$_]->[1] eq $tag_name) {
3102     $formatting_element = $active_formatting_elements->[$_];
3103     $formatting_element_i_in_active = $_;
3104     last AFE;
3105     } elsif ($active_formatting_elements->[$_]->[0] eq '#marker') {
3106     last AFE;
3107     }
3108     } # AFE
3109     unless (defined $formatting_element) {
3110 wakaba 1.3 $self->{parse_error}-> (type => 'unmatched end tag:'.$tag_name);
3111 wakaba 1.1 ## Ignore the token
3112     $token = $self->_get_next_token;
3113     return;
3114     }
3115     ## has an element in scope
3116     my $in_scope = 1;
3117     my $formatting_element_i_in_open;
3118 wakaba 1.3 INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3119     my $node = $self->{open_elements}->[$_];
3120 wakaba 1.1 if ($node->[0] eq $formatting_element->[0]) {
3121     if ($in_scope) {
3122     $formatting_element_i_in_open = $_;
3123     last INSCOPE;
3124     } else { # in open elements but not in scope
3125 wakaba 1.4 $self->{parse_error}-> (type => 'unmatched end tag:'.$token->{tag_name});
3126 wakaba 1.1 ## Ignore the token
3127     $token = $self->_get_next_token;
3128     return;
3129     }
3130     } elsif ({
3131     table => 1, caption => 1, td => 1, th => 1,
3132     button => 1, marquee => 1, object => 1, html => 1,
3133     }->{$node->[1]}) {
3134     $in_scope = 0;
3135     }
3136     } # INSCOPE
3137     unless (defined $formatting_element_i_in_open) {
3138 wakaba 1.4 $self->{parse_error}-> (type => 'unmatched end tag:'.$token->{tag_name});
3139 wakaba 1.1 pop @$active_formatting_elements; # $formatting_element
3140     $token = $self->_get_next_token; ## TODO: ok?
3141     return;
3142     }
3143 wakaba 1.3 if (not $self->{open_elements}->[-1]->[0] eq $formatting_element->[0]) {
3144 wakaba 1.4 $self->{parse_error}-> (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3145 wakaba 1.1 }
3146    
3147     ## Step 2
3148     my $furthest_block;
3149     my $furthest_block_i_in_open;
3150 wakaba 1.3 OE: for (reverse 0..$#{$self->{open_elements}}) {
3151     my $node = $self->{open_elements}->[$_];
3152 wakaba 1.1 if (not $formatting_category->{$node->[1]} and
3153     #not $phrasing_category->{$node->[1]} and
3154     ($special_category->{$node->[1]} or
3155     $scoping_category->{$node->[1]})) {
3156     $furthest_block = $node;
3157     $furthest_block_i_in_open = $_;
3158     } elsif ($node->[0] eq $formatting_element->[0]) {
3159     last OE;
3160     }
3161     } # OE
3162    
3163     ## Step 3
3164     unless (defined $furthest_block) { # MUST
3165 wakaba 1.3 splice @{$self->{open_elements}}, $formatting_element_i_in_open;
3166 wakaba 1.1 splice @$active_formatting_elements, $formatting_element_i_in_active, 1;
3167     $token = $self->_get_next_token;
3168     return;
3169     }
3170    
3171     ## Step 4
3172 wakaba 1.3 my $common_ancestor_node = $self->{open_elements}->[$formatting_element_i_in_open - 1];
3173 wakaba 1.1
3174     ## Step 5
3175     my $furthest_block_parent = $furthest_block->[0]->parent_node;
3176     if (defined $furthest_block_parent) {
3177     $furthest_block_parent->remove_child ($furthest_block->[0]);
3178     }
3179    
3180     ## Step 6
3181     my $bookmark_prev_el
3182     = $active_formatting_elements->[$formatting_element_i_in_active - 1]
3183     ->[0];
3184    
3185     ## Step 7
3186     my $node = $furthest_block;
3187     my $node_i_in_open = $furthest_block_i_in_open;
3188     my $last_node = $furthest_block;
3189     S7: {
3190     ## Step 1
3191     $node_i_in_open--;
3192 wakaba 1.3 $node = $self->{open_elements}->[$node_i_in_open];
3193 wakaba 1.1
3194     ## Step 2
3195     my $node_i_in_active;
3196     S7S2: {
3197     for (reverse 0..$#$active_formatting_elements) {
3198     if ($active_formatting_elements->[$_]->[0] eq $node->[0]) {
3199     $node_i_in_active = $_;
3200     last S7S2;
3201     }
3202     }
3203 wakaba 1.3 splice @{$self->{open_elements}}, $node_i_in_open, 1;
3204 wakaba 1.1 redo S7;
3205     } # S7S2
3206    
3207     ## Step 3
3208     last S7 if $node->[0] eq $formatting_element->[0];
3209    
3210     ## Step 4
3211     if ($last_node->[0] eq $furthest_block->[0]) {
3212     $bookmark_prev_el = $node->[0];
3213     }
3214    
3215     ## Step 5
3216     if ($node->[0]->has_child_nodes ()) {
3217     my $clone = [$node->[0]->clone_node (0), $node->[1]];
3218     $active_formatting_elements->[$node_i_in_active] = $clone;
3219 wakaba 1.3 $self->{open_elements}->[$node_i_in_open] = $clone;
3220 wakaba 1.1 $node = $clone;
3221     }
3222    
3223     ## Step 6
3224     $node->[0]->append_child ($last_node->[0]);
3225    
3226     ## Step 7
3227     $last_node = $node;
3228    
3229     ## Step 8
3230     redo S7;
3231     } # S7
3232    
3233     ## Step 8
3234     $common_ancestor_node->[0]->append_child ($last_node->[0]);
3235    
3236     ## Step 9
3237     my $clone = [$formatting_element->[0]->clone_node (0),
3238     $formatting_element->[1]];
3239    
3240     ## Step 10
3241     my @cn = @{$furthest_block->[0]->child_nodes};
3242     $clone->[0]->append_child ($_) for @cn;
3243    
3244     ## Step 11
3245     $furthest_block->[0]->append_child ($clone->[0]);
3246    
3247     ## Step 12
3248     my $i;
3249     AFE: for (reverse 0..$#$active_formatting_elements) {
3250     if ($active_formatting_elements->[$_]->[0] eq $formatting_element->[0]) {
3251     splice @$active_formatting_elements, $_, 1;
3252     $i-- and last AFE if defined $i;
3253     } elsif ($active_formatting_elements->[$_]->[0] eq $bookmark_prev_el) {
3254     $i = $_;
3255     }
3256     } # AFE
3257     splice @$active_formatting_elements, $i + 1, 0, $clone;
3258    
3259     ## Step 13
3260     undef $i;
3261 wakaba 1.3 OE: for (reverse 0..$#{$self->{open_elements}}) {
3262     if ($self->{open_elements}->[$_]->[0] eq $formatting_element->[0]) {
3263     splice @{$self->{open_elements}}, $_, 1;
3264 wakaba 1.1 $i-- and last OE if defined $i;
3265 wakaba 1.3 } elsif ($self->{open_elements}->[$_]->[0] eq $furthest_block->[0]) {
3266 wakaba 1.1 $i = $_;
3267     }
3268     } # OE
3269 wakaba 1.3 splice @{$self->{open_elements}}, $i + 1, 1, $clone;
3270 wakaba 1.1
3271     ## Step 14
3272     redo FET;
3273     } # FET
3274     }; # $formatting_end_tag
3275    
3276     my $insert_to_current = sub {
3277 wakaba 1.25 $self->{open_elements}->[-1]->[0]->append_child ($_[0]);
3278 wakaba 1.1 }; # $insert_to_current
3279    
3280     my $insert_to_foster = sub {
3281     my $child = shift;
3282     if ({
3283     table => 1, tbody => 1, tfoot => 1,
3284     thead => 1, tr => 1,
3285 wakaba 1.3 }->{$self->{open_elements}->[-1]->[1]}) {
3286 wakaba 1.1 # MUST
3287     my $foster_parent_element;
3288     my $next_sibling;
3289 wakaba 1.3 OE: for (reverse 0..$#{$self->{open_elements}}) {
3290     if ($self->{open_elements}->[$_]->[1] eq 'table') {
3291     my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
3292 wakaba 1.1 if (defined $parent and $parent->node_type == 1) {
3293     $foster_parent_element = $parent;
3294 wakaba 1.3 $next_sibling = $self->{open_elements}->[$_]->[0];
3295 wakaba 1.1 } else {
3296     $foster_parent_element
3297 wakaba 1.3 = $self->{open_elements}->[$_ - 1]->[0];
3298 wakaba 1.1 }
3299     last OE;
3300     }
3301     } # OE
3302 wakaba 1.3 $foster_parent_element = $self->{open_elements}->[0]->[0]
3303 wakaba 1.1 unless defined $foster_parent_element;
3304     $foster_parent_element->insert_before
3305     ($child, $next_sibling);
3306     } else {
3307 wakaba 1.3 $self->{open_elements}->[-1]->[0]->append_child ($child);
3308 wakaba 1.1 }
3309     }; # $insert_to_foster
3310    
3311     my $in_body = sub {
3312     my $insert = shift;
3313     if ($token->{type} eq 'start tag') {
3314     if ($token->{tag_name} eq 'script') {
3315 wakaba 1.25 ## NOTE: This is an "as if in head" code clone
3316     $script_start_tag->($insert);
3317 wakaba 1.1 return;
3318     } elsif ($token->{tag_name} eq 'style') {
3319 wakaba 1.25 ## NOTE: This is an "as if in head" code clone
3320     $parse_rcdata->('CDATA', $insert);
3321 wakaba 1.1 return;
3322     } elsif ({
3323 wakaba 1.35 base => 1, link => 1,
3324 wakaba 1.1 }->{$token->{tag_name}}) {
3325 wakaba 1.25 ## NOTE: This is an "as if in head" code clone, only "-t" differs
3326 wakaba 1.1
3327 wakaba 1.25 {
3328     my $el;
3329    
3330 wakaba 1.1 $el = $self->{document}->create_element_ns
3331     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3332    
3333 wakaba 1.25 for my $attr_name (keys %{ $token->{attributes}}) {
3334 wakaba 1.1 $el->set_attribute_ns (undef, [undef, $attr_name],
3335 wakaba 1.25 $token->{attributes} ->{$attr_name}->{value});
3336 wakaba 1.1 }
3337    
3338 wakaba 1.25 $insert->($el);
3339     push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3340     }
3341    
3342     pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
3343 wakaba 1.1 $token = $self->_get_next_token;
3344     return;
3345 wakaba 1.34 } elsif ($token->{tag_name} eq 'meta') {
3346     ## NOTE: This is an "as if in head" code clone, only "-t" differs
3347    
3348     {
3349     my $el;
3350    
3351     $el = $self->{document}->create_element_ns
3352     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3353    
3354     for my $attr_name (keys %{ $token->{attributes}}) {
3355     $el->set_attribute_ns (undef, [undef, $attr_name],
3356     $token->{attributes} ->{$attr_name}->{value});
3357     }
3358    
3359     $insert->($el);
3360     push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3361     }
3362    
3363     pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
3364    
3365     unless ($self->{confident}) {
3366     my $charset;
3367     if ($token->{attributes}->{charset}) { ## TODO: And if supported
3368     $charset = $token->{attributes}->{charset}->{value};
3369     }
3370     if ($token->{attributes}->{'http-equiv'}) {
3371 wakaba 1.35 ## ISSUE: Algorithm name in the spec was incorrect so that not linked to the definition.
3372 wakaba 1.34 if ($token->{attributes}->{'http-equiv'}->{value}
3373     =~ /\A[^;]*;[\x09-\x0D\x20]*charset[\x09-\x0D\x20]*=
3374     [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|
3375     ([^"'\x09-\x0D\x20][^\x09-\x0D\x20]*))/x) {
3376     $charset = defined $1 ? $1 : defined $2 ? $2 : $3;
3377     } ## TODO: And if supported
3378     }
3379     ## TODO: Change the encoding
3380     }
3381    
3382     $token = $self->_get_next_token;
3383     return;
3384 wakaba 1.1 } elsif ($token->{tag_name} eq 'title') {
3385 wakaba 1.3 $self->{parse_error}-> (type => 'in body:title');
3386 wakaba 1.25 ## NOTE: This is an "as if in head" code clone
3387 wakaba 1.31 $parse_rcdata->('RCDATA', sub {
3388     if (defined $self->{head_element}) {
3389     $self->{head_element}->append_child ($_[0]);
3390     } else {
3391     $insert->($_[0]);
3392     }
3393     });
3394 wakaba 1.1 return;
3395     } elsif ($token->{tag_name} eq 'body') {
3396 wakaba 1.3 $self->{parse_error}-> (type => 'in body:body');
3397 wakaba 1.1
3398 wakaba 1.3 if (@{$self->{open_elements}} == 1 or
3399     $self->{open_elements}->[1]->[1] ne 'body') {
3400 wakaba 1.1 ## Ignore the token
3401     } else {
3402 wakaba 1.3 my $body_el = $self->{open_elements}->[1]->[0];
3403 wakaba 1.1 for my $attr_name (keys %{$token->{attributes}}) {
3404     unless ($body_el->has_attribute_ns (undef, $attr_name)) {
3405     $body_el->set_attribute_ns
3406     (undef, [undef, $attr_name],
3407     $token->{attributes}->{$attr_name}->{value});
3408     }
3409     }
3410     }
3411     $token = $self->_get_next_token;
3412     return;
3413     } elsif ({
3414     address => 1, blockquote => 1, center => 1, dir => 1,
3415     div => 1, dl => 1, fieldset => 1, listing => 1,
3416     menu => 1, ol => 1, p => 1, ul => 1,
3417     pre => 1,
3418     }->{$token->{tag_name}}) {
3419     ## has a p element in scope
3420 wakaba 1.3 INSCOPE: for (reverse @{$self->{open_elements}}) {
3421 wakaba 1.1 if ($_->[1] eq 'p') {
3422     unshift @{$self->{token}}, $token;
3423     $token = {type => 'end tag', tag_name => 'p'};
3424     return;
3425     } elsif ({
3426     table => 1, caption => 1, td => 1, th => 1,
3427     button => 1, marquee => 1, object => 1, html => 1,
3428     }->{$_->[1]}) {
3429     last INSCOPE;
3430     }
3431     } # INSCOPE
3432    
3433    
3434     {
3435     my $el;
3436    
3437     $el = $self->{document}->create_element_ns
3438     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3439    
3440     for my $attr_name (keys %{ $token->{attributes}}) {
3441     $el->set_attribute_ns (undef, [undef, $attr_name],
3442     $token->{attributes} ->{$attr_name}->{value});
3443     }
3444    
3445     $insert->($el);
3446 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3447 wakaba 1.1 }
3448    
3449     if ($token->{tag_name} eq 'pre') {
3450     $token = $self->_get_next_token;
3451     if ($token->{type} eq 'character') {
3452     $token->{data} =~ s/^\x0A//;
3453     unless (length $token->{data}) {
3454     $token = $self->_get_next_token;
3455     }
3456     }
3457     } else {
3458     $token = $self->_get_next_token;
3459     }
3460     return;
3461     } elsif ($token->{tag_name} eq 'form') {
3462 wakaba 1.3 if (defined $self->{form_element}) {
3463     $self->{parse_error}-> (type => 'in form:form');
3464 wakaba 1.1 ## Ignore the token
3465 wakaba 1.7 $token = $self->_get_next_token;
3466     return;
3467 wakaba 1.1 } else {
3468     ## has a p element in scope
3469 wakaba 1.3 INSCOPE: for (reverse @{$self->{open_elements}}) {
3470 wakaba 1.1 if ($_->[1] eq 'p') {
3471     unshift @{$self->{token}}, $token;
3472     $token = {type => 'end tag', tag_name => 'p'};
3473     return;
3474     } elsif ({
3475     table => 1, caption => 1, td => 1, th => 1,
3476     button => 1, marquee => 1, object => 1, html => 1,
3477     }->{$_->[1]}) {
3478     last INSCOPE;
3479     }
3480     } # INSCOPE
3481    
3482    
3483     {
3484     my $el;
3485    
3486     $el = $self->{document}->create_element_ns
3487     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3488    
3489     for my $attr_name (keys %{ $token->{attributes}}) {
3490     $el->set_attribute_ns (undef, [undef, $attr_name],
3491     $token->{attributes} ->{$attr_name}->{value});
3492     }
3493    
3494     $insert->($el);
3495 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3496 wakaba 1.1 }
3497    
3498 wakaba 1.3 $self->{form_element} = $self->{open_elements}->[-1]->[0];
3499 wakaba 1.1 $token = $self->_get_next_token;
3500     return;
3501     }
3502     } elsif ($token->{tag_name} eq 'li') {
3503     ## has a p element in scope
3504 wakaba 1.3 INSCOPE: for (reverse @{$self->{open_elements}}) {
3505 wakaba 1.1 if ($_->[1] eq 'p') {
3506     unshift @{$self->{token}}, $token;
3507     $token = {type => 'end tag', tag_name => 'p'};
3508     return;
3509     } elsif ({
3510     table => 1, caption => 1, td => 1, th => 1,
3511     button => 1, marquee => 1, object => 1, html => 1,
3512     }->{$_->[1]}) {
3513     last INSCOPE;
3514     }
3515     } # INSCOPE
3516    
3517     ## Step 1
3518     my $i = -1;
3519 wakaba 1.3 my $node = $self->{open_elements}->[$i];
3520 wakaba 1.1 LI: {
3521     ## Step 2
3522     if ($node->[1] eq 'li') {
3523 wakaba 1.8 if ($i != -1) {
3524     $self->{parse_error}-> (type => 'end tag missing:'.
3525     $self->{open_elements}->[-1]->[1]);
3526     }
3527 wakaba 1.3 splice @{$self->{open_elements}}, $i;
3528 wakaba 1.1 last LI;
3529     }
3530    
3531     ## Step 3
3532     if (not $formatting_category->{$node->[1]} and
3533     #not $phrasing_category->{$node->[1]} and
3534     ($special_category->{$node->[1]} or
3535     $scoping_category->{$node->[1]}) and
3536     $node->[1] ne 'address' and $node->[1] ne 'div') {
3537     last LI;
3538     }
3539    
3540     ## Step 4
3541     $i--;
3542 wakaba 1.3 $node = $self->{open_elements}->[$i];
3543 wakaba 1.1 redo LI;
3544     } # LI
3545    
3546    
3547     {
3548     my $el;
3549    
3550     $el = $self->{document}->create_element_ns
3551     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3552    
3553     for my $attr_name (keys %{ $token->{attributes}}) {
3554     $el->set_attribute_ns (undef, [undef, $attr_name],
3555     $token->{attributes} ->{$attr_name}->{value});
3556     }
3557    
3558     $insert->($el);
3559 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3560 wakaba 1.1 }
3561    
3562     $token = $self->_get_next_token;
3563     return;
3564     } elsif ($token->{tag_name} eq 'dd' or $token->{tag_name} eq 'dt') {
3565     ## has a p element in scope
3566 wakaba 1.3 INSCOPE: for (reverse @{$self->{open_elements}}) {
3567 wakaba 1.1 if ($_->[1] eq 'p') {
3568     unshift @{$self->{token}}, $token;
3569     $token = {type => 'end tag', tag_name => 'p'};
3570     return;
3571     } elsif ({
3572     table => 1, caption => 1, td => 1, th => 1,
3573     button => 1, marquee => 1, object => 1, html => 1,
3574     }->{$_->[1]}) {
3575     last INSCOPE;
3576     }
3577     } # INSCOPE
3578    
3579     ## Step 1
3580     my $i = -1;
3581 wakaba 1.3 my $node = $self->{open_elements}->[$i];
3582 wakaba 1.1 LI: {
3583     ## Step 2
3584     if ($node->[1] eq 'dt' or $node->[1] eq 'dd') {
3585 wakaba 1.8 if ($i != -1) {
3586     $self->{parse_error}-> (type => 'end tag missing:'.
3587     $self->{open_elements}->[-1]->[1]);
3588     }
3589 wakaba 1.3 splice @{$self->{open_elements}}, $i;
3590 wakaba 1.1 last LI;
3591     }
3592    
3593     ## Step 3
3594     if (not $formatting_category->{$node->[1]} and
3595     #not $phrasing_category->{$node->[1]} and
3596     ($special_category->{$node->[1]} or
3597     $scoping_category->{$node->[1]}) and
3598     $node->[1] ne 'address' and $node->[1] ne 'div') {
3599     last LI;
3600     }
3601    
3602     ## Step 4
3603     $i--;
3604 wakaba 1.3 $node = $self->{open_elements}->[$i];
3605 wakaba 1.1 redo LI;
3606     } # LI
3607    
3608    
3609     {
3610     my $el;
3611    
3612     $el = $self->{document}->create_element_ns
3613     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3614    
3615     for my $attr_name (keys %{ $token->{attributes}}) {
3616     $el->set_attribute_ns (undef, [undef, $attr_name],
3617     $token->{attributes} ->{$attr_name}->{value});
3618     }
3619    
3620     $insert->($el);
3621 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3622 wakaba 1.1 }
3623    
3624     $token = $self->_get_next_token;
3625     return;
3626     } elsif ($token->{tag_name} eq 'plaintext') {
3627     ## has a p element in scope
3628 wakaba 1.3 INSCOPE: for (reverse @{$self->{open_elements}}) {
3629 wakaba 1.1 if ($_->[1] eq 'p') {
3630     unshift @{$self->{token}}, $token;
3631     $token = {type => 'end tag', tag_name => 'p'};
3632     return;
3633     } elsif ({
3634     table => 1, caption => 1, td => 1, th => 1,
3635     button => 1, marquee => 1, object => 1, html => 1,
3636     }->{$_->[1]}) {
3637     last INSCOPE;
3638     }
3639     } # INSCOPE
3640    
3641    
3642     {
3643     my $el;
3644    
3645     $el = $self->{document}->create_element_ns
3646     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3647    
3648     for my $attr_name (keys %{ $token->{attributes}}) {
3649     $el->set_attribute_ns (undef, [undef, $attr_name],
3650     $token->{attributes} ->{$attr_name}->{value});
3651     }
3652    
3653     $insert->($el);
3654 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3655 wakaba 1.1 }
3656    
3657    
3658     $self->{content_model_flag} = 'PLAINTEXT';
3659    
3660     $token = $self->_get_next_token;
3661     return;
3662     } elsif ({
3663     h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
3664     }->{$token->{tag_name}}) {
3665     ## has a p element in scope
3666 wakaba 1.3 INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3667     my $node = $self->{open_elements}->[$_];
3668 wakaba 1.1 if ($node->[1] eq 'p') {
3669     unshift @{$self->{token}}, $token;
3670     $token = {type => 'end tag', tag_name => 'p'};
3671     return;
3672     } elsif ({
3673     table => 1, caption => 1, td => 1, th => 1,
3674     button => 1, marquee => 1, object => 1, html => 1,
3675     }->{$node->[1]}) {
3676     last INSCOPE;
3677     }
3678     } # INSCOPE
3679    
3680 wakaba 1.23 ## NOTE: See <http://html5.org/tools/web-apps-tracker?from=925&to=926>
3681 wakaba 1.1 ## has an element in scope
3682 wakaba 1.23 #my $i;
3683     #INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3684     # my $node = $self->{open_elements}->[$_];
3685     # if ({
3686     # h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
3687     # }->{$node->[1]}) {
3688     # $i = $_;
3689     # last INSCOPE;
3690     # } elsif ({
3691     # table => 1, caption => 1, td => 1, th => 1,
3692     # button => 1, marquee => 1, object => 1, html => 1,
3693     # }->{$node->[1]}) {
3694     # last INSCOPE;
3695     # }
3696     #} # INSCOPE
3697     #
3698     #if (defined $i) {
3699     # !!! parse-error (type => 'in hn:hn');
3700     # splice @{$self->{open_elements}}, $i;
3701     #}
3702 wakaba 1.1
3703    
3704     {
3705     my $el;
3706    
3707     $el = $self->{document}->create_element_ns
3708     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3709    
3710     for my $attr_name (keys %{ $token->{attributes}}) {
3711     $el->set_attribute_ns (undef, [undef, $attr_name],
3712     $token->{attributes} ->{$attr_name}->{value});
3713     }
3714    
3715     $insert->($el);
3716 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3717 wakaba 1.1 }
3718    
3719    
3720     $token = $self->_get_next_token;
3721     return;
3722     } elsif ($token->{tag_name} eq 'a') {
3723     AFE: for my $i (reverse 0..$#$active_formatting_elements) {
3724     my $node = $active_formatting_elements->[$i];
3725     if ($node->[1] eq 'a') {
3726 wakaba 1.3 $self->{parse_error}-> (type => 'in a:a');
3727 wakaba 1.1
3728     unshift @{$self->{token}}, $token;
3729     $token = {type => 'end tag', tag_name => 'a'};
3730     $formatting_end_tag->($token->{tag_name});
3731    
3732     AFE2: for (reverse 0..$#$active_formatting_elements) {
3733     if ($active_formatting_elements->[$_]->[0] eq $node->[0]) {
3734     splice @$active_formatting_elements, $_, 1;
3735     last AFE2;
3736     }
3737     } # AFE2
3738 wakaba 1.3 OE: for (reverse 0..$#{$self->{open_elements}}) {
3739     if ($self->{open_elements}->[$_]->[0] eq $node->[0]) {
3740     splice @{$self->{open_elements}}, $_, 1;
3741 wakaba 1.1 last OE;
3742     }
3743     } # OE
3744     last AFE;
3745     } elsif ($node->[0] eq '#marker') {
3746     last AFE;
3747     }
3748     } # AFE
3749    
3750     $reconstruct_active_formatting_elements->($insert_to_current);
3751    
3752    
3753     {
3754     my $el;
3755    
3756     $el = $self->{document}->create_element_ns
3757     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3758    
3759     for my $attr_name (keys %{ $token->{attributes}}) {
3760     $el->set_attribute_ns (undef, [undef, $attr_name],
3761     $token->{attributes} ->{$attr_name}->{value});
3762     }
3763    
3764     $insert->($el);
3765 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3766 wakaba 1.1 }
3767    
3768 wakaba 1.3 push @$active_formatting_elements, $self->{open_elements}->[-1];
3769 wakaba 1.1
3770     $token = $self->_get_next_token;
3771     return;
3772     } elsif ({
3773     b => 1, big => 1, em => 1, font => 1, i => 1,
3774 wakaba 1.19 s => 1, small => 1, strile => 1,
3775 wakaba 1.1 strong => 1, tt => 1, u => 1,
3776     }->{$token->{tag_name}}) {
3777     $reconstruct_active_formatting_elements->($insert_to_current);
3778    
3779    
3780     {
3781     my $el;
3782    
3783     $el = $self->{document}->create_element_ns
3784     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3785    
3786     for my $attr_name (keys %{ $token->{attributes}}) {
3787     $el->set_attribute_ns (undef, [undef, $attr_name],
3788     $token->{attributes} ->{$attr_name}->{value});
3789     }
3790    
3791     $insert->($el);
3792 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3793 wakaba 1.1 }
3794    
3795 wakaba 1.3 push @$active_formatting_elements, $self->{open_elements}->[-1];
3796 wakaba 1.1
3797     $token = $self->_get_next_token;
3798     return;
3799 wakaba 1.19 } elsif ($token->{tag_name} eq 'nobr') {
3800     $reconstruct_active_formatting_elements->($insert_to_current);
3801    
3802     ## has a |nobr| element in scope
3803     INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3804     my $node = $self->{open_elements}->[$_];
3805     if ($node->[1] eq 'nobr') {
3806 wakaba 1.31 $self->{parse_error}-> (type => 'not closed:nobr');
3807 wakaba 1.19 unshift @{$self->{token}}, $token;
3808     $token = {type => 'end tag', tag_name => 'nobr'};
3809     return;
3810     } elsif ({
3811     table => 1, caption => 1, td => 1, th => 1,
3812     button => 1, marquee => 1, object => 1, html => 1,
3813     }->{$node->[1]}) {
3814     last INSCOPE;
3815     }
3816     } # INSCOPE
3817    
3818    
3819     {
3820     my $el;
3821    
3822     $el = $self->{document}->create_element_ns
3823     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3824    
3825     for my $attr_name (keys %{ $token->{attributes}}) {
3826     $el->set_attribute_ns (undef, [undef, $attr_name],
3827     $token->{attributes} ->{$attr_name}->{value});
3828     }
3829    
3830     $insert->($el);
3831     push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3832     }
3833    
3834     push @$active_formatting_elements, $self->{open_elements}->[-1];
3835    
3836     $token = $self->_get_next_token;
3837     return;
3838 wakaba 1.1 } elsif ($token->{tag_name} eq 'button') {
3839     ## has a button element in scope
3840 wakaba 1.3 INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3841     my $node = $self->{open_elements}->[$_];
3842 wakaba 1.1 if ($node->[1] eq 'button') {
3843 wakaba 1.3 $self->{parse_error}-> (type => 'in button:button');
3844 wakaba 1.1 unshift @{$self->{token}}, $token;
3845     $token = {type => 'end tag', tag_name => 'button'};
3846     return;
3847     } elsif ({
3848     table => 1, caption => 1, td => 1, th => 1,
3849     button => 1, marquee => 1, object => 1, html => 1,
3850     }->{$node->[1]}) {
3851     last INSCOPE;
3852     }
3853     } # INSCOPE
3854    
3855     $reconstruct_active_formatting_elements->($insert_to_current);
3856    
3857    
3858     {
3859     my $el;
3860    
3861     $el = $self->{document}->create_element_ns
3862     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3863    
3864     for my $attr_name (keys %{ $token->{attributes}}) {
3865     $el->set_attribute_ns (undef, [undef, $attr_name],
3866     $token->{attributes} ->{$attr_name}->{value});
3867     }
3868    
3869     $insert->($el);
3870 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3871 wakaba 1.1 }
3872    
3873     push @$active_formatting_elements, ['#marker', ''];
3874    
3875     $token = $self->_get_next_token;
3876     return;
3877     } elsif ($token->{tag_name} eq 'marquee' or
3878     $token->{tag_name} eq 'object') {
3879     $reconstruct_active_formatting_elements->($insert_to_current);
3880    
3881    
3882     {
3883     my $el;
3884    
3885     $el = $self->{document}->create_element_ns
3886     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3887    
3888     for my $attr_name (keys %{ $token->{attributes}}) {
3889     $el->set_attribute_ns (undef, [undef, $attr_name],
3890     $token->{attributes} ->{$attr_name}->{value});
3891     }
3892    
3893     $insert->($el);
3894 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3895 wakaba 1.1 }
3896    
3897     push @$active_formatting_elements, ['#marker', ''];
3898    
3899     $token = $self->_get_next_token;
3900     return;
3901     } elsif ($token->{tag_name} eq 'xmp') {
3902     $reconstruct_active_formatting_elements->($insert_to_current);
3903 wakaba 1.25 $parse_rcdata->('CDATA', $insert);
3904 wakaba 1.1 return;
3905     } elsif ($token->{tag_name} eq 'table') {
3906     ## has a p element in scope
3907 wakaba 1.3 INSCOPE: for (reverse @{$self->{open_elements}}) {
3908 wakaba 1.1 if ($_->[1] eq 'p') {
3909     unshift @{$self->{token}}, $token;
3910     $token = {type => 'end tag', tag_name => 'p'};
3911     return;
3912     } elsif ({
3913     table => 1, caption => 1, td => 1, th => 1,
3914     button => 1, marquee => 1, object => 1, html => 1,
3915     }->{$_->[1]}) {
3916     last INSCOPE;
3917     }
3918     } # INSCOPE
3919    
3920    
3921     {
3922     my $el;
3923    
3924     $el = $self->{document}->create_element_ns
3925     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3926    
3927     for my $attr_name (keys %{ $token->{attributes}}) {
3928     $el->set_attribute_ns (undef, [undef, $attr_name],
3929     $token->{attributes} ->{$attr_name}->{value});
3930     }
3931    
3932     $insert->($el);
3933 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3934 wakaba 1.1 }
3935    
3936    
3937 wakaba 1.3 $self->{insertion_mode} = 'in table';
3938 wakaba 1.1
3939     $token = $self->_get_next_token;
3940     return;
3941     } elsif ({
3942     area => 1, basefont => 1, bgsound => 1, br => 1,
3943     embed => 1, img => 1, param => 1, spacer => 1, wbr => 1,
3944     image => 1,
3945     }->{$token->{tag_name}}) {
3946     if ($token->{tag_name} eq 'image') {
3947 wakaba 1.3 $self->{parse_error}-> (type => 'image');
3948 wakaba 1.1 $token->{tag_name} = 'img';
3949     }
3950 wakaba 1.31
3951     ## NOTE: There is an "as if <br>" code clone.
3952 wakaba 1.1 $reconstruct_active_formatting_elements->($insert_to_current);
3953    
3954    
3955     {
3956     my $el;
3957    
3958     $el = $self->{document}->create_element_ns
3959     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3960    
3961     for my $attr_name (keys %{ $token->{attributes}}) {
3962     $el->set_attribute_ns (undef, [undef, $attr_name],
3963     $token->{attributes} ->{$attr_name}->{value});
3964     }
3965    
3966     $insert->($el);
3967 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
3968 wakaba 1.1 }
3969    
3970 wakaba 1.3 pop @{$self->{open_elements}};
3971 wakaba 1.1
3972     $token = $self->_get_next_token;
3973     return;
3974     } elsif ($token->{tag_name} eq 'hr') {
3975     ## has a p element in scope
3976 wakaba 1.3 INSCOPE: for (reverse @{$self->{open_elements}}) {
3977 wakaba 1.1 if ($_->[1] eq 'p') {
3978     unshift @{$self->{token}}, $token;
3979     $token = {type => 'end tag', tag_name => 'p'};
3980     return;
3981     } elsif ({
3982     table => 1, caption => 1, td => 1, th => 1,
3983     button => 1, marquee => 1, object => 1, html => 1,
3984     }->{$_->[1]}) {
3985     last INSCOPE;
3986     }
3987     } # INSCOPE
3988    
3989    
3990     {
3991     my $el;
3992    
3993     $el = $self->{document}->create_element_ns
3994     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
3995    
3996     for my $attr_name (keys %{ $token->{attributes}}) {
3997     $el->set_attribute_ns (undef, [undef, $attr_name],
3998     $token->{attributes} ->{$attr_name}->{value});
3999     }
4000    
4001     $insert->($el);
4002 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
4003 wakaba 1.1 }
4004    
4005 wakaba 1.3 pop @{$self->{open_elements}};
4006 wakaba 1.1
4007     $token = $self->_get_next_token;
4008     return;
4009     } elsif ($token->{tag_name} eq 'input') {
4010     $reconstruct_active_formatting_elements->($insert_to_current);
4011    
4012    
4013     {
4014     my $el;
4015    
4016     $el = $self->{document}->create_element_ns
4017     (q<http://www.w3.org/1999/xhtml>, [undef, $token->{tag_name}]);
4018    
4019     for my $attr_name (keys %{ $token->{attributes}}) {
4020     $el->set_attribute_ns (undef, [undef, $attr_name],
4021     $token->{attributes} ->{$attr_name}->{value});
4022     }
4023    
4024     $insert->($el);
4025 wakaba 1.3 push @{$self->{open_elements}}, [$el, $token->{tag_name}];
4026 wakaba 1.1 }
4027    
4028 wakaba 1.3 ## TODO: associate with $self->{form_element} if defined
4029     pop @{$self->{open_elements}};
4030 wakaba 1.1
4031     $token = $self->_get_next_token;
4032     return;
4033     } elsif ($token->{tag_name} eq 'isindex') {
4034 wakaba 1.3 $self->{parse_error}-> (type => 'isindex');
4035 wakaba 1.1
4036 wakaba 1.3 if (defined $self->{form_element}) {
4037 wakaba 1.1 ## Ignore the token
4038     $token = $self->_get_next_token;
4039     return;
4040     } else {
4041     my $at = $token->{attributes};
4042 wakaba 1.22 my $form_attrs;
4043