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

Diff of /markup/html/whatpm/Whatpm/HTML.pm.src

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by wakaba, Tue May 1 10:47:37 2007 UTC revision 1.27 by wakaba, Sun Jun 24 14:24:21 2007 UTC
# Line 2  package Whatpm::HTML; Line 2  package Whatpm::HTML;
2  use strict;  use strict;
3  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4    
5  ## This is an early version of an HTML parser.  ## ISSUE:
6    ## var doc = implementation.createDocument (null, null, null);
7    ## doc.write ('');
8    ## alert (doc.compatMode);
9    
10  my $permitted_slash_tag_name = {  my $permitted_slash_tag_name = {
11    base => 1,    base => 1,
# Line 18  my $permitted_slash_tag_name = { Line 21  my $permitted_slash_tag_name = {
21    input => 1,    input => 1,
22  };  };
23    
24  my $entity_char = {  my $c1_entity_char = {
25    AElig => "\x{00C6}",    0x80 => 0x20AC,
26    Aacute => "\x{00C1}",    0x81 => 0xFFFD,
27    Acirc => "\x{00C2}",    0x82 => 0x201A,
28    Agrave => "\x{00C0}",    0x83 => 0x0192,
29    Alpha => "\x{0391}",    0x84 => 0x201E,
30    Aring => "\x{00C5}",    0x85 => 0x2026,
31    Atilde => "\x{00C3}",    0x86 => 0x2020,
32    Auml => "\x{00C4}",    0x87 => 0x2021,
33    Beta => "\x{0392}",    0x88 => 0x02C6,
34    Ccedil => "\x{00C7}",    0x89 => 0x2030,
35    Chi => "\x{03A7}",    0x8A => 0x0160,
36    Dagger => "\x{2021}",    0x8B => 0x2039,
37    Delta => "\x{0394}",    0x8C => 0x0152,
38    ETH => "\x{00D0}",    0x8D => 0xFFFD,
39    Eacute => "\x{00C9}",    0x8E => 0x017D,
40    Ecirc => "\x{00CA}",    0x8F => 0xFFFD,
41    Egrave => "\x{00C8}",    0x90 => 0xFFFD,
42    Epsilon => "\x{0395}",    0x91 => 0x2018,
43    Eta => "\x{0397}",    0x92 => 0x2019,
44    Euml => "\x{00CB}",    0x93 => 0x201C,
45    Gamma => "\x{0393}",    0x94 => 0x201D,
46    Iacute => "\x{00CD}",    0x95 => 0x2022,
47    Icirc => "\x{00CE}",    0x96 => 0x2013,
48    Igrave => "\x{00CC}",    0x97 => 0x2014,
49    Iota => "\x{0399}",    0x98 => 0x02DC,
50    Iuml => "\x{00CF}",    0x99 => 0x2122,
51    Kappa => "\x{039A}",    0x9A => 0x0161,
52    Lambda => "\x{039B}",    0x9B => 0x203A,
53    Mu => "\x{039C}",    0x9C => 0x0153,
54    Ntilde => "\x{00D1}",    0x9D => 0xFFFD,
55    Nu => "\x{039D}",    0x9E => 0x017E,
56    OElig => "\x{0152}",    0x9F => 0x0178,
57    Oacute => "\x{00D3}",  }; # $c1_entity_char
   Ocirc => "\x{00D4}",  
   Ograve => "\x{00D2}",  
   Omega => "\x{03A9}",  
   Omicron => "\x{039F}",  
   Oslash => "\x{00D8}",  
   Otilde => "\x{00D5}",  
   Ouml => "\x{00D6}",  
   Phi => "\x{03A6}",  
   Pi => "\x{03A0}",  
   Prime => "\x{2033}",  
   Psi => "\x{03A8}",  
   Rho => "\x{03A1}",  
   Scaron => "\x{0160}",  
   Sigma => "\x{03A3}",  
   THORN => "\x{00DE}",  
   Tau => "\x{03A4}",  
   Theta => "\x{0398}",  
   Uacute => "\x{00DA}",  
   Ucirc => "\x{00DB}",  
   Ugrave => "\x{00D9}",  
   Upsilon => "\x{03A5}",  
   Uuml => "\x{00DC}",  
   Xi => "\x{039E}",  
   Yacute => "\x{00DD}",  
   Yuml => "\x{0178}",  
   Zeta => "\x{0396}",  
   aacute => "\x{00E1}",  
   acirc => "\x{00E2}",  
   acute => "\x{00B4}",  
   aelig => "\x{00E6}",  
   agrave => "\x{00E0}",  
   alefsym => "\x{2135}",  
   alpha => "\x{03B1}",  
   amp => "\x{0026}",  
   AMP => "\x{0026}",  
   and => "\x{2227}",  
   ang => "\x{2220}",  
   apos => "\x{0027}",  
   aring => "\x{00E5}",  
   asymp => "\x{2248}",  
   atilde => "\x{00E3}",  
   auml => "\x{00E4}",  
   bdquo => "\x{201E}",  
   beta => "\x{03B2}",  
   brvbar => "\x{00A6}",  
   bull => "\x{2022}",  
   cap => "\x{2229}",  
   ccedil => "\x{00E7}",  
   cedil => "\x{00B8}",  
   cent => "\x{00A2}",  
   chi => "\x{03C7}",  
   circ => "\x{02C6}",  
   clubs => "\x{2663}",  
   cong => "\x{2245}",  
   copy => "\x{00A9}",  
   COPY => "\x{00A9}",  
   crarr => "\x{21B5}",  
   cup => "\x{222A}",  
   curren => "\x{00A4}",  
   dArr => "\x{21D3}",  
   dagger => "\x{2020}",  
   darr => "\x{2193}",  
   deg => "\x{00B0}",  
   delta => "\x{03B4}",  
   diams => "\x{2666}",  
   divide => "\x{00F7}",  
   eacute => "\x{00E9}",  
   ecirc => "\x{00EA}",  
   egrave => "\x{00E8}",  
   empty => "\x{2205}",  
   emsp => "\x{2003}",  
   ensp => "\x{2002}",  
   epsilon => "\x{03B5}",  
   equiv => "\x{2261}",  
   eta => "\x{03B7}",  
   eth => "\x{00F0}",  
   euml => "\x{00EB}",  
   euro => "\x{20AC}",  
   exist => "\x{2203}",  
   fnof => "\x{0192}",  
   forall => "\x{2200}",  
   frac12 => "\x{00BD}",  
   frac14 => "\x{00BC}",  
   frac34 => "\x{00BE}",  
   frasl => "\x{2044}",  
   gamma => "\x{03B3}",  
   ge => "\x{2265}",  
   gt => "\x{003E}",  
   GT => "\x{003E}",  
   hArr => "\x{21D4}",  
   harr => "\x{2194}",  
   hearts => "\x{2665}",  
   hellip => "\x{2026}",  
   iacute => "\x{00ED}",  
   icirc => "\x{00EE}",  
   iexcl => "\x{00A1}",  
   igrave => "\x{00EC}",  
   image => "\x{2111}",  
   infin => "\x{221E}",  
   int => "\x{222B}",  
   iota => "\x{03B9}",  
   iquest => "\x{00BF}",  
   isin => "\x{2208}",  
   iuml => "\x{00EF}",  
   kappa => "\x{03BA}",  
   lArr => "\x{21D0}",  
   lambda => "\x{03BB}",  
   lang => "\x{2329}",  
   laquo => "\x{00AB}",  
   larr => "\x{2190}",  
   lceil => "\x{2308}",  
   ldquo => "\x{201C}",  
   le => "\x{2264}",  
   lfloor => "\x{230A}",  
   lowast => "\x{2217}",  
   loz => "\x{25CA}",  
   lrm => "\x{200E}",  
   lsaquo => "\x{2039}",  
   lsquo => "\x{2018}",  
   lt => "\x{003C}",  
   LT => "\x{003C}",  
   macr => "\x{00AF}",  
   mdash => "\x{2014}",  
   micro => "\x{00B5}",  
   middot => "\x{00B7}",  
   minus => "\x{2212}",  
   mu => "\x{03BC}",  
   nabla => "\x{2207}",  
   nbsp => "\x{00A0}",  
   ndash => "\x{2013}",  
   ne => "\x{2260}",  
   ni => "\x{220B}",  
   not => "\x{00AC}",  
   notin => "\x{2209}",  
   nsub => "\x{2284}",  
   ntilde => "\x{00F1}",  
   nu => "\x{03BD}",  
   oacute => "\x{00F3}",  
   ocirc => "\x{00F4}",  
   oelig => "\x{0153}",  
   ograve => "\x{00F2}",  
   oline => "\x{203E}",  
   omega => "\x{03C9}",  
   omicron => "\x{03BF}",  
   oplus => "\x{2295}",  
   or => "\x{2228}",  
   ordf => "\x{00AA}",  
   ordm => "\x{00BA}",  
   oslash => "\x{00F8}",  
   otilde => "\x{00F5}",  
   otimes => "\x{2297}",  
   ouml => "\x{00F6}",  
   para => "\x{00B6}",  
   part => "\x{2202}",  
   permil => "\x{2030}",  
   perp => "\x{22A5}",  
   phi => "\x{03C6}",  
   pi => "\x{03C0}",  
   piv => "\x{03D6}",  
   plusmn => "\x{00B1}",  
   pound => "\x{00A3}",  
   prime => "\x{2032}",  
   prod => "\x{220F}",  
   prop => "\x{221D}",  
   psi => "\x{03C8}",  
   quot => "\x{0022}",  
   QUOT => "\x{0022}",  
   rArr => "\x{21D2}",  
   radic => "\x{221A}",  
   rang => "\x{232A}",  
   raquo => "\x{00BB}",  
   rarr => "\x{2192}",  
   rceil => "\x{2309}",  
   rdquo => "\x{201D}",  
   real => "\x{211C}",  
   reg => "\x{00AE}",  
   REG => "\x{00AE}",  
   rfloor => "\x{230B}",  
   rho => "\x{03C1}",  
   rlm => "\x{200F}",  
   rsaquo => "\x{203A}",  
   rsquo => "\x{2019}",  
   sbquo => "\x{201A}",  
   scaron => "\x{0161}",  
   sdot => "\x{22C5}",  
   sect => "\x{00A7}",  
   shy => "\x{00AD}",  
   sigma => "\x{03C3}",  
   sigmaf => "\x{03C2}",  
   sim => "\x{223C}",  
   spades => "\x{2660}",  
   sub => "\x{2282}",  
   sube => "\x{2286}",  
   sum => "\x{2211}",  
   sup => "\x{2283}",  
   sup1 => "\x{00B9}",  
   sup2 => "\x{00B2}",  
   sup3 => "\x{00B3}",  
   supe => "\x{2287}",  
   szlig => "\x{00DF}",  
   tau => "\x{03C4}",  
   there4 => "\x{2234}",  
   theta => "\x{03B8}",  
   thetasym => "\x{03D1}",  
   thinsp => "\x{2009}",  
   thorn => "\x{00FE}",  
   tilde => "\x{02DC}",  
   times => "\x{00D7}",  
   trade => "\x{2122}",  
   uArr => "\x{21D1}",  
   uacute => "\x{00FA}",  
   uarr => "\x{2191}",  
   ucirc => "\x{00FB}",  
   ugrave => "\x{00F9}",  
   uml => "\x{00A8}",  
   upsih => "\x{03D2}",  
   upsilon => "\x{03C5}",  
   uuml => "\x{00FC}",  
   weierp => "\x{2118}",  
   xi => "\x{03BE}",  
   yacute => "\x{00FD}",  
   yen => "\x{00A5}",  
   yuml => "\x{00FF}",  
   zeta => "\x{03B6}",  
   zwj => "\x{200D}",  
   zwnj => "\x{200C}",  
 };  
58    
59  my $special_category = {  my $special_category = {
60    address => 1, area => 1, base => 1, basefont => 1, bgsound => 1,    address => 1, area => 1, base => 1, basefont => 1, bgsound => 1,
# Line 307  sub parse_string ($$$;$) { Line 83  sub parse_string ($$$;$) {
83    my $s = \$_[0];    my $s = \$_[0];
84    $self->{document} = $_[1];    $self->{document} = $_[1];
85    
86    my $i;    ## NOTE: |set_inner_html| copies most of this method's code
87    
88    my $i = 0;    my $i = 0;
89      my $line = 1;
90      my $column = 0;
91    $self->{set_next_input_character} = sub {    $self->{set_next_input_character} = sub {
92      my $self = shift;      my $self = shift;
93    
94        pop @{$self->{prev_input_character}};
95        unshift @{$self->{prev_input_character}}, $self->{next_input_character};
96    
97      $self->{next_input_character} = -1 and return if $i >= length $$s;      $self->{next_input_character} = -1 and return if $i >= length $$s;
98      $self->{next_input_character} = ord substr $$s, $i++, 1;      $self->{next_input_character} = ord substr $$s, $i++, 1;
99        $column++;
100            
101      if ($self->{next_input_character} == 0x000D) { # CR      if ($self->{next_input_character} == 0x000A) { # LF
102        if ($i >= length $$s) {        $line++;
103          #        $column = 0;
104        } else {      } elsif ($self->{next_input_character} == 0x000D) { # CR
105          my $next_char = ord substr $$s, $i++, 1;        $i++ if substr ($$s, $i, 1) eq "\x0A";
         if ($next_char == 0x000A) { # LF  
           #  
         } else {  
           push @{$self->{char}}, $next_char;  
         }  
       }  
106        $self->{next_input_character} = 0x000A; # LF # MUST        $self->{next_input_character} = 0x000A; # LF # MUST
107          $line++;
108          $column = 0;
109      } elsif ($self->{next_input_character} > 0x10FFFF) {      } elsif ($self->{next_input_character} > 0x10FFFF) {
110        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
111      } elsif ($self->{next_input_character} == 0x0000) { # NULL      } elsif ($self->{next_input_character} == 0x0000) { # NULL
112          !!!parse-error (type => 'NULL');
113        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
114      }      }
115    };    };
116      $self->{prev_input_character} = [-1, -1, -1];
117      $self->{next_input_character} = -1;
118    
119    $self->{parse_error} = $_[2] || sub {    my $onerror = $_[2] || sub {
120      warn "Parse error at character $i\n"; ## TODO: Report (line, column) pair      my (%opt) = @_;
121        warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n";
122      };
123      $self->{parse_error} = sub {
124        $onerror->(@_, line => $line, column => $column);
125    };    };
126    
127    $self->_initialize_tokenizer;    $self->_initialize_tokenizer;
# Line 371  sub _initialize_tokenizer ($) { Line 158  sub _initialize_tokenizer ($) {
158    # $self->{next_input_character}    # $self->{next_input_character}
159    !!!next-input-character;    !!!next-input-character;
160    $self->{token} = [];    $self->{token} = [];
161      # $self->{escape}
162  } # _initialize_tokenizer  } # _initialize_tokenizer
163    
164  ## A token has:  ## A token has:
165  ##   ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',  ##   ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',
166  ##       'character', or 'end-of-file'  ##       'character', or 'end-of-file'
167  ##   ->{name} (DOCTYPE, start tag (tagname), end tag (tagname))  ##   ->{name} (DOCTYPE, start tag (tag name), end tag (tag name))
168      ## ISSUE: the spec need s/tagname/tag name/  ##   ->{public_identifier} (DOCTYPE)
169  ##   ->{error} == 1 or 0 (DOCTYPE)  ##   ->{system_identifier} (DOCTYPE)
170    ##   ->{correct} == 1 or 0 (DOCTYPE)
171  ##   ->{attributes} isa HASH (start tag, end tag)  ##   ->{attributes} isa HASH (start tag, end tag)
172  ##   ->{data} (comment, character)  ##   ->{data} (comment, character)
173    
 ## Macros  
 ##   Macros MUST be preceded by three EXCLAMATION MARKs.  
 ##   emit ($token)  
 ##     Emits the specified token.  
   
174  ## Emitted token MUST immediately be handled by the tree construction state.  ## Emitted token MUST immediately be handled by the tree construction state.
175    
176  ## Before each step, UA MAY check to see if either one of the scripts in  ## Before each step, UA MAY check to see if either one of the scripts in
# Line 412  sub _get_next_token ($) { Line 196  sub _get_next_token ($) {
196          } else {          } else {
197            #            #
198          }          }
199          } elsif ($self->{next_input_character} == 0x002D) { # -
200            if ($self->{content_model_flag} eq 'RCDATA' or
201                $self->{content_model_flag} eq 'CDATA') {
202              unless ($self->{escape}) {
203                if ($self->{prev_input_character}->[0] == 0x002D and # -
204                    $self->{prev_input_character}->[1] == 0x0021 and # !
205                    $self->{prev_input_character}->[2] == 0x003C) { # <
206                  $self->{escape} = 1;
207                }
208              }
209            }
210            
211            #
212        } elsif ($self->{next_input_character} == 0x003C) { # <        } elsif ($self->{next_input_character} == 0x003C) { # <
213          if ($self->{content_model_flag} ne 'PLAINTEXT') {          if ($self->{content_model_flag} eq 'PCDATA' or
214                (($self->{content_model_flag} eq 'CDATA' or
215                  $self->{content_model_flag} eq 'RCDATA') and
216                 not $self->{escape})) {
217            $self->{state} = 'tag open';            $self->{state} = 'tag open';
218            !!!next-input-character;            !!!next-input-character;
219            redo A;            redo A;
220          } else {          } else {
221            #            #
222          }          }
223          } elsif ($self->{next_input_character} == 0x003E) { # >
224            if ($self->{escape} and
225                ($self->{content_model_flag} eq 'RCDATA' or
226                 $self->{content_model_flag} eq 'CDATA')) {
227              if ($self->{prev_input_character}->[0] == 0x002D and # -
228                  $self->{prev_input_character}->[1] == 0x002D) { # -
229                delete $self->{escape};
230              }
231            }
232            
233            #
234        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
235          !!!emit ({type => 'end-of-file'});          !!!emit ({type => 'end-of-file'});
236          last A; ## TODO: ok?          last A; ## TODO: ok?
# Line 436  sub _get_next_token ($) { Line 247  sub _get_next_token ($) {
247      } elsif ($self->{state} eq 'entity data') {      } elsif ($self->{state} eq 'entity data') {
248        ## (cannot happen in CDATA state)        ## (cannot happen in CDATA state)
249                
250        my $token = $self->_tokenize_attempt_to_consume_an_entity;        my $token = $self->_tokenize_attempt_to_consume_an_entity (0);
251    
252        $self->{state} = 'data';        $self->{state} = 'data';
253        # next-input-character is already done        # next-input-character is already done
# Line 488  sub _get_next_token ($) { Line 299  sub _get_next_token ($) {
299            !!!next-input-character;            !!!next-input-character;
300            redo A;            redo A;
301          } elsif ($self->{next_input_character} == 0x003E) { # >          } elsif ($self->{next_input_character} == 0x003E) { # >
302            !!!parse-error;            !!!parse-error (type => 'empty start tag');
303            $self->{state} = 'data';            $self->{state} = 'data';
304            !!!next-input-character;            !!!next-input-character;
305    
# Line 496  sub _get_next_token ($) { Line 307  sub _get_next_token ($) {
307    
308            redo A;            redo A;
309          } elsif ($self->{next_input_character} == 0x003F) { # ?          } elsif ($self->{next_input_character} == 0x003F) { # ?
310            !!!parse-error;            !!!parse-error (type => 'pio');
311            $self->{state} = 'bogus comment';            $self->{state} = 'bogus comment';
312            ## $self->{next_input_character} is intentionally left as is            ## $self->{next_input_character} is intentionally left as is
313            redo A;            redo A;
314          } else {          } else {
315            !!!parse-error;            !!!parse-error (type => 'bare stago');
316            $self->{state} = 'data';            $self->{state} = 'data';
317            ## reconsume            ## reconsume
318    
# Line 515  sub _get_next_token ($) { Line 326  sub _get_next_token ($) {
326      } elsif ($self->{state} eq 'close tag open') {      } elsif ($self->{state} eq 'close tag open') {
327        if ($self->{content_model_flag} eq 'RCDATA' or        if ($self->{content_model_flag} eq 'RCDATA' or
328            $self->{content_model_flag} eq 'CDATA') {            $self->{content_model_flag} eq 'CDATA') {
329          my @next_char;          if (defined $self->{last_emitted_start_tag_name}) {
330          TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {            my @next_char;
331              TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {
332                push @next_char, $self->{next_input_character};
333                my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);
334                my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;
335                if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {
336                  !!!next-input-character;
337                  next TAGNAME;
338                } else {
339                  $self->{next_input_character} = shift @next_char; # reconsume
340                  !!!back-next-input-character (@next_char);
341                  $self->{state} = 'data';
342    
343                  !!!emit ({type => 'character', data => '</'});
344      
345                  redo A;
346                }
347              }
348            push @next_char, $self->{next_input_character};            push @next_char, $self->{next_input_character};
349            my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);        
350            my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;            unless ($self->{next_input_character} == 0x0009 or # HT
351            if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {                    $self->{next_input_character} == 0x000A or # LF
352              !!!next-input-character;                    $self->{next_input_character} == 0x000B or # VT
353              next TAGNAME;                    $self->{next_input_character} == 0x000C or # FF
354            } else {                    $self->{next_input_character} == 0x0020 or # SP
355              !!!parse-error;                    $self->{next_input_character} == 0x003E or # >
356                      $self->{next_input_character} == 0x002F or # /
357                      $self->{next_input_character} == -1) {
358              $self->{next_input_character} = shift @next_char; # reconsume              $self->{next_input_character} = shift @next_char; # reconsume
359              !!!back-next-input-character (@next_char);              !!!back-next-input-character (@next_char);
360              $self->{state} = 'data';              $self->{state} = 'data';
   
361              !!!emit ({type => 'character', data => '</'});              !!!emit ({type => 'character', data => '</'});
   
362              redo A;              redo A;
363              } else {
364                $self->{next_input_character} = shift @next_char;
365                !!!back-next-input-character (@next_char);
366                # and consume...
367            }            }
368          }          } else {
369          push @next_char, $self->{next_input_character};            ## No start tag token has ever been emitted
370                  # next-input-character is already done
         unless ($self->{next_input_character} == 0x0009 or # HT  
                 $self->{next_input_character} == 0x000A or # LF  
                 $self->{next_input_character} == 0x000B or # VT  
                 $self->{next_input_character} == 0x000C or # FF  
                 $self->{next_input_character} == 0x0020 or # SP  
                 $self->{next_input_character} == 0x003E or # >  
                 $self->{next_input_character} == 0x002F or # /  
                 $self->{next_input_character} == 0x003C or # <  
                 $self->{next_input_character} == -1) {  
           !!!parse-error;  
           $self->{next_input_character} = shift @next_char; # reconsume  
           !!!back-next-input-character (@next_char);  
371            $self->{state} = 'data';            $self->{state} = 'data';
   
372            !!!emit ({type => 'character', data => '</'});            !!!emit ({type => 'character', data => '</'});
   
373            redo A;            redo A;
         } else {  
           $self->{next_input_character} = shift @next_char;  
           !!!back-next-input-character (@next_char);  
           # and consume...  
374          }          }
375        }        }
376                
# Line 575  sub _get_next_token ($) { Line 389  sub _get_next_token ($) {
389          !!!next-input-character;          !!!next-input-character;
390          redo A;          redo A;
391        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
392          !!!parse-error;          !!!parse-error (type => 'empty end tag');
393          $self->{state} = 'data';          $self->{state} = 'data';
394          !!!next-input-character;          !!!next-input-character;
395          redo A;          redo A;
396        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
397          !!!parse-error;          !!!parse-error (type => 'bare etago');
398          $self->{state} = 'data';          $self->{state} = 'data';
399          # reconsume          # reconsume
400    
# Line 588  sub _get_next_token ($) { Line 402  sub _get_next_token ($) {
402    
403          redo A;          redo A;
404        } else {        } else {
405          !!!parse-error;          !!!parse-error (type => 'bogus end tag');
406          $self->{state} = 'bogus comment';          $self->{state} = 'bogus comment';
407          ## $self->{next_input_character} is intentionally left as is          ## $self->{next_input_character} is intentionally left as is
408          redo A;          redo A;
# Line 608  sub _get_next_token ($) { Line 422  sub _get_next_token ($) {
422          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
423            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
424            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
425              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
426            }            }
427          } else {          } else {
428            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 617  sub _get_next_token ($) { Line 431  sub _get_next_token ($) {
431          !!!next-input-character;          !!!next-input-character;
432    
433          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
434    
435          redo A;          redo A;
436        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 627  sub _get_next_token ($) { Line 440  sub _get_next_token ($) {
440          ## Stay in this state          ## Stay in this state
441          !!!next-input-character;          !!!next-input-character;
442          redo A;          redo A;
443        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
444                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
445          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
446            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
447          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
448            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
449            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
450              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
451            }            }
452          } else {          } else {
453            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 644  sub _get_next_token ($) { Line 456  sub _get_next_token ($) {
456          # reconsume          # reconsume
457    
458          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
459    
460          redo A;          redo A;
461        } elsif ($self->{next_input_character} == 0x002F) { # /        } elsif ($self->{next_input_character} == 0x002F) { # /
# Line 655  sub _get_next_token ($) { Line 466  sub _get_next_token ($) {
466            # permitted slash            # permitted slash
467            #            #
468          } else {          } else {
469            !!!parse-error;            !!!parse-error (type => 'nestc');
470          }          }
471          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
472          # next-input-character is already done          # next-input-character is already done
# Line 682  sub _get_next_token ($) { Line 493  sub _get_next_token ($) {
493          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
494            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
495            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
496              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
497            }            }
498          } else {          } else {
499            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 691  sub _get_next_token ($) { Line 502  sub _get_next_token ($) {
502          !!!next-input-character;          !!!next-input-character;
503    
504          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
505    
506          redo A;          redo A;
507        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 709  sub _get_next_token ($) { Line 519  sub _get_next_token ($) {
519            # permitted slash            # permitted slash
520            #            #
521          } else {          } else {
522            !!!parse-error;            !!!parse-error (type => 'nestc');
523          }          }
524          ## Stay in the state          ## Stay in the state
525          # next-input-character is already done          # next-input-character is already done
526          redo A;          redo A;
527        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
528                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
529          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
530            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
531          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
532            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
533            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
534              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
535            }            }
536          } else {          } else {
537            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 731  sub _get_next_token ($) { Line 540  sub _get_next_token ($) {
540          # reconsume          # reconsume
541    
542          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
543    
544          redo A;          redo A;
545        } else {        } else {
# Line 745  sub _get_next_token ($) { Line 553  sub _get_next_token ($) {
553        my $before_leave = sub {        my $before_leave = sub {
554          if (exists $self->{current_token}->{attributes} # start tag or end tag          if (exists $self->{current_token}->{attributes} # start tag or end tag
555              ->{$self->{current_attribute}->{name}}) { # MUST              ->{$self->{current_attribute}->{name}}) { # MUST
556            !!!parse-error;            !!!parse-error (type => 'dupulicate attribute');
557            ## Discard $self->{current_attribute} # MUST            ## Discard $self->{current_attribute} # MUST
558          } else {          } else {
559            $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}}            $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}}
# Line 774  sub _get_next_token ($) { Line 582  sub _get_next_token ($) {
582          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
583            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
584            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
585              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
586            }            }
587          } else {          } else {
588            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 783  sub _get_next_token ($) { Line 591  sub _get_next_token ($) {
591          !!!next-input-character;          !!!next-input-character;
592    
593          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
594    
595          redo A;          redo A;
596        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 801  sub _get_next_token ($) { Line 608  sub _get_next_token ($) {
608            # permitted slash            # permitted slash
609            #            #
610          } else {          } else {
611            !!!parse-error;            !!!parse-error (type => 'nestc');
612          }          }
613          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
614          # next-input-character is already done          # next-input-character is already done
615          redo A;          redo A;
616        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
617                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
618          $before_leave->();          $before_leave->();
619          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
620            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
621          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
622            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
623            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
624              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
625            }            }
626          } else {          } else {
627            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 824  sub _get_next_token ($) { Line 630  sub _get_next_token ($) {
630          # reconsume          # reconsume
631    
632          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
633    
634          redo A;          redo A;
635        } else {        } else {
# Line 852  sub _get_next_token ($) { Line 657  sub _get_next_token ($) {
657          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
658            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
659            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
660              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
661            }            }
662          } else {          } else {
663            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 861  sub _get_next_token ($) { Line 666  sub _get_next_token ($) {
666          !!!next-input-character;          !!!next-input-character;
667    
668          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
669    
670          redo A;          redo A;
671        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 879  sub _get_next_token ($) { Line 683  sub _get_next_token ($) {
683            # permitted slash            # permitted slash
684            #            #
685          } else {          } else {
686            !!!parse-error;            !!!parse-error (type => 'nestc');
687          }          }
688          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
689          # next-input-character is already done          # next-input-character is already done
690          redo A;          redo A;
691        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
692                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
693          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
694            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
695          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
696            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
697            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
698              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
699            }            }
700          } else {          } else {
701            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 901  sub _get_next_token ($) { Line 704  sub _get_next_token ($) {
704          # reconsume          # reconsume
705    
706          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
707    
708          redo A;          redo A;
709        } else {        } else {
# Line 938  sub _get_next_token ($) { Line 740  sub _get_next_token ($) {
740          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
741            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
742            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
743              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
744            }            }
745          } else {          } else {
746            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 947  sub _get_next_token ($) { Line 749  sub _get_next_token ($) {
749          !!!next-input-character;          !!!next-input-character;
750    
751          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
752    
753          redo A;          redo A;
754        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
755                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
756          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
757            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
758          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
759            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
760            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
761              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
762            }            }
763          } else {          } else {
764            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 967  sub _get_next_token ($) { Line 767  sub _get_next_token ($) {
767          ## reconsume          ## reconsume
768    
769          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
770    
771          redo A;          redo A;
772        } else {        } else {
# Line 987  sub _get_next_token ($) { Line 786  sub _get_next_token ($) {
786          !!!next-input-character;          !!!next-input-character;
787          redo A;          redo A;
788        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
789          !!!parse-error;          !!!parse-error (type => 'unclosed attribute value');
790          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
791            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
792          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
793            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
794            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
795              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
796            }            }
797          } else {          } else {
798            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 1002  sub _get_next_token ($) { Line 801  sub _get_next_token ($) {
801          ## reconsume          ## reconsume
802    
803          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
804    
805          redo A;          redo A;
806        } else {        } else {
# Line 1022  sub _get_next_token ($) { Line 820  sub _get_next_token ($) {
820          !!!next-input-character;          !!!next-input-character;
821          redo A;          redo A;
822        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
823          !!!parse-error;          !!!parse-error (type => 'unclosed attribute value');
824          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
825            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
826          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
827            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
828            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
829              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
830            }            }
831          } else {          } else {
832            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 1037  sub _get_next_token ($) { Line 835  sub _get_next_token ($) {
835          ## reconsume          ## reconsume
836    
837          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
838    
839          redo A;          redo A;
840        } else {        } else {
# Line 1066  sub _get_next_token ($) { Line 863  sub _get_next_token ($) {
863          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
864            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
865            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
866              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
867            }            }
868          } else {          } else {
869            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 1075  sub _get_next_token ($) { Line 872  sub _get_next_token ($) {
872          !!!next-input-character;          !!!next-input-character;
873    
874          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
875    
876          redo A;          redo A;
877        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
878                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
879          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
880            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
881          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
882            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
883            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
884              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
885            }            }
886          } else {          } else {
887            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 1095  sub _get_next_token ($) { Line 890  sub _get_next_token ($) {
890          ## reconsume          ## reconsume
891    
892          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
893    
894          redo A;          redo A;
895        } else {        } else {
# Line 1105  sub _get_next_token ($) { Line 899  sub _get_next_token ($) {
899          redo A;          redo A;
900        }        }
901      } elsif ($self->{state} eq 'entity in attribute value') {      } elsif ($self->{state} eq 'entity in attribute value') {
902        my $token = $self->_tokenize_attempt_to_consume_an_entity;        my $token = $self->_tokenize_attempt_to_consume_an_entity (1);
903    
904        unless (defined $token) {        unless (defined $token) {
905          $self->{current_attribute}->{value} .= '&';          $self->{current_attribute}->{value} .= '&';
# Line 1154  sub _get_next_token ($) { Line 948  sub _get_next_token ($) {
948          push @next_char, $self->{next_input_character};          push @next_char, $self->{next_input_character};
949          if ($self->{next_input_character} == 0x002D) { # -          if ($self->{next_input_character} == 0x002D) { # -
950            $self->{current_token} = {type => 'comment', data => ''};            $self->{current_token} = {type => 'comment', data => ''};
951            $self->{state} = 'comment';            $self->{state} = 'comment start';
952            !!!next-input-character;            !!!next-input-character;
953            redo A;            redo A;
954          }          }
# Line 1196  sub _get_next_token ($) { Line 990  sub _get_next_token ($) {
990          }          }
991        }        }
992    
993        !!!parse-error;        !!!parse-error (type => 'bogus comment open');
994        $self->{next_input_character} = shift @next_char;        $self->{next_input_character} = shift @next_char;
995        !!!back-next-input-character (@next_char);        !!!back-next-input-character (@next_char);
996        $self->{state} = 'bogus comment';        $self->{state} = 'bogus comment';
# Line 1204  sub _get_next_token ($) { Line 998  sub _get_next_token ($) {
998                
999        ## ISSUE: typos in spec: chacacters, is is a parse error        ## ISSUE: typos in spec: chacacters, is is a parse error
1000        ## 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?        ## 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?
1001        } elsif ($self->{state} eq 'comment start') {
1002          if ($self->{next_input_character} == 0x002D) { # -
1003            $self->{state} = 'comment start dash';
1004            !!!next-input-character;
1005            redo A;
1006          } elsif ($self->{next_input_character} == 0x003E) { # >
1007            !!!parse-error (type => 'bogus comment');
1008            $self->{state} = 'data';
1009            !!!next-input-character;
1010    
1011            !!!emit ($self->{current_token}); # comment
1012    
1013            redo A;
1014          } elsif ($self->{next_input_character} == -1) {
1015            !!!parse-error (type => 'unclosed comment');
1016            $self->{state} = 'data';
1017            ## reconsume
1018    
1019            !!!emit ($self->{current_token}); # comment
1020    
1021            redo A;
1022          } else {
1023            $self->{current_token}->{data} # comment
1024                .= chr ($self->{next_input_character});
1025            $self->{state} = 'comment';
1026            !!!next-input-character;
1027            redo A;
1028          }
1029        } elsif ($self->{state} eq 'comment start dash') {
1030          if ($self->{next_input_character} == 0x002D) { # -
1031            $self->{state} = 'comment end';
1032            !!!next-input-character;
1033            redo A;
1034          } elsif ($self->{next_input_character} == 0x003E) { # >
1035            !!!parse-error (type => 'bogus comment');
1036            $self->{state} = 'data';
1037            !!!next-input-character;
1038    
1039            !!!emit ($self->{current_token}); # comment
1040    
1041            redo A;
1042          } elsif ($self->{next_input_character} == -1) {
1043            !!!parse-error (type => 'unclosed comment');
1044            $self->{state} = 'data';
1045            ## reconsume
1046    
1047            !!!emit ($self->{current_token}); # comment
1048    
1049            redo A;
1050          } else {
1051            $self->{current_token}->{data} # comment
1052                .= chr ($self->{next_input_character});
1053            $self->{state} = 'comment';
1054            !!!next-input-character;
1055            redo A;
1056          }
1057      } elsif ($self->{state} eq 'comment') {      } elsif ($self->{state} eq 'comment') {
1058        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1059          $self->{state} = 'comment dash';          $self->{state} = 'comment end dash';
1060          !!!next-input-character;          !!!next-input-character;
1061          redo A;          redo A;
1062        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1063          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1064          $self->{state} = 'data';          $self->{state} = 'data';
1065          ## reconsume          ## reconsume
1066    
1067          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1068    
1069          redo A;          redo A;
1070        } else {        } else {
# Line 1224  sub _get_next_token ($) { Line 1073  sub _get_next_token ($) {
1073          !!!next-input-character;          !!!next-input-character;
1074          redo A;          redo A;
1075        }        }
1076      } elsif ($self->{state} eq 'comment dash') {      } elsif ($self->{state} eq 'comment end dash') {
1077        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1078          $self->{state} = 'comment end';          $self->{state} = 'comment end';
1079          !!!next-input-character;          !!!next-input-character;
1080          redo A;          redo A;
1081        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1082          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1083          $self->{state} = 'data';          $self->{state} = 'data';
1084          ## reconsume          ## reconsume
1085    
1086          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1087    
1088          redo A;          redo A;
1089        } else {        } else {
# Line 1250  sub _get_next_token ($) { Line 1098  sub _get_next_token ($) {
1098          !!!next-input-character;          !!!next-input-character;
1099    
1100          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1101    
1102          redo A;          redo A;
1103        } elsif ($self->{next_input_character} == 0x002D) { # -        } elsif ($self->{next_input_character} == 0x002D) { # -
1104          !!!parse-error;          !!!parse-error (type => 'dash in comment');
1105          $self->{current_token}->{data} .= '-'; # comment          $self->{current_token}->{data} .= '-'; # comment
1106          ## Stay in the state          ## Stay in the state
1107          !!!next-input-character;          !!!next-input-character;
1108          redo A;          redo A;
1109        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1110          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1111          $self->{state} = 'data';          $self->{state} = 'data';
1112          ## reconsume          ## reconsume
1113    
1114          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1115    
1116          redo A;          redo A;
1117        } else {        } else {
1118          !!!parse-error;          !!!parse-error (type => 'dash in comment');
1119          $self->{current_token}->{data} .= '--' . chr ($self->{next_input_character}); # comment          $self->{current_token}->{data} .= '--' . chr ($self->{next_input_character}); # comment
1120          $self->{state} = 'comment';          $self->{state} = 'comment';
1121          !!!next-input-character;          !!!next-input-character;
# Line 1285  sub _get_next_token ($) { Line 1131  sub _get_next_token ($) {
1131          !!!next-input-character;          !!!next-input-character;
1132          redo A;          redo A;
1133        } else {        } else {
1134          !!!parse-error;          !!!parse-error (type => 'no space before DOCTYPE name');
1135          $self->{state} = 'before DOCTYPE name';          $self->{state} = 'before DOCTYPE name';
1136          ## reconsume          ## reconsume
1137          redo A;          redo A;
# Line 1299  sub _get_next_token ($) { Line 1145  sub _get_next_token ($) {
1145          ## Stay in the state          ## Stay in the state
1146          !!!next-input-character;          !!!next-input-character;
1147          redo A;          redo A;
       } elsif (0x0061 <= $self->{next_input_character} and  
                $self->{next_input_character} <= 0x007A) { # a..z  
         $self->{current_token} = {type => 'DOCTYPE',  
                           name => chr ($self->{next_input_character} - 0x0020),  
                           error => 1};  
         $self->{state} = 'DOCTYPE name';  
         !!!next-input-character;  
         redo A;  
1148        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
1149          !!!parse-error;          !!!parse-error (type => 'no DOCTYPE name');
1150          $self->{state} = 'data';          $self->{state} = 'data';
1151          !!!next-input-character;          !!!next-input-character;
1152    
1153          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1154    
1155          redo A;          redo A;
1156        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1157          !!!parse-error;          !!!parse-error (type => 'no DOCTYPE name');
1158          $self->{state} = 'data';          $self->{state} = 'data';
1159          ## reconsume          ## reconsume
1160    
1161          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1162    
1163          redo A;          redo A;
1164        } else {        } else {
1165          $self->{current_token} = {type => 'DOCTYPE',          $self->{current_token}
1166                            name => chr ($self->{next_input_character}),              = {type => 'DOCTYPE',
1167                            error => 1};                 name => chr ($self->{next_input_character}),
1168                   correct => 1};
1169    ## ISSUE: "Set the token's name name to the" in the spec
1170          $self->{state} = 'DOCTYPE name';          $self->{state} = 'DOCTYPE name';
1171          !!!next-input-character;          !!!next-input-character;
1172          redo A;          redo A;
1173        }        }
1174      } elsif ($self->{state} eq 'DOCTYPE name') {      } elsif ($self->{state} eq 'DOCTYPE name') {
1175    ## ISSUE: Redundant "First," in the spec.
1176        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1177            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1178            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
1179            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
1180            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1181          $self->{state} = 'after DOCTYPE name';          $self->{state} = 'after DOCTYPE name';
1182          !!!next-input-character;          !!!next-input-character;
1183          redo A;          redo A;
1184        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1185          $self->{state} = 'data';          $self->{state} = 'data';
1186          !!!next-input-character;          !!!next-input-character;
1187    
1188          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1189    
1190          redo A;          redo A;
       } elsif (0x0061 <= $self->{next_input_character} and  
                $self->{next_input_character} <= 0x007A) { # a..z  
         $self->{current_token}->{name} .= chr ($self->{next_input_character} - 0x0020); # DOCTYPE  
         #$self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML');  
         ## Stay in the state  
         !!!next-input-character;  
         redo A;  
1191        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1192          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1193          $self->{state} = 'data';          $self->{state} = 'data';
1194          ## reconsume          ## reconsume
1195    
1196          !!!emit ($self->{current_token});          delete $self->{current_token}->{correct};
1197          undef $self->{current_token};          !!!emit ($self->{current_token}); # DOCTYPE
1198    
1199          redo A;          redo A;
1200        } else {        } else {
1201          $self->{current_token}->{name}          $self->{current_token}->{name}
1202            .= chr ($self->{next_input_character}); # DOCTYPE            .= chr ($self->{next_input_character}); # DOCTYPE
         #$self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML');  
1203          ## Stay in the state          ## Stay in the state
1204          !!!next-input-character;          !!!next-input-character;
1205          redo A;          redo A;
# Line 1389  sub _get_next_token ($) { Line 1218  sub _get_next_token ($) {
1218          !!!next-input-character;          !!!next-input-character;
1219    
1220          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1221    
1222          redo A;          redo A;
1223        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1224          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
1225            $self->{state} = 'data';
1226            ## reconsume
1227    
1228            delete $self->{current_token}->{correct};
1229            !!!emit ($self->{current_token}); # DOCTYPE
1230    
1231            redo A;
1232          } elsif ($self->{next_input_character} == 0x0050 or # P
1233                   $self->{next_input_character} == 0x0070) { # p
1234            !!!next-input-character;
1235            if ($self->{next_input_character} == 0x0055 or # U
1236                $self->{next_input_character} == 0x0075) { # u
1237              !!!next-input-character;
1238              if ($self->{next_input_character} == 0x0042 or # B
1239                  $self->{next_input_character} == 0x0062) { # b
1240                !!!next-input-character;
1241                if ($self->{next_input_character} == 0x004C or # L
1242                    $self->{next_input_character} == 0x006C) { # l
1243                  !!!next-input-character;
1244                  if ($self->{next_input_character} == 0x0049 or # I
1245                      $self->{next_input_character} == 0x0069) { # i
1246                    !!!next-input-character;
1247                    if ($self->{next_input_character} == 0x0043 or # C
1248                        $self->{next_input_character} == 0x0063) { # c
1249                      $self->{state} = 'before DOCTYPE public identifier';
1250                      !!!next-input-character;
1251                      redo A;
1252                    }
1253                  }
1254                }
1255              }
1256            }
1257    
1258            #
1259          } elsif ($self->{next_input_character} == 0x0053 or # S
1260                   $self->{next_input_character} == 0x0073) { # s
1261            !!!next-input-character;
1262            if ($self->{next_input_character} == 0x0059 or # Y
1263                $self->{next_input_character} == 0x0079) { # y
1264              !!!next-input-character;
1265              if ($self->{next_input_character} == 0x0053 or # S
1266                  $self->{next_input_character} == 0x0073) { # s
1267                !!!next-input-character;
1268                if ($self->{next_input_character} == 0x0054 or # T
1269                    $self->{next_input_character} == 0x0074) { # t
1270                  !!!next-input-character;
1271                  if ($self->{next_input_character} == 0x0045 or # E
1272                      $self->{next_input_character} == 0x0065) { # e
1273                    !!!next-input-character;
1274                    if ($self->{next_input_character} == 0x004D or # M
1275                        $self->{next_input_character} == 0x006D) { # m
1276                      $self->{state} = 'before DOCTYPE system identifier';
1277                      !!!next-input-character;
1278                      redo A;
1279                    }
1280                  }
1281                }
1282              }
1283            }
1284    
1285            #
1286          } else {
1287            !!!next-input-character;
1288            #
1289          }
1290    
1291          !!!parse-error (type => 'string after DOCTYPE name');
1292          $self->{state} = 'bogus DOCTYPE';
1293          # next-input-character is already done
1294          redo A;
1295        } elsif ($self->{state} eq 'before DOCTYPE public identifier') {
1296          if ({
1297                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1298                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1299              }->{$self->{next_input_character}}) {
1300            ## Stay in the state
1301            !!!next-input-character;
1302            redo A;
1303          } elsif ($self->{next_input_character} eq 0x0022) { # "
1304            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1305            $self->{state} = 'DOCTYPE public identifier (double-quoted)';
1306            !!!next-input-character;
1307            redo A;
1308          } elsif ($self->{next_input_character} eq 0x0027) { # '
1309            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1310            $self->{state} = 'DOCTYPE public identifier (single-quoted)';
1311            !!!next-input-character;
1312            redo A;
1313          } elsif ($self->{next_input_character} eq 0x003E) { # >
1314            !!!parse-error (type => 'no PUBLIC literal');
1315    
1316            $self->{state} = 'data';
1317            !!!next-input-character;
1318    
1319            delete $self->{current_token}->{correct};
1320            !!!emit ($self->{current_token}); # DOCTYPE
1321    
1322            redo A;
1323          } elsif ($self->{next_input_character} == -1) {
1324            !!!parse-error (type => 'unclosed DOCTYPE');
1325    
1326            $self->{state} = 'data';
1327            ## reconsume
1328    
1329            delete $self->{current_token}->{correct};
1330            !!!emit ($self->{current_token}); # DOCTYPE
1331    
1332            redo A;
1333          } else {
1334            !!!parse-error (type => 'string after PUBLIC');
1335            $self->{state} = 'bogus DOCTYPE';
1336            !!!next-input-character;
1337            redo A;
1338          }
1339        } elsif ($self->{state} eq 'DOCTYPE public identifier (double-quoted)') {
1340          if ($self->{next_input_character} == 0x0022) { # "
1341            $self->{state} = 'after DOCTYPE public identifier';
1342            !!!next-input-character;
1343            redo A;
1344          } elsif ($self->{next_input_character} == -1) {
1345            !!!parse-error (type => 'unclosed PUBLIC literal');
1346    
1347            $self->{state} = 'data';
1348            ## reconsume
1349    
1350            delete $self->{current_token}->{correct};
1351            !!!emit ($self->{current_token}); # DOCTYPE
1352    
1353            redo A;
1354          } else {
1355            $self->{current_token}->{public_identifier} # DOCTYPE
1356                .= chr $self->{next_input_character};
1357            ## Stay in the state
1358            !!!next-input-character;
1359            redo A;
1360          }
1361        } elsif ($self->{state} eq 'DOCTYPE public identifier (single-quoted)') {
1362          if ($self->{next_input_character} == 0x0027) { # '
1363            $self->{state} = 'after DOCTYPE public identifier';
1364            !!!next-input-character;
1365            redo A;
1366          } elsif ($self->{next_input_character} == -1) {
1367            !!!parse-error (type => 'unclosed PUBLIC literal');
1368    
1369            $self->{state} = 'data';
1370            ## reconsume
1371    
1372            delete $self->{current_token}->{correct};
1373            !!!emit ($self->{current_token}); # DOCTYPE
1374    
1375            redo A;
1376          } else {
1377            $self->{current_token}->{public_identifier} # DOCTYPE
1378                .= chr $self->{next_input_character};
1379            ## Stay in the state
1380            !!!next-input-character;
1381            redo A;
1382          }
1383        } elsif ($self->{state} eq 'after DOCTYPE public identifier') {
1384          if ({
1385                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1386                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1387              }->{$self->{next_input_character}}) {
1388            ## Stay in the state
1389            !!!next-input-character;
1390            redo A;
1391          } elsif ($self->{next_input_character} == 0x0022) { # "
1392            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1393            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1394            !!!next-input-character;
1395            redo A;
1396          } elsif ($self->{next_input_character} == 0x0027) { # '
1397            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1398            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1399            !!!next-input-character;
1400            redo A;
1401          } elsif ($self->{next_input_character} == 0x003E) { # >
1402            $self->{state} = 'data';
1403            !!!next-input-character;
1404    
1405            !!!emit ($self->{current_token}); # DOCTYPE
1406    
1407            redo A;
1408          } elsif ($self->{next_input_character} == -1) {
1409            !!!parse-error (type => 'unclosed DOCTYPE');
1410    
1411            $self->{state} = 'data';
1412            ## reconsume
1413    
1414            delete $self->{current_token}->{correct};
1415            !!!emit ($self->{current_token}); # DOCTYPE
1416    
1417            redo A;
1418          } else {
1419            !!!parse-error (type => 'string after PUBLIC literal');
1420            $self->{state} = 'bogus DOCTYPE';
1421            !!!next-input-character;
1422            redo A;
1423          }
1424        } elsif ($self->{state} eq 'before DOCTYPE system identifier') {
1425          if ({
1426                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1427                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1428              }->{$self->{next_input_character}}) {
1429            ## Stay in the state
1430            !!!next-input-character;
1431            redo A;
1432          } elsif ($self->{next_input_character} == 0x0022) { # "
1433            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1434            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1435            !!!next-input-character;
1436            redo A;
1437          } elsif ($self->{next_input_character} == 0x0027) { # '
1438            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1439            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1440            !!!next-input-character;
1441            redo A;
1442          } elsif ($self->{next_input_character} == 0x003E) { # >
1443            !!!parse-error (type => 'no SYSTEM literal');
1444            $self->{state} = 'data';
1445            !!!next-input-character;
1446    
1447            delete $self->{current_token}->{correct};
1448            !!!emit ($self->{current_token}); # DOCTYPE
1449    
1450            redo A;
1451          } elsif ($self->{next_input_character} == -1) {
1452            !!!parse-error (type => 'unclosed DOCTYPE');
1453    
1454            $self->{state} = 'data';
1455            ## reconsume
1456    
1457            delete $self->{current_token}->{correct};
1458            !!!emit ($self->{current_token}); # DOCTYPE
1459    
1460            redo A;
1461          } else {
1462            !!!parse-error (type => 'string after PUBLIC literal');
1463            $self->{state} = 'bogus DOCTYPE';
1464            !!!next-input-character;
1465            redo A;
1466          }
1467        } elsif ($self->{state} eq 'DOCTYPE system identifier (double-quoted)') {
1468          if ($self->{next_input_character} == 0x0022) { # "
1469            $self->{state} = 'after DOCTYPE system identifier';
1470            !!!next-input-character;
1471            redo A;
1472          } elsif ($self->{next_input_character} == -1) {
1473            !!!parse-error (type => 'unclosed SYSTEM literal');
1474    
1475            $self->{state} = 'data';
1476            ## reconsume
1477    
1478            delete $self->{current_token}->{correct};
1479            !!!emit ($self->{current_token}); # DOCTYPE
1480    
1481            redo A;
1482          } else {
1483            $self->{current_token}->{system_identifier} # DOCTYPE
1484                .= chr $self->{next_input_character};
1485            ## Stay in the state
1486            !!!next-input-character;
1487            redo A;
1488          }
1489        } elsif ($self->{state} eq 'DOCTYPE system identifier (single-quoted)') {
1490          if ($self->{next_input_character} == 0x0027) { # '
1491            $self->{state} = 'after DOCTYPE system identifier';
1492            !!!next-input-character;
1493            redo A;
1494          } elsif ($self->{next_input_character} == -1) {
1495            !!!parse-error (type => 'unclosed SYSTEM literal');
1496    
1497            $self->{state} = 'data';
1498            ## reconsume
1499    
1500            delete $self->{current_token}->{correct};
1501            !!!emit ($self->{current_token}); # DOCTYPE
1502    
1503            redo A;
1504          } else {
1505            $self->{current_token}->{system_identifier} # DOCTYPE
1506                .= chr $self->{next_input_character};
1507            ## Stay in the state
1508            !!!next-input-character;
1509            redo A;
1510          }
1511        } elsif ($self->{state} eq 'after DOCTYPE system identifier') {
1512          if ({
1513                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1514                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1515              }->{$self->{next_input_character}}) {
1516            ## Stay in the state
1517            !!!next-input-character;
1518            redo A;
1519          } elsif ($self->{next_input_character} == 0x003E) { # >
1520            $self->{state} = 'data';
1521            !!!next-input-character;
1522    
1523            !!!emit ($self->{current_token}); # DOCTYPE
1524    
1525            redo A;
1526          } elsif ($self->{next_input_character} == -1) {
1527            !!!parse-error (type => 'unclosed DOCTYPE');
1528    
1529          $self->{state} = 'data';          $self->{state} = 'data';
1530          ## reconsume          ## reconsume
1531    
1532            delete $self->{current_token}->{correct};
1533          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1534    
1535          redo A;          redo A;
1536        } else {        } else {
1537          !!!parse-error;          !!!parse-error (type => 'string after SYSTEM literal');
         $self->{current_token}->{error} = 1; # DOCTYPE  
1538          $self->{state} = 'bogus DOCTYPE';          $self->{state} = 'bogus DOCTYPE';
1539          !!!next-input-character;          !!!next-input-character;
1540          redo A;          redo A;
# Line 1413  sub _get_next_token ($) { Line 1544  sub _get_next_token ($) {
1544          $self->{state} = 'data';          $self->{state} = 'data';
1545          !!!next-input-character;          !!!next-input-character;
1546    
1547            delete $self->{current_token}->{correct};
1548          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1549    
1550          redo A;          redo A;
1551        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1552          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
1553          $self->{state} = 'data';          $self->{state} = 'data';
1554          ## reconsume          ## reconsume
1555    
1556            delete $self->{current_token}->{correct};
1557          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1558    
1559          redo A;          redo A;
1560        } else {        } else {
# Line 1439  sub _get_next_token ($) { Line 1570  sub _get_next_token ($) {
1570    die "$0: _get_next_token: unexpected case";    die "$0: _get_next_token: unexpected case";
1571  } # _get_next_token  } # _get_next_token
1572    
1573  sub _tokenize_attempt_to_consume_an_entity ($) {  sub _tokenize_attempt_to_consume_an_entity ($$) {
1574    my $self = shift;    my ($self, $in_attr) = @_;
1575      
1576    if ($self->{next_input_character} == 0x0023) { # #    if ({
1577           0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
1578           0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR
1579          }->{$self->{next_input_character}}) {
1580        ## Don't consume
1581        ## No error
1582        return undef;
1583      } elsif ($self->{next_input_character} == 0x0023) { # #
1584      !!!next-input-character;      !!!next-input-character;
     my $num;  
1585      if ($self->{next_input_character} == 0x0078 or # x      if ($self->{next_input_character} == 0x0078 or # x
1586          $self->{next_input_character} == 0x0058) { # X          $self->{next_input_character} == 0x0058) { # X
1587          my $code;
1588        X: {        X: {
1589          my $x_char = $self->{next_input_character};          my $x_char = $self->{next_input_character};
1590          !!!next-input-character;          !!!next-input-character;
1591          if (0x0030 <= $self->{next_input_character} and          if (0x0030 <= $self->{next_input_character} and
1592              $self->{next_input_character} <= 0x0039) { # 0..9              $self->{next_input_character} <= 0x0039) { # 0..9
1593            $num ||= 0;            $code ||= 0;
1594            $num *= 0x10;            $code *= 0x10;
1595            $num += $self->{next_input_character} - 0x0030;            $code += $self->{next_input_character} - 0x0030;
1596            redo X;            redo X;
1597          } elsif (0x0061 <= $self->{next_input_character} and          } elsif (0x0061 <= $self->{next_input_character} and
1598                   $self->{next_input_character} <= 0x0066) { # a..f                   $self->{next_input_character} <= 0x0066) { # a..f
1599            ## ISSUE: the spec says U+0078, which is apparently incorrect            $code ||= 0;
1600            $num ||= 0;            $code *= 0x10;
1601            $num *= 0x10;            $code += $self->{next_input_character} - 0x0060 + 9;
           $num += $self->{next_input_character} - 0x0060 + 9;  
1602            redo X;            redo X;
1603          } elsif (0x0041 <= $self->{next_input_character} and          } elsif (0x0041 <= $self->{next_input_character} and
1604                   $self->{next_input_character} <= 0x0046) { # A..F                   $self->{next_input_character} <= 0x0046) { # A..F
1605            ## ISSUE: the spec says U+0058, which is apparently incorrect            $code ||= 0;
1606            $num ||= 0;            $code *= 0x10;
1607            $num *= 0x10;            $code += $self->{next_input_character} - 0x0040 + 9;
           $num += $self->{next_input_character} - 0x0040 + 9;  
1608            redo X;            redo X;
1609          } elsif (not defined $num) { # no hexadecimal digit          } elsif (not defined $code) { # no hexadecimal digit
1610            !!!parse-error;            !!!parse-error (type => 'bare hcro');
1611            $self->{next_input_character} = 0x0023; # #            $self->{next_input_character} = 0x0023; # #
1612            !!!back-next-input-character ($x_char);            !!!back-next-input-character ($x_char);
1613            return undef;            return undef;
1614          } elsif ($self->{next_input_character} == 0x003B) { # ;          } elsif ($self->{next_input_character} == 0x003B) { # ;
1615            !!!next-input-character;            !!!next-input-character;
1616          } else {          } else {
1617            !!!parse-error;            !!!parse-error (type => 'no refc');
1618          }          }
1619    
1620          ## TODO: check the definition for |a valid Unicode character|.          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
1621          if ($num > 1114111 or $num == 0) {            !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1622            $num = 0xFFFD; # REPLACEMENT CHARACTER            $code = 0xFFFD;
1623            ## ISSUE: Why this is not an error?          } elsif ($code > 0x10FFFF) {
1624              !!!parse-error (type => sprintf 'invalid character reference:U-%08X', $code);
1625              $code = 0xFFFD;
1626            } elsif ($code == 0x000D) {
1627              !!!parse-error (type => 'CR character reference');
1628              $code = 0x000A;
1629            } elsif (0x80 <= $code and $code <= 0x9F) {
1630              !!!parse-error (type => sprintf 'c1 entity:U+%04X', $code);
1631              $code = $c1_entity_char->{$code};
1632          }          }
1633    
1634          return {type => 'character', data => chr $num};          return {type => 'character', data => chr $code};
1635        } # X        } # X
1636      } elsif (0x0030 <= $self->{next_input_character} and      } elsif (0x0030 <= $self->{next_input_character} and
1637               $self->{next_input_character} <= 0x0039) { # 0..9               $self->{next_input_character} <= 0x0039) { # 0..9
# Line 1505  sub _tokenize_attempt_to_consume_an_enti Line 1649  sub _tokenize_attempt_to_consume_an_enti
1649        if ($self->{next_input_character} == 0x003B) { # ;        if ($self->{next_input_character} == 0x003B) { # ;
1650          !!!next-input-character;          !!!next-input-character;
1651        } else {        } else {
1652          !!!parse-error;          !!!parse-error (type => 'no refc');
1653        }        }
1654    
1655        ## TODO: check the definition for |a valid Unicode character|.        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
1656        if ($code > 1114111 or $code == 0) {          !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1657          $code = 0xFFFD; # REPLACEMENT CHARACTER          $code = 0xFFFD;
1658          ## ISSUE: Why this is not an error?        } elsif ($code > 0x10FFFF) {
1659            !!!parse-error (type => sprintf 'invalid character reference:U-%08X', $code);
1660            $code = 0xFFFD;
1661          } elsif ($code == 0x000D) {
1662            !!!parse-error (type => 'CR character reference');
1663            $code = 0x000A;
1664          } elsif (0x80 <= $code and $code <= 0x9F) {
1665            !!!parse-error (type => sprintf 'c1 entity:U+%04X', $code);
1666            $code = $c1_entity_char->{$code};
1667        }        }
1668                
1669        return {type => 'character', data => chr $code};        return {type => 'character', data => chr $code};
1670      } else {      } else {
1671        !!!parse-error;        !!!parse-error (type => 'bare nero');
1672        !!!back-next-input-character ($self->{next_input_character});        !!!back-next-input-character ($self->{next_input_character});
1673        $self->{next_input_character} = 0x0023; # #        $self->{next_input_character} = 0x0023; # #
1674        return undef;        return undef;
# Line 1530  sub _tokenize_attempt_to_consume_an_enti Line 1682  sub _tokenize_attempt_to_consume_an_enti
1682    
1683      my $value = $entity_name;      my $value = $entity_name;
1684      my $match;      my $match;
1685        require Whatpm::_NamedEntityList;
1686        our $EntityChar;
1687    
1688      while (length $entity_name < 10 and      while (length $entity_name < 10 and
1689             ## NOTE: Some number greater than the maximum length of entity name             ## NOTE: Some number greater than the maximum length of entity name
1690             ((0x0041 <= $self->{next_input_character} and             ((0x0041 <= $self->{next_input_character} and # a
1691               $self->{next_input_character} <= 0x005A) or               $self->{next_input_character} <= 0x005A) or # x
1692              (0x0061 <= $self->{next_input_character} and              (0x0061 <= $self->{next_input_character} and # a
1693               $self->{next_input_character} <= 0x007A) or               $self->{next_input_character} <= 0x007A) or # z
1694              (0x0030 <= $self->{next_input_character} and              (0x0030 <= $self->{next_input_character} and # 0
1695               $self->{next_input_character} <= 0x0039))) {               $self->{next_input_character} <= 0x0039) or # 9
1696                $self->{next_input_character} == 0x003B)) { # ;
1697        $entity_name .= chr $self->{next_input_character};        $entity_name .= chr $self->{next_input_character};
1698        if (defined $entity_char->{$entity_name}) {        if (defined $EntityChar->{$entity_name}) {
1699          $value = $entity_char->{$entity_name};          if ($self->{next_input_character} == 0x003B) { # ;
1700          $match = 1;            $value = $EntityChar->{$entity_name};
1701              $match = 1;
1702              !!!next-input-character;
1703              last;
1704            } elsif (not $in_attr) {
1705              $value = $EntityChar->{$entity_name};
1706              $match = -1;
1707            } else {
1708              $value .= chr $self->{next_input_character};
1709            }
1710        } else {        } else {
1711          $value .= chr $self->{next_input_character};          $value .= chr $self->{next_input_character};
1712        }        }
1713        !!!next-input-character;        !!!next-input-character;
1714      }      }
1715            
1716      if ($match) {      if ($match > 0) {
1717        if ($self->{next_input_character} == 0x003B) { # ;        return {type => 'character', data => $value};
1718          !!!next-input-character;      } elsif ($match < 0) {
1719        } else {        !!!parse-error (type => 'refc');
         !!!parse-error;  
       }  
   
1720        return {type => 'character', data => $value};        return {type => 'character', data => $value};
1721      } else {      } else {
1722        !!!parse-error;        !!!parse-error (type => 'bare ero');
1723        ## NOTE: No characters are consumed in the spec.        ## NOTE: No characters are consumed in the spec.
1724        !!!back-token ({type => 'character', data => $value});        return {type => 'character', data => '&'.$value};
       return undef;  
1725      }      }
1726    } else {    } else {
1727      ## no characters are consumed      ## no characters are consumed
1728      !!!parse-error;      !!!parse-error (type => 'bare ero');
1729      return undef;      return undef;
1730    }    }
1731  } # _tokenize_attempt_to_consume_an_entity  } # _tokenize_attempt_to_consume_an_entity
# Line 1576  sub _initialize_tree_constructor ($) { Line 1736  sub _initialize_tree_constructor ($) {
1736    $self->{document}->strict_error_checking (0);    $self->{document}->strict_error_checking (0);
1737    ## TODO: Turn mutation events off # MUST    ## TODO: Turn mutation events off # MUST
1738    ## TODO: Turn loose Document option (manakai extension) on    ## TODO: Turn loose Document option (manakai extension) on
1739    ## TODO: Mark the Document as an HTML document # MUST    $self->{document}->manakai_is_html (1); # MUST
1740  } # _initialize_tree_constructor  } # _initialize_tree_constructor
1741    
1742  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 1587  sub _terminate_tree_constructor ($) { Line 1747  sub _terminate_tree_constructor ($) {
1747    
1748  ## ISSUE: Should append_child (for example) in script executed in tree construction stage fire mutation events?  ## ISSUE: Should append_child (for example) in script executed in tree construction stage fire mutation events?
1749    
1750    { # tree construction stage
1751      my $token;
1752    
1753  sub _construct_tree ($) {  sub _construct_tree ($) {
1754    my ($self) = @_;    my ($self) = @_;
1755    
# Line 1598  sub _construct_tree ($) { Line 1761  sub _construct_tree ($) {
1761    ## characters and insert one Text node whose data is concatenation    ## characters and insert one Text node whose data is concatenation
1762    ## of all those characters. # MUST    ## of all those characters. # MUST
1763        
   my $token;  
1764    !!!next-token;    !!!next-token;
1765    
1766    my $phase = 'initial'; # MUST    $self->{insertion_mode} = 'before head';
1767      undef $self->{form_element};
1768      undef $self->{head_element};
1769      $self->{open_elements} = [];
1770      undef $self->{inner_html_node};
1771    
1772      $self->_tree_construction_initial; # MUST
1773      $self->_tree_construction_root_element;
1774      $self->_tree_construction_main;
1775    } # _construct_tree
1776    
1777    sub _tree_construction_initial ($) {
1778      my $self = shift;
1779      INITIAL: {
1780        if ($token->{type} eq 'DOCTYPE') {
1781          ## NOTE: Conformance checkers MAY, instead of reporting "not HTML5"
1782          ## error, switch to a conformance checking mode for another
1783          ## language.
1784          my $doctype_name = $token->{name};
1785          $doctype_name = '' unless defined $doctype_name;
1786          $doctype_name =~ tr/a-z/A-Z/;
1787          if (not defined $token->{name} or # <!DOCTYPE>
1788              defined $token->{public_identifier} or
1789              defined $token->{system_identifier}) {
1790            !!!parse-error (type => 'not HTML5');
1791          } elsif ($doctype_name ne 'HTML') {
1792            ## ISSUE: ASCII case-insensitive? (in fact it does not matter)
1793            !!!parse-error (type => 'not HTML5');
1794          }
1795          
1796          my $doctype = $self->{document}->create_document_type_definition
1797            ($token->{name}); ## ISSUE: If name is missing (e.g. <!DOCTYPE>)?
1798          $doctype->public_id ($token->{public_identifier})
1799              if defined $token->{public_identifier};
1800          $doctype->system_id ($token->{system_identifier})
1801              if defined $token->{system_identifier};
1802          ## NOTE: Other DocumentType attributes are null or empty lists.
1803          ## ISSUE: internalSubset = null??
1804          $self->{document}->append_child ($doctype);
1805          
1806          if (not $token->{correct} or $doctype_name ne 'HTML') {
1807            $self->{document}->manakai_compat_mode ('quirks');
1808          } elsif (defined $token->{public_identifier}) {
1809            my $pubid = $token->{public_identifier};
1810            $pubid =~ tr/a-z/A-z/;
1811            if ({
1812              "+//SILMARIL//DTD HTML PRO V0R11 19970101//EN" => 1,
1813              "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1814              "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1815              "-//IETF//DTD HTML 2.0 LEVEL 1//EN" => 1,
1816              "-//IETF//DTD HTML 2.0 LEVEL 2//EN" => 1,
1817              "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//EN" => 1,
1818              "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//EN" => 1,
1819              "-//IETF//DTD HTML 2.0 STRICT//EN" => 1,
1820              "-//IETF//DTD HTML 2.0//EN" => 1,
1821              "-//IETF//DTD HTML 2.1E//EN" => 1,
1822              "-//IETF//DTD HTML 3.0//EN" => 1,
1823              "-//IETF//DTD HTML 3.0//EN//" => 1,
1824              "-//IETF//DTD HTML 3.2 FINAL//EN" => 1,
1825              "-//IETF//DTD HTML 3.2//EN" => 1,
1826              "-//IETF//DTD HTML 3//EN" => 1,
1827              "-//IETF//DTD HTML LEVEL 0//EN" => 1,
1828              "-//IETF//DTD HTML LEVEL 0//EN//2.0" => 1,
1829              "-//IETF//DTD HTML LEVEL 1//EN" => 1,
1830              "-//IETF//DTD HTML LEVEL 1//EN//2.0" => 1,
1831              "-//IETF//DTD HTML LEVEL 2//EN" => 1,
1832              "-//IETF//DTD HTML LEVEL 2//EN//2.0" => 1,
1833              "-//IETF//DTD HTML LEVEL 3//EN" => 1,
1834              "-//IETF//DTD HTML LEVEL 3//EN//3.0" => 1,
1835              "-//IETF//DTD HTML STRICT LEVEL 0//EN" => 1,
1836              "-//IETF//DTD HTML STRICT LEVEL 0//EN//2.0" => 1,
1837              "-//IETF//DTD HTML STRICT LEVEL 1//EN" => 1,
1838              "-//IETF//DTD HTML STRICT LEVEL 1//EN//2.0" => 1,
1839              "-//IETF//DTD HTML STRICT LEVEL 2//EN" => 1,
1840              "-//IETF//DTD HTML STRICT LEVEL 2//EN//2.0" => 1,
1841              "-//IETF//DTD HTML STRICT LEVEL 3//EN" => 1,
1842              "-//IETF//DTD HTML STRICT LEVEL 3//EN//3.0" => 1,
1843              "-//IETF//DTD HTML STRICT//EN" => 1,
1844              "-//IETF//DTD HTML STRICT//EN//2.0" => 1,
1845              "-//IETF//DTD HTML STRICT//EN//3.0" => 1,
1846              "-//IETF//DTD HTML//EN" => 1,
1847              "-//IETF//DTD HTML//EN//2.0" => 1,
1848              "-//IETF//DTD HTML//EN//3.0" => 1,
1849              "-//METRIUS//DTD METRIUS PRESENTATIONAL//EN" => 1,
1850              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//EN" => 1,
1851              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//EN" => 1,
1852              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//EN" => 1,
1853              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//EN" => 1,
1854              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//EN" => 1,
1855              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//EN" => 1,
1856              "-//NETSCAPE COMM. CORP.//DTD HTML//EN" => 1,
1857              "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//EN" => 1,
1858              "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//EN" => 1,
1859              "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//EN" => 1,
1860              "-//SPYGLASS//DTD HTML 2.0 EXTENDED//EN" => 1,
1861              "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//EN" => 1,
1862              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//EN" => 1,
1863              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//EN" => 1,
1864              "-//W3C//DTD HTML 3 1995-03-24//EN" => 1,
1865              "-//W3C//DTD HTML 3.2 DRAFT//EN" => 1,
1866              "-//W3C//DTD HTML 3.2 FINAL//EN" => 1,
1867              "-//W3C//DTD HTML 3.2//EN" => 1,
1868              "-//W3C//DTD HTML 3.2S DRAFT//EN" => 1,
1869              "-//W3C//DTD HTML 4.0 FRAMESET//EN" => 1,
1870              "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN" => 1,
1871              "-//W3C//DTD HTML EXPERIMETNAL 19960712//EN" => 1,
1872              "-//W3C//DTD HTML EXPERIMENTAL 970421//EN" => 1,
1873              "-//W3C//DTD W3 HTML//EN" => 1,
1874              "-//W3O//DTD W3 HTML 3.0//EN" => 1,
1875              "-//W3O//DTD W3 HTML 3.0//EN//" => 1,
1876              "-//W3O//DTD W3 HTML STRICT 3.0//EN//" => 1,
1877              "-//WEBTECHS//DTD MOZILLA HTML 2.0//EN" => 1,
1878              "-//WEBTECHS//DTD MOZILLA HTML//EN" => 1,
1879              "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" => 1,
1880              "HTML" => 1,
1881            }->{$pubid}) {
1882              $self->{document}->manakai_compat_mode ('quirks');
1883            } elsif ($pubid eq "-//W3C//DTD HTML 4.01 FRAMESET//EN" or
1884                     $pubid eq "-//W3C//DTD HTML 4.01 TRANSITIONAL//EN") {
1885              if (defined $token->{system_identifier}) {
1886                $self->{document}->manakai_compat_mode ('quirks');
1887              } else {
1888                $self->{document}->manakai_compat_mode ('limited quirks');
1889              }
1890            } elsif ($pubid eq "-//W3C//DTD XHTML 1.0 Frameset//EN" or
1891                     $pubid eq "-//W3C//DTD XHTML 1.0 Transitional//EN") {
1892              $self->{document}->manakai_compat_mode ('limited quirks');
1893            }
1894          }
1895          if (defined $token->{system_identifier}) {
1896            my $sysid = $token->{system_identifier};
1897            $sysid =~ tr/A-Z/a-z/;
1898            if ($sysid eq "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd") {
1899              $self->{document}->manakai_compat_mode ('quirks');
1900            }
1901          }
1902          
1903          ## Go to the root element phase.
1904          !!!next-token;
1905          return;
1906        } elsif ({
1907                  'start tag' => 1,
1908                  'end tag' => 1,
1909                  'end-of-file' => 1,
1910                 }->{$token->{type}}) {
1911          !!!parse-error (type => 'no DOCTYPE');
1912          $self->{document}->manakai_compat_mode ('quirks');
1913          ## Go to the root element phase
1914          ## reprocess
1915          return;
1916        } elsif ($token->{type} eq 'character') {
1917          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
1918            ## Ignore the token
1919    
1920            unless (length $token->{data}) {
1921              ## Stay in the phase
1922              !!!next-token;
1923              redo INITIAL;
1924            }
1925          }
1926    
1927          !!!parse-error (type => 'no DOCTYPE');
1928          $self->{document}->manakai_compat_mode ('quirks');
1929          ## Go to the root element phase
1930          ## reprocess
1931          return;
1932        } elsif ($token->{type} eq 'comment') {
1933          my $comment = $self->{document}->create_comment ($token->{data});
1934          $self->{document}->append_child ($comment);
1935          
1936          ## Stay in the phase.
1937          !!!next-token;
1938          redo INITIAL;
1939        } else {
1940          die "$0: $token->{type}: Unknown token";
1941        }
1942      } # INITIAL
1943    } # _tree_construction_initial
1944    
1945    sub _tree_construction_root_element ($) {
1946      my $self = shift;
1947      
1948      B: {
1949          if ($token->{type} eq 'DOCTYPE') {
1950            !!!parse-error (type => 'in html:#DOCTYPE');
1951            ## Ignore the token
1952            ## Stay in the phase
1953            !!!next-token;
1954            redo B;
1955          } elsif ($token->{type} eq 'comment') {
1956            my $comment = $self->{document}->create_comment ($token->{data});
1957            $self->{document}->append_child ($comment);
1958            ## Stay in the phase
1959            !!!next-token;
1960            redo B;
1961          } elsif ($token->{type} eq 'character') {
1962            if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
1963              ## Ignore the token.
1964    
1965              unless (length $token->{data}) {
1966                ## Stay in the phase
1967                !!!next-token;
1968                redo B;
1969              }
1970            }
1971            #
1972          } elsif ({
1973                    'start tag' => 1,
1974                    'end tag' => 1,
1975                    'end-of-file' => 1,
1976                   }->{$token->{type}}) {
1977            ## ISSUE: There is an issue in the spec
1978            #
1979          } else {
1980            die "$0: $token->{type}: Unknown token";
1981          }
1982          my $root_element; !!!create-element ($root_element, 'html');
1983          $self->{document}->append_child ($root_element);
1984          push @{$self->{open_elements}}, [$root_element, 'html'];
1985          #$phase = 'main';
1986          ## reprocess
1987          #redo B;
1988          return;
1989      } # B
1990    } # _tree_construction_root_element
1991    
1992    sub _reset_insertion_mode ($) {
1993      my $self = shift;
1994    
1995        ## Step 1
1996        my $last;
1997        
1998        ## Step 2
1999        my $i = -1;
2000        my $node = $self->{open_elements}->[$i];
2001        
2002        ## Step 3
2003        S3: {
2004          $last = 1 if $self->{open_elements}->[0]->[0] eq $node->[0];
2005          if (defined $self->{inner_html_node}) {
2006            if ($self->{inner_html_node}->[1] eq 'td' or
2007                $self->{inner_html_node}->[1] eq 'th') {
2008              #
2009            } else {
2010              $node = $self->{inner_html_node};
2011            }
2012          }
2013        
2014          ## Step 4..13
2015          my $new_mode = {
2016                          select => 'in select',
2017                          td => 'in cell',
2018                          th => 'in cell',
2019                          tr => 'in row',
2020                          tbody => 'in table body',
2021                          thead => 'in table head',
2022                          tfoot => 'in table foot',
2023                          caption => 'in caption',
2024                          colgroup => 'in column group',
2025                          table => 'in table',
2026                          head => 'in body', # not in head!
2027                          body => 'in body',
2028                          frameset => 'in frameset',
2029                         }->{$node->[1]};
2030          $self->{insertion_mode} = $new_mode and return if defined $new_mode;
2031          
2032          ## Step 14
2033          if ($node->[1] eq 'html') {
2034            unless (defined $self->{head_element}) {
2035              $self->{insertion_mode} = 'before head';
2036            } else {
2037              $self->{insertion_mode} = 'after head';
2038            }
2039            return;
2040          }
2041          
2042          ## Step 15
2043          $self->{insertion_mode} = 'in body' and return if $last;
2044          
2045          ## Step 16
2046          $i--;
2047          $node = $self->{open_elements}->[$i];
2048          
2049          ## Step 17
2050          redo S3;
2051        } # S3
2052    } # _reset_insertion_mode
2053    
2054    sub _tree_construction_main ($) {
2055      my $self = shift;
2056    
2057      my $phase = 'main';
2058    
   my $open_elements = [];  
2059    my $active_formatting_elements = [];    my $active_formatting_elements = [];
   my $head_element;  
   my $form_element;  
   my $insertion_mode = 'before head';  
2060    
2061    my $reconstruct_active_formatting_elements = sub { # MUST    my $reconstruct_active_formatting_elements = sub { # MUST
2062      my $insert = shift;      my $insert = shift;
# Line 1621  sub _construct_tree ($) { Line 2070  sub _construct_tree ($) {
2070    
2071      ## Step 2      ## Step 2
2072      return if $entry->[0] eq '#marker';      return if $entry->[0] eq '#marker';
2073      for (@$open_elements) {      for (@{$self->{open_elements}}) {
2074        if ($entry->[0] eq $_->[0]) {        if ($entry->[0] eq $_->[0]) {
2075          return;          return;
2076        }        }
# Line 1640  sub _construct_tree ($) { Line 2089  sub _construct_tree ($) {
2089          #          #
2090        } else {        } else {
2091          my $in_open_elements;          my $in_open_elements;
2092          OE: for (@$open_elements) {          OE: for (@{$self->{open_elements}}) {
2093            if ($entry->[0] eq $_->[0]) {            if ($entry->[0] eq $_->[0]) {
2094              $in_open_elements = 1;              $in_open_elements = 1;
2095              last OE;              last OE;
# Line 1664  sub _construct_tree ($) { Line 2113  sub _construct_tree ($) {
2113            
2114        ## Step 9        ## Step 9
2115        $insert->($clone->[0]);        $insert->($clone->[0]);
2116        push @$open_elements, $clone;        push @{$self->{open_elements}}, $clone;
2117                
2118        ## Step 10        ## Step 10
2119        $active_formatting_elements->[$i] = $open_elements->[-1];        $active_formatting_elements->[$i] = $self->{open_elements}->[-1];
2120    
2121        ## Step 11        ## Step 11
2122        unless ($clone->[0] eq $active_formatting_elements->[-1]->[0]) {        unless ($clone->[0] eq $active_formatting_elements->[-1]->[0]) {
# Line 1689  sub _construct_tree ($) { Line 2138  sub _construct_tree ($) {
2138      }      }
2139    }; # $clear_up_to_marker    }; # $clear_up_to_marker
2140    
2141    my $reset_insertion_mode = sub {    my $parse_rcdata = sub ($$) {
2142        my ($content_model_flag, $insert) = @_;
2143    
2144      ## Step 1      ## Step 1
2145      my $last;      my $start_tag_name = $token->{tag_name};
2146            my $el;
2147        !!!create-element ($el, $start_tag_name, $token->{attributes});
2148    
2149      ## Step 2      ## Step 2
2150      my $i = -1;      $insert->($el); # /context node/->append_child ($el)
2151      my $node = $open_elements->[$i];  
       
2152      ## Step 3      ## Step 3
2153      S3: {      $self->{content_model_flag} = $content_model_flag; # CDATA or RCDATA
2154        $last = 1 if $open_elements->[0]->[0] eq $node->[0];      delete $self->{escape}; # MUST
       ## TODO: the element whose inner_html is set is neither td nor th, then $node = the element  
       
       ## Step 4..13  
       my $new_mode = {  
                       select => 'in select',  
                       td => 'in cell',  
                       th => 'in cell',  
                       tr => 'in row',  
                       tbody => 'in table body',  
                       thead => 'in table head',  
                       tfoot => 'in table foot',  
                       caption => 'in caption',  
                       colgroup => 'in column group',  
                       table => 'in table',  
                       head => 'in body', # not in head!  
                       body => 'in body',  
                       frameset => 'in frameset',  
                      }->{$node->[1]};  
       $insertion_mode = $new_mode and return if defined $new_mode;  
         
       ## Step 14  
       if ($node->[1] eq 'html') {  
         unless (defined $head_element) {  
           $insertion_mode = 'before head';  
         } else {  
           $insertion_mode = 'after head';  
         }  
         return;  
       }  
         
       ## Step 15  
       $insertion_mode = 'in body' and return if $last;  
         
       ## Step 16  
       $i--;  
       $node = $open_elements->[$i];  
         
       ## Step 17  
       redo S3;  
     } # S3  
   }; # $reset_insertion_mode  
2155    
2156    my $style_start_tag = sub {      ## Step 4
     my $style_el; !!!create-element ($style_el, 'style');  
     ## $insertion_mode eq 'in head' and ... (always true)  
     (($insertion_mode eq 'in head' and defined $head_element)  
      ? $head_element : $open_elements->[-1]->[0])  
       ->append_child ($style_el);  
     $self->{content_model_flag} = 'CDATA';  
                 
2157      my $text = '';      my $text = '';
2158      !!!next-token;      !!!next-token;
2159      while ($token->{type} eq 'character') {      while ($token->{type} eq 'character') { # or until stop tokenizing
2160        $text .= $token->{data};        $text .= $token->{data};
2161        !!!next-token;        !!!next-token;
2162      } # stop if non-character token or tokenizer stops tokenising      }
2163    
2164        ## Step 5
2165      if (length $text) {      if (length $text) {
2166        $style_el->manakai_append_text ($text);        my $text = $self->{document}->create_text_node ($text);
2167          $el->append_child ($text);
2168      }      }
2169        
2170        ## Step 6
2171      $self->{content_model_flag} = 'PCDATA';      $self->{content_model_flag} = 'PCDATA';
2172                  
2173      if ($token->{type} eq 'end tag' and $token->{tag_name} eq 'style') {      ## Step 7
2174        if ($token->{type} eq 'end tag' and $token->{tag_name} eq $start_tag_name) {
2175        ## Ignore the token        ## Ignore the token
2176      } else {      } else {
2177        !!!parse-error;        !!!parse-error (type => 'in '.$content_model_flag.':#'.$token->{type});
       ## ISSUE: And ignore?  
2178      }      }
2179      !!!next-token;      !!!next-token;
2180    }; # $style_start_tag    }; # $parse_rcdata
2181    
2182    my $script_start_tag = sub {    my $script_start_tag = sub ($) {
2183        my $insert = $_[0];
2184      my $script_el;      my $script_el;
2185      !!!create-element ($script_el, 'script', $token->{attributes});      !!!create-element ($script_el, 'script', $token->{attributes});
2186      ## TODO: mark as "parser-inserted"      ## TODO: mark as "parser-inserted"
2187    
2188      $self->{content_model_flag} = 'CDATA';      $self->{content_model_flag} = 'CDATA';
2189        delete $self->{escape}; # MUST
2190            
2191      my $text = '';      my $text = '';
2192      !!!next-token;      !!!next-token;
# Line 1794  sub _construct_tree ($) { Line 2204  sub _construct_tree ($) {
2204          $token->{tag_name} eq 'script') {          $token->{tag_name} eq 'script') {
2205        ## Ignore the token        ## Ignore the token
2206      } else {      } else {
2207        !!!parse-error;        !!!parse-error (type => 'in CDATA:#'.$token->{type});
2208        ## ISSUE: And ignore?        ## ISSUE: And ignore?
2209        ## TODO: mark as "already executed"        ## TODO: mark as "already executed"
2210      }      }
2211            
2212      ## TODO: inner_html mode then mark as "already executed" and skip      if (defined $self->{inner_html_node}) {
2213      if (1) {        ## TODO: mark as "already executed"
2214        } else {
2215        ## TODO: $old_insertion_point = current insertion point        ## TODO: $old_insertion_point = current insertion point
2216        ## TODO: insertion point = just before the next input character        ## TODO: insertion point = just before the next input character
2217          
2218        (($insertion_mode eq 'in head' and defined $head_element)        $insert->($script_el);
        ? $head_element : $open_elements->[-1]->[0])->append_child ($script_el);  
2219                
2220        ## TODO: insertion point = $old_insertion_point (might be "undefined")        ## TODO: insertion point = $old_insertion_point (might be "undefined")
2221                
# Line 1832  sub _construct_tree ($) { Line 2242  sub _construct_tree ($) {
2242          }          }
2243        } # AFE        } # AFE
2244        unless (defined $formatting_element) {        unless (defined $formatting_element) {
2245          !!!parse-error;          !!!parse-error (type => 'unmatched end tag:'.$tag_name);
2246          ## Ignore the token          ## Ignore the token
2247          !!!next-token;          !!!next-token;
2248          return;          return;
# Line 1840  sub _construct_tree ($) { Line 2250  sub _construct_tree ($) {
2250        ## has an element in scope        ## has an element in scope
2251        my $in_scope = 1;        my $in_scope = 1;
2252        my $formatting_element_i_in_open;          my $formatting_element_i_in_open;  
2253        INSCOPE: for (reverse 0..$#$open_elements) {        INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2254          my $node = $open_elements->[$_];          my $node = $self->{open_elements}->[$_];
2255          if ($node->[0] eq $formatting_element->[0]) {          if ($node->[0] eq $formatting_element->[0]) {
2256            if ($in_scope) {            if ($in_scope) {
2257              $formatting_element_i_in_open = $_;              $formatting_element_i_in_open = $_;
2258              last INSCOPE;              last INSCOPE;
2259            } else { # in open elements but not in scope            } else { # in open elements but not in scope
2260              !!!parse-error;              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
2261              ## Ignore the token              ## Ignore the token
2262              !!!next-token;              !!!next-token;
2263              return;              return;
# Line 1860  sub _construct_tree ($) { Line 2270  sub _construct_tree ($) {
2270          }          }
2271        } # INSCOPE        } # INSCOPE
2272        unless (defined $formatting_element_i_in_open) {        unless (defined $formatting_element_i_in_open) {
2273          !!!parse-error;          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
2274          pop @$active_formatting_elements; # $formatting_element          pop @$active_formatting_elements; # $formatting_element
2275          !!!next-token; ## TODO: ok?          !!!next-token; ## TODO: ok?
2276          return;          return;
2277        }        }
2278        if (not $open_elements->[-1]->[0] eq $formatting_element->[0]) {        if (not $self->{open_elements}->[-1]->[0] eq $formatting_element->[0]) {
2279          !!!parse-error;          !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
2280        }        }
2281                
2282        ## Step 2        ## Step 2
2283        my $furthest_block;        my $furthest_block;
2284        my $furthest_block_i_in_open;        my $furthest_block_i_in_open;
2285        OE: for (reverse 0..$#$open_elements) {        OE: for (reverse 0..$#{$self->{open_elements}}) {
2286          my $node = $open_elements->[$_];          my $node = $self->{open_elements}->[$_];
2287          if (not $formatting_category->{$node->[1]} and          if (not $formatting_category->{$node->[1]} and
2288              #not $phrasing_category->{$node->[1]} and              #not $phrasing_category->{$node->[1]} and
2289              ($special_category->{$node->[1]} or              ($special_category->{$node->[1]} or
# Line 1887  sub _construct_tree ($) { Line 2297  sub _construct_tree ($) {
2297                
2298        ## Step 3        ## Step 3
2299        unless (defined $furthest_block) { # MUST        unless (defined $furthest_block) { # MUST
2300          splice @$open_elements, $formatting_element_i_in_open;          splice @{$self->{open_elements}}, $formatting_element_i_in_open;
2301          splice @$active_formatting_elements, $formatting_element_i_in_active, 1;          splice @$active_formatting_elements, $formatting_element_i_in_active, 1;
2302          !!!next-token;          !!!next-token;
2303          return;          return;
2304        }        }
2305                
2306        ## Step 4        ## Step 4
2307        my $common_ancestor_node = $open_elements->[$formatting_element_i_in_open - 1];        my $common_ancestor_node = $self->{open_elements}->[$formatting_element_i_in_open - 1];
2308                
2309        ## Step 5        ## Step 5
2310        my $furthest_block_parent = $furthest_block->[0]->parent_node;        my $furthest_block_parent = $furthest_block->[0]->parent_node;
# Line 1914  sub _construct_tree ($) { Line 2324  sub _construct_tree ($) {
2324        S7: {        S7: {
2325          ## Step 1          ## Step 1
2326          $node_i_in_open--;          $node_i_in_open--;
2327          $node = $open_elements->[$node_i_in_open];          $node = $self->{open_elements}->[$node_i_in_open];
2328                    
2329          ## Step 2          ## Step 2
2330          my $node_i_in_active;          my $node_i_in_active;
# Line 1925  sub _construct_tree ($) { Line 2335  sub _construct_tree ($) {
2335                last S7S2;                last S7S2;
2336              }              }
2337            }            }
2338            splice @$open_elements, $node_i_in_open, 1;            splice @{$self->{open_elements}}, $node_i_in_open, 1;
2339            redo S7;            redo S7;
2340          } # S7S2          } # S7S2
2341                    
# Line 1941  sub _construct_tree ($) { Line 2351  sub _construct_tree ($) {
2351          if ($node->[0]->has_child_nodes ()) {          if ($node->[0]->has_child_nodes ()) {
2352            my $clone = [$node->[0]->clone_node (0), $node->[1]];            my $clone = [$node->[0]->clone_node (0), $node->[1]];
2353            $active_formatting_elements->[$node_i_in_active] = $clone;            $active_formatting_elements->[$node_i_in_active] = $clone;
2354            $open_elements->[$node_i_in_open] = $clone;            $self->{open_elements}->[$node_i_in_open] = $clone;
2355            $node = $clone;            $node = $clone;
2356          }          }
2357                    
# Line 1983  sub _construct_tree ($) { Line 2393  sub _construct_tree ($) {
2393                
2394        ## Step 13        ## Step 13
2395        undef $i;        undef $i;
2396        OE: for (reverse 0..$#$open_elements) {        OE: for (reverse 0..$#{$self->{open_elements}}) {
2397          if ($open_elements->[$_]->[0] eq $formatting_element->[0]) {          if ($self->{open_elements}->[$_]->[0] eq $formatting_element->[0]) {
2398            splice @$open_elements, $_, 1;            splice @{$self->{open_elements}}, $_, 1;
2399            $i-- and last OE if defined $i;            $i-- and last OE if defined $i;
2400          } elsif ($open_elements->[$_]->[0] eq $furthest_block->[0]) {          } elsif ($self->{open_elements}->[$_]->[0] eq $furthest_block->[0]) {
2401            $i = $_;            $i = $_;
2402          }          }
2403        } # OE        } # OE
2404        splice @$open_elements, $i + 1, 1, $clone;        splice @{$self->{open_elements}}, $i + 1, 1, $clone;
2405                
2406        ## Step 14        ## Step 14
2407        redo FET;        redo FET;
# Line 1999  sub _construct_tree ($) { Line 2409  sub _construct_tree ($) {
2409    }; # $formatting_end_tag    }; # $formatting_end_tag
2410    
2411    my $insert_to_current = sub {    my $insert_to_current = sub {
2412      $open_elements->[-1]->[0]->append_child (shift);      $self->{open_elements}->[-1]->[0]->append_child ($_[0]);
2413    }; # $insert_to_current    }; # $insert_to_current
2414    
2415    my $insert_to_foster = sub {    my $insert_to_foster = sub {
# Line 2007  sub _construct_tree ($) { Line 2417  sub _construct_tree ($) {
2417                         if ({                         if ({
2418                              table => 1, tbody => 1, tfoot => 1,                              table => 1, tbody => 1, tfoot => 1,
2419                              thead => 1, tr => 1,                              thead => 1, tr => 1,
2420                             }->{$open_elements->[-1]->[1]}) {                             }->{$self->{open_elements}->[-1]->[1]}) {
2421                           # MUST                           # MUST
2422                           my $foster_parent_element;                           my $foster_parent_element;
2423                           my $next_sibling;                           my $next_sibling;
2424                           OE: for (reverse 0..$#$open_elements) {                           OE: for (reverse 0..$#{$self->{open_elements}}) {
2425                             if ($open_elements->[$_]->[1] eq 'table') {                             if ($self->{open_elements}->[$_]->[1] eq 'table') {
2426                               my $parent = $open_elements->[$_]->[0]->parent_node;                               my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
2427                               if (defined $parent and $parent->node_type == 1) {                               if (defined $parent and $parent->node_type == 1) {
2428                                 $foster_parent_element = $parent;                                 $foster_parent_element = $parent;
2429                                 $next_sibling = $open_elements->[$_]->[0];                                 $next_sibling = $self->{open_elements}->[$_]->[0];
2430                               } else {                               } else {
2431                                 $foster_parent_element                                 $foster_parent_element
2432                                   = $open_elements->[$_ - 1]->[0];                                   = $self->{open_elements}->[$_ - 1]->[0];
2433                               }                               }
2434                               last OE;                               last OE;
2435                             }                             }
2436                           } # OE                           } # OE
2437                           $foster_parent_element = $open_elements->[0]->[0]                           $foster_parent_element = $self->{open_elements}->[0]->[0]
2438                             unless defined $foster_parent_element;                             unless defined $foster_parent_element;
2439                           $foster_parent_element->insert_before                           $foster_parent_element->insert_before
2440                             ($child, $next_sibling);                             ($child, $next_sibling);
2441                         } else {                         } else {
2442                           $open_elements->[-1]->[0]->append_child ($child);                           $self->{open_elements}->[-1]->[0]->append_child ($child);
2443                         }                         }
2444    }; # $insert_to_foster    }; # $insert_to_foster
2445    
# Line 2037  sub _construct_tree ($) { Line 2447  sub _construct_tree ($) {
2447      my $insert = shift;      my $insert = shift;
2448      if ($token->{type} eq 'start tag') {      if ($token->{type} eq 'start tag') {
2449        if ($token->{tag_name} eq 'script') {        if ($token->{tag_name} eq 'script') {
2450          $script_start_tag->();          ## NOTE: This is an "as if in head" code clone
2451            $script_start_tag->($insert);
2452          return;          return;
2453        } elsif ($token->{tag_name} eq 'style') {        } elsif ($token->{tag_name} eq 'style') {
2454          $style_start_tag->();          ## NOTE: This is an "as if in head" code clone
2455            $parse_rcdata->('CDATA', $insert);
2456          return;          return;
2457        } elsif ({        } elsif ({
2458                  base => 1, link => 1, meta => 1,                  base => 1, link => 1, meta => 1,
2459                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2460          !!!parse-error ($token->{tag_name}.' in body');          ## NOTE: This is an "as if in head" code clone, only "-t" differs
2461          ## NOTE: This is an "as if in head" code clone          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2462          my $el;          pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
         !!!create-element ($el, $token->{tag_name}, $token->{attributes});  
         if (defined $head_element) {  
           $head_element->append_child ($el);  
         } else {  
           $insert->($el);  
         }  
           
2463          !!!next-token;          !!!next-token;
2464            ## TODO: Extracting |charset| from |meta|.
2465          return;          return;
2466        } elsif ($token->{tag_name} eq 'title') {        } elsif ($token->{tag_name} eq 'title') {
2467          !!!parse-error ('title in body');          !!!parse-error (type => 'in body:title');
2468          ## NOTE: There is an "as if in head" code clone          ## NOTE: This is an "as if in head" code clone
2469          my $title_el;          $parse_rcdata->('RCDATA', $insert);
         !!!create-element ($title_el, 'title', $token->{attributes});  
         (defined $head_element ? $head_element : $open_elements->[-1]->[0])  
           ->append_child ($title_el);  
         $self->{content_model_flag} = 'RCDATA';  
           
         my $text = '';  
         !!!next-token;  
         while ($token->{type} eq 'character') {  
           $text .= $token->{data};  
           !!!next-token;  
         }  
         if (length $text) {  
           $title_el->manakai_append_text ($text);  
         }  
           
         $self->{content_model_flag} = 'PCDATA';  
           
         if ($token->{type} eq 'end tag' and  
             $token->{tag_name} eq 'title') {  
           ## Ignore the token  
         } else {  
           !!!parse-error;  
           ## ISSUE: And ignore?  
         }  
         !!!next-token;  
2470          return;          return;
2471        } elsif ($token->{tag_name} eq 'body') {        } elsif ($token->{tag_name} eq 'body') {
2472          !!!parse-error;          !!!parse-error (type => 'in body:body');
2473                                
2474          if (@$open_elements == 1 or          if (@{$self->{open_elements}} == 1 or
2475              $open_elements->[1]->[1] ne 'body') {              $self->{open_elements}->[1]->[1] ne 'body') {
2476            ## Ignore the token            ## Ignore the token
2477          } else {          } else {
2478            my $body_el = $open_elements->[1]->[0];            my $body_el = $self->{open_elements}->[1]->[0];
2479            for my $attr_name (keys %{$token->{attributes}}) {            for my $attr_name (keys %{$token->{attributes}}) {
2480              unless ($body_el->has_attribute_ns (undef, $attr_name)) {              unless ($body_el->has_attribute_ns (undef, $attr_name)) {
2481                $body_el->set_attribute_ns                $body_el->set_attribute_ns
# Line 2112  sub _construct_tree ($) { Line 2493  sub _construct_tree ($) {
2493                  pre => 1,                  pre => 1,
2494                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2495          ## has a p element in scope          ## has a p element in scope
2496          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2497            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2498              !!!back-token;              !!!back-token;
2499              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2139  sub _construct_tree ($) { Line 2520  sub _construct_tree ($) {
2520          }          }
2521          return;          return;
2522        } elsif ($token->{tag_name} eq 'form') {        } elsif ($token->{tag_name} eq 'form') {
2523          if (defined $form_element) {          if (defined $self->{form_element}) {
2524            !!!parse-error;            !!!parse-error (type => 'in form:form');
2525            ## Ignore the token            ## Ignore the token
2526              !!!next-token;
2527              return;
2528          } else {          } else {
2529            ## has a p element in scope            ## has a p element in scope
2530            INSCOPE: for (reverse @$open_elements) {            INSCOPE: for (reverse @{$self->{open_elements}}) {
2531              if ($_->[1] eq 'p') {              if ($_->[1] eq 'p') {
2532                !!!back-token;                !!!back-token;
2533                $token = {type => 'end tag', tag_name => 'p'};                $token = {type => 'end tag', tag_name => 'p'};
# Line 2158  sub _construct_tree ($) { Line 2541  sub _construct_tree ($) {
2541            } # INSCOPE            } # INSCOPE
2542                            
2543            !!!insert-element-t ($token->{tag_name}, $token->{attributes});            !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2544            $form_element = $open_elements->[-1]->[0];            $self->{form_element} = $self->{open_elements}->[-1]->[0];
2545            !!!next-token;            !!!next-token;
2546            return;            return;
2547          }          }
2548        } elsif ($token->{tag_name} eq 'li') {        } elsif ($token->{tag_name} eq 'li') {
2549          ## has a p element in scope          ## has a p element in scope
2550          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2551            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2552              !!!back-token;              !!!back-token;
2553              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2179  sub _construct_tree ($) { Line 2562  sub _construct_tree ($) {
2562                        
2563          ## Step 1          ## Step 1
2564          my $i = -1;          my $i = -1;
2565          my $node = $open_elements->[$i];          my $node = $self->{open_elements}->[$i];
2566          LI: {          LI: {
2567            ## Step 2            ## Step 2
2568            if ($node->[1] eq 'li') {            if ($node->[1] eq 'li') {
2569              splice @$open_elements, $i;              if ($i != -1) {
2570                  !!!parse-error (type => 'end tag missing:'.
2571                                  $self->{open_elements}->[-1]->[1]);
2572                  ## TODO: test
2573                }
2574                splice @{$self->{open_elements}}, $i;
2575              last LI;              last LI;
2576            }            }
2577                        
# Line 2198  sub _construct_tree ($) { Line 2586  sub _construct_tree ($) {
2586                        
2587            ## Step 4            ## Step 4
2588            $i--;            $i--;
2589            $node = $open_elements->[$i];            $node = $self->{open_elements}->[$i];
2590            redo LI;            redo LI;
2591          } # LI          } # LI
2592                        
# Line 2207  sub _construct_tree ($) { Line 2595  sub _construct_tree ($) {
2595          return;          return;
2596        } elsif ($token->{tag_name} eq 'dd' or $token->{tag_name} eq 'dt') {        } elsif ($token->{tag_name} eq 'dd' or $token->{tag_name} eq 'dt') {
2597          ## has a p element in scope          ## has a p element in scope
2598          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2599            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2600              !!!back-token;              !!!back-token;
2601              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2222  sub _construct_tree ($) { Line 2610  sub _construct_tree ($) {
2610                        
2611          ## Step 1          ## Step 1
2612          my $i = -1;          my $i = -1;
2613          my $node = $open_elements->[$i];          my $node = $self->{open_elements}->[$i];
2614          LI: {          LI: {
2615            ## Step 2            ## Step 2
2616            if ($node->[1] eq 'dt' or $node->[1] eq 'dd') {            if ($node->[1] eq 'dt' or $node->[1] eq 'dd') {
2617              splice @$open_elements, $i;              if ($i != -1) {
2618                  !!!parse-error (type => 'end tag missing:'.
2619                                  $self->{open_elements}->[-1]->[1]);
2620                  ## TODO: test
2621                }
2622                splice @{$self->{open_elements}}, $i;
2623              last LI;              last LI;
2624            }            }
2625                        
# Line 2241  sub _construct_tree ($) { Line 2634  sub _construct_tree ($) {
2634                        
2635            ## Step 4            ## Step 4
2636            $i--;            $i--;
2637            $node = $open_elements->[$i];            $node = $self->{open_elements}->[$i];
2638            redo LI;            redo LI;
2639          } # LI          } # LI
2640                        
# Line 2250  sub _construct_tree ($) { Line 2643  sub _construct_tree ($) {
2643          return;          return;
2644        } elsif ($token->{tag_name} eq 'plaintext') {        } elsif ($token->{tag_name} eq 'plaintext') {
2645          ## has a p element in scope          ## has a p element in scope
2646          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2647            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2648              !!!back-token;              !!!back-token;
2649              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2273  sub _construct_tree ($) { Line 2666  sub _construct_tree ($) {
2666                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
2667                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2668          ## has a p element in scope          ## has a p element in scope
2669          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2670            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
2671            if ($node->[1] eq 'p') {            if ($node->[1] eq 'p') {
2672              !!!back-token;              !!!back-token;
2673              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2287  sub _construct_tree ($) { Line 2680  sub _construct_tree ($) {
2680            }            }
2681          } # INSCOPE          } # INSCOPE
2682                        
2683            ## NOTE: See <http://html5.org/tools/web-apps-tracker?from=925&to=926>
2684          ## has an element in scope          ## has an element in scope
2685          my $i;          #my $i;
2686          INSCOPE: for (reverse 0..$#$open_elements) {          #INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2687            my $node = $open_elements->[$_];          #  my $node = $self->{open_elements}->[$_];
2688            if ({          #  if ({
2689                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,          #       h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
2690                }->{$node->[1]}) {          #      }->{$node->[1]}) {
2691              $i = $_;          #    $i = $_;
2692              last INSCOPE;          #    last INSCOPE;
2693            } elsif ({          #  } elsif ({
2694                      table => 1, caption => 1, td => 1, th => 1,          #            table => 1, caption => 1, td => 1, th => 1,
2695                      button => 1, marquee => 1, object => 1, html => 1,          #            button => 1, marquee => 1, object => 1, html => 1,
2696                     }->{$node->[1]}) {          #           }->{$node->[1]}) {
2697              last INSCOPE;          #    last INSCOPE;
2698            }          #  }
2699          } # INSCOPE          #} # INSCOPE
2700                      #  
2701          if (defined $i) {          #if (defined $i) {
2702            !!!parse-error;          #  !!! parse-error (type => 'in hn:hn');
2703            splice @$open_elements, $i;          #  splice @{$self->{open_elements}}, $i;
2704          }          #}
2705                        
2706          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2707                        
# Line 2317  sub _construct_tree ($) { Line 2711  sub _construct_tree ($) {
2711          AFE: for my $i (reverse 0..$#$active_formatting_elements) {          AFE: for my $i (reverse 0..$#$active_formatting_elements) {
2712            my $node = $active_formatting_elements->[$i];            my $node = $active_formatting_elements->[$i];
2713            if ($node->[1] eq 'a') {            if ($node->[1] eq 'a') {
2714              !!!parse-error ('a in a');              !!!parse-error (type => 'in a:a');
2715                            
2716              !!!back-token;              !!!back-token;
2717              $token = {type => 'end tag', tag_name => 'a'};              $token = {type => 'end tag', tag_name => 'a'};
# Line 2329  sub _construct_tree ($) { Line 2723  sub _construct_tree ($) {
2723                  last AFE2;                  last AFE2;
2724                }                }
2725              } # AFE2              } # AFE2
2726              OE: for (reverse 0..$#$open_elements) {              OE: for (reverse 0..$#{$self->{open_elements}}) {
2727                if ($open_elements->[$_]->[0] eq $node->[0]) {                if ($self->{open_elements}->[$_]->[0] eq $node->[0]) {
2728                  splice @$open_elements, $_, 1;                  splice @{$self->{open_elements}}, $_, 1;
2729                  last OE;                  last OE;
2730                }                }
2731              } # OE              } # OE
# Line 2344  sub _construct_tree ($) { Line 2738  sub _construct_tree ($) {
2738          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2739    
2740          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2741          push @$active_formatting_elements, $open_elements->[-1];          push @$active_formatting_elements, $self->{open_elements}->[-1];
2742    
2743          !!!next-token;          !!!next-token;
2744          return;          return;
2745        } elsif ({        } elsif ({
2746                  b => 1, big => 1, em => 1, font => 1, i => 1,                  b => 1, big => 1, em => 1, font => 1, i => 1,
2747                  nobr => 1, s => 1, small => 1, strile => 1,                  s => 1, small => 1, strile => 1,
2748                  strong => 1, tt => 1, u => 1,                  strong => 1, tt => 1, u => 1,
2749                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2750          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2751                    
2752          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2753          push @$active_formatting_elements, $open_elements->[-1];          push @$active_formatting_elements, $self->{open_elements}->[-1];
2754            
2755            !!!next-token;
2756            return;
2757          } elsif ($token->{tag_name} eq 'nobr') {
2758            $reconstruct_active_formatting_elements->($insert_to_current);
2759    
2760            ## has a |nobr| element in scope
2761            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2762              my $node = $self->{open_elements}->[$_];
2763              if ($node->[1] eq 'nobr') {
2764                !!!back-token;
2765                $token = {type => 'end tag', tag_name => 'nobr'};
2766                return;
2767              } elsif ({
2768                        table => 1, caption => 1, td => 1, th => 1,
2769                        button => 1, marquee => 1, object => 1, html => 1,
2770                       }->{$node->[1]}) {
2771                last INSCOPE;
2772              }
2773            } # INSCOPE
2774            
2775            !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2776            push @$active_formatting_elements, $self->{open_elements}->[-1];
2777                    
2778          !!!next-token;          !!!next-token;
2779          return;          return;
2780        } elsif ($token->{tag_name} eq 'button') {        } elsif ($token->{tag_name} eq 'button') {
2781          ## has a button element in scope          ## has a button element in scope
2782          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2783            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
2784            if ($node->[1] eq 'button') {            if ($node->[1] eq 'button') {
2785              !!!parse-error;              !!!parse-error (type => 'in button:button');
2786              !!!back-token;              !!!back-token;
2787              $token = {type => 'end tag', tag_name => 'button'};              $token = {type => 'end tag', tag_name => 'button'};
2788              return;              return;
# Line 2395  sub _construct_tree ($) { Line 2812  sub _construct_tree ($) {
2812          return;          return;
2813        } elsif ($token->{tag_name} eq 'xmp') {        } elsif ($token->{tag_name} eq 'xmp') {
2814          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2815                    $parse_rcdata->('CDATA', $insert);
         !!!insert-element-t ($token->{tag_name}, $token->{attributes});  
           
         $self->{content_model_flag} = 'CDATA';  
           
         !!!next-token;  
2816          return;          return;
2817        } elsif ($token->{tag_name} eq 'table') {        } elsif ($token->{tag_name} eq 'table') {
2818          ## has a p element in scope          ## has a p element in scope
2819          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2820            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2821              !!!back-token;              !!!back-token;
2822              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2419  sub _construct_tree ($) { Line 2831  sub _construct_tree ($) {
2831                        
2832          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2833                        
2834          $insertion_mode = 'in table';          $self->{insertion_mode} = 'in table';
2835                        
2836          !!!next-token;          !!!next-token;
2837          return;          return;
# Line 2429  sub _construct_tree ($) { Line 2841  sub _construct_tree ($) {
2841                  image => 1,                  image => 1,
2842                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2843          if ($token->{tag_name} eq 'image') {          if ($token->{tag_name} eq 'image') {
2844            !!!parse-error;            !!!parse-error (type => 'image');
2845            $token->{tag_name} = 'img';            $token->{tag_name} = 'img';
2846          }          }
2847                    
2848          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2849                    
2850          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2851          pop @$open_elements;          pop @{$self->{open_elements}};
2852                    
2853          !!!next-token;          !!!next-token;
2854          return;          return;
2855        } elsif ($token->{tag_name} eq 'hr') {        } elsif ($token->{tag_name} eq 'hr') {
2856          ## has a p element in scope          ## has a p element in scope
2857          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2858            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2859              !!!back-token;              !!!back-token;
2860              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2456  sub _construct_tree ($) { Line 2868  sub _construct_tree ($) {
2868          } # INSCOPE          } # INSCOPE
2869                        
2870          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2871          pop @$open_elements;          pop @{$self->{open_elements}};
2872                        
2873          !!!next-token;          !!!next-token;
2874          return;          return;
# Line 2464  sub _construct_tree ($) { Line 2876  sub _construct_tree ($) {
2876          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2877                    
2878          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2879          ## TODO: associate with $form_element if defined          ## TODO: associate with $self->{form_element} if defined
2880          pop @$open_elements;          pop @{$self->{open_elements}};
2881                    
2882          !!!next-token;          !!!next-token;
2883          return;          return;
2884        } elsif ($token->{tag_name} eq 'isindex') {        } elsif ($token->{tag_name} eq 'isindex') {
2885          !!!parse-error;          !!!parse-error (type => 'isindex');
2886                    
2887          if (defined $form_element) {          if (defined $self->{form_element}) {
2888            ## Ignore the token            ## Ignore the token
2889            !!!next-token;            !!!next-token;
2890            return;            return;
2891          } else {          } else {
2892            my $at = $token->{attributes};            my $at = $token->{attributes};
2893              my $form_attrs;
2894              $form_attrs->{action} = $at->{action} if $at->{action};
2895              my $prompt_attr = $at->{prompt};
2896            $at->{name} = {name => 'name', value => 'isindex'};            $at->{name} = {name => 'name', value => 'isindex'};
2897              delete $at->{action};
2898              delete $at->{prompt};
2899            my @tokens = (            my @tokens = (
2900                          {type => 'start tag', tag_name => 'form'},                          {type => 'start tag', tag_name => 'form',
2901                             attributes => $form_attrs},
2902                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2903                          {type => 'start tag', tag_name => 'p'},                          {type => 'start tag', tag_name => 'p'},
2904                          {type => 'start tag', tag_name => 'label'},                          {type => 'start tag', tag_name => 'label'},
2905                          {type => 'character',                         );
2906                           data => 'This is a searchable index. Insert your search keywords here: '}, # SHOULD            if ($prompt_attr) {
2907                          ## TODO: make this configurable              push @tokens, {type => 'character', data => $prompt_attr->{value}};
2908              } else {
2909                push @tokens, {type => 'character',
2910                               data => 'This is a searchable index. Insert your search keywords here: '}; # SHOULD
2911                ## TODO: make this configurable
2912              }
2913              push @tokens,
2914                          {type => 'start tag', tag_name => 'input', attributes => $at},                          {type => 'start tag', tag_name => 'input', attributes => $at},
2915                          #{type => 'character', data => ''}, # SHOULD                          #{type => 'character', data => ''}, # SHOULD
2916                          {type => 'end tag', tag_name => 'label'},                          {type => 'end tag', tag_name => 'label'},
2917                          {type => 'end tag', tag_name => 'p'},                          {type => 'end tag', tag_name => 'p'},
2918                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2919                          {type => 'end tag', tag_name => 'form'},                          {type => 'end tag', tag_name => 'form'};
                        );  
2920            $token = shift @tokens;            $token = shift @tokens;
2921            !!!back-token (@tokens);            !!!back-token (@tokens);
2922            return;            return;
2923          }          }
2924        } elsif ({        } elsif ($token->{tag_name} eq 'textarea') {
                 textarea => 1,  
                 noembed => 1,  
                 noframes => 1,  
                 noscript => 0, ## TODO: 1 if scripting is enabled  
                }->{$token->{tag_name}}) {  
2925          my $tag_name = $token->{tag_name};          my $tag_name = $token->{tag_name};
2926          my $el;          my $el;
2927          !!!create-element ($el, $token->{tag_name}, $token->{attributes});          !!!create-element ($el, $token->{tag_name}, $token->{attributes});
2928                    
2929          if ($token->{tag_name} eq 'textarea') {          ## TODO: $self->{form_element} if defined
2930            ## TODO: form_element if defined          $self->{content_model_flag} = 'RCDATA';
2931            $self->{content_model_flag} = 'RCDATA';          delete $self->{escape}; # MUST
         } else {  
           $self->{content_model_flag} = 'CDATA';  
         }  
2932                    
2933          $insert->($el);          $insert->($el);
2934                    
2935          my $text = '';          my $text = '';
2936          !!!next-token;          !!!next-token;
2937            if ($token->{type} eq 'character') {
2938              $token->{data} =~ s/^\x0A//;
2939              unless (length $token->{data}) {
2940                !!!next-token;
2941              }
2942            }
2943          while ($token->{type} eq 'character') {          while ($token->{type} eq 'character') {
2944            $text .= $token->{data};            $text .= $token->{data};
2945            !!!next-token;            !!!next-token;
# Line 2533  sub _construct_tree ($) { Line 2954  sub _construct_tree ($) {
2954              $token->{tag_name} eq $tag_name) {              $token->{tag_name} eq $tag_name) {
2955            ## Ignore the token            ## Ignore the token
2956          } else {          } else {
2957            !!!parse-error;            !!!parse-error (type => 'in RCDATA:#'.$token->{type});
           ## ISSUE: And ignore?  
2958          }          }
2959          !!!next-token;          !!!next-token;
2960          return;          return;
2961          } elsif ({
2962                    iframe => 1,
2963                    noembed => 1,
2964                    noframes => 1,
2965                    noscript => 0, ## TODO: 1 if scripting is enabled
2966                   }->{$token->{tag_name}}) {
2967            $parse_rcdata->('CDATA', $insert);
2968            return;
2969        } elsif ($token->{tag_name} eq 'select') {        } elsif ($token->{tag_name} eq 'select') {
2970          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2971                    
2972          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2973                    
2974          $insertion_mode = 'in select';          $self->{insertion_mode} = 'in select';
2975          !!!next-token;          !!!next-token;
2976          return;          return;
2977        } elsif ({        } elsif ({
# Line 2552  sub _construct_tree ($) { Line 2980  sub _construct_tree ($) {
2980                  tbody => 1, td => 1, tfoot => 1, th => 1,                  tbody => 1, td => 1, tfoot => 1, th => 1,
2981                  thead => 1, tr => 1,                  thead => 1, tr => 1,
2982                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2983          !!!parse-error;          !!!parse-error (type => 'in body:'.$token->{tag_name});
2984          ## Ignore the token          ## Ignore the token
2985          !!!next-token;          !!!next-token;
2986          return;          return;
# Line 2568  sub _construct_tree ($) { Line 2996  sub _construct_tree ($) {
2996        }        }
2997      } elsif ($token->{type} eq 'end tag') {      } elsif ($token->{type} eq 'end tag') {
2998        if ($token->{tag_name} eq 'body') {        if ($token->{tag_name} eq 'body') {
2999          if (@$open_elements > 1 and $open_elements->[1]->[1] eq 'body') {          if (@{$self->{open_elements}} > 1 and
3000            ## ISSUE: There is an issue in the spec.              $self->{open_elements}->[1]->[1] eq 'body') {
3001            if ($open_elements->[-1]->[1] ne 'body') {            for (@{$self->{open_elements}}) {
3002              !!!parse-error;              unless ({
3003                           dd => 1, dt => 1, li => 1, p => 1, td => 1,
3004                           th => 1, tr => 1, body => 1, html => 1,
3005                        }->{$_->[1]}) {
3006                  !!!parse-error (type => 'not closed:'.$_->[1]);
3007                }
3008            }            }
3009            $insertion_mode = 'after body';  
3010              $self->{insertion_mode} = 'after body';
3011            !!!next-token;            !!!next-token;
3012            return;            return;
3013          } else {          } else {
3014            !!!parse-error;            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3015            ## Ignore the token            ## Ignore the token
3016            !!!next-token;            !!!next-token;
3017            return;            return;
3018          }          }
3019        } elsif ($token->{tag_name} eq 'html') {        } elsif ($token->{tag_name} eq 'html') {
3020          if (@$open_elements > 1 and $open_elements->[1]->[1] eq 'body') {          if (@{$self->{open_elements}} > 1 and $self->{open_elements}->[1]->[1] eq 'body') {
3021            ## ISSUE: There is an issue in the spec.            ## ISSUE: There is an issue in the spec.
3022            if ($open_elements->[-1]->[1] ne 'body') {            if ($self->{open_elements}->[-1]->[1] ne 'body') {
3023              !!!parse-error;              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[1]->[1]);
3024            }            }
3025            $insertion_mode = 'after body';            $self->{insertion_mode} = 'after body';
3026            ## reprocess            ## reprocess
3027            return;            return;
3028          } else {          } else {
3029            !!!parse-error;            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3030            ## Ignore the token            ## Ignore the token
3031            !!!next-token;            !!!next-token;
3032            return;            return;
# Line 2601  sub _construct_tree ($) { Line 3035  sub _construct_tree ($) {
3035                  address => 1, blockquote => 1, center => 1, dir => 1,                  address => 1, blockquote => 1, center => 1, dir => 1,
3036                  div => 1, dl => 1, fieldset => 1, listing => 1,                  div => 1, dl => 1, fieldset => 1, listing => 1,
3037                  menu => 1, ol => 1, pre => 1, ul => 1,                  menu => 1, ol => 1, pre => 1, ul => 1,
                 form => 1,  
3038                  p => 1,                  p => 1,
3039                  dd => 1, dt => 1, li => 1,                  dd => 1, dt => 1, li => 1,
3040                  button => 1, marquee => 1, object => 1,                  button => 1, marquee => 1, object => 1,
3041                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3042          ## has an element in scope          ## has an element in scope
3043          my $i;          my $i;
3044          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3045            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
3046            if ($node->[1] eq $token->{tag_name}) {            if ($node->[1] eq $token->{tag_name}) {
3047              ## generate implied end tags              ## generate implied end tags
3048              if ({              if ({
# Line 2618  sub _construct_tree ($) { Line 3051  sub _construct_tree ($) {
3051                   li => ($token->{tag_name} ne 'li'),                   li => ($token->{tag_name} ne 'li'),
3052                   p => ($token->{tag_name} ne 'p'),                   p => ($token->{tag_name} ne 'p'),
3053                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3054                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3055                !!!back-token;                !!!back-token;
3056                $token = {type => 'end tag',                $token = {type => 'end tag',
3057                          tag_name => $open_elements->[-1]->[1]}; # MUST                          tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3058                return;                return;
3059              }              }
3060              $i = $_;              $i = $_;
# Line 2634  sub _construct_tree ($) { Line 3067  sub _construct_tree ($) {
3067            }            }
3068          } # INSCOPE          } # INSCOPE
3069                    
3070          if ($open_elements->[-1]->[1] ne $token->{tag_name}) {          if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
3071            !!!parse-error;            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3072          }          }
3073                    
3074          splice @$open_elements, $i if defined $i;          splice @{$self->{open_elements}}, $i if defined $i;
         undef $form_element if $token->{tag_name} eq 'form';  
3075          $clear_up_to_marker->()          $clear_up_to_marker->()
3076            if {            if {
3077              button => 1, marquee => 1, object => 1,              button => 1, marquee => 1, object => 1,
3078            }->{$token->{tag_name}};            }->{$token->{tag_name}};
3079          !!!next-token;          !!!next-token;
3080          return;          return;
3081          } elsif ($token->{tag_name} eq 'form') {
3082            ## has an element in scope
3083            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3084              my $node = $self->{open_elements}->[$_];
3085              if ($node->[1] eq $token->{tag_name}) {
3086                ## generate implied end tags
3087                if ({
3088                     dd => 1, dt => 1, li => 1, p => 1,
3089                     td => 1, th => 1, tr => 1,
3090                    }->{$self->{open_elements}->[-1]->[1]}) {
3091                  !!!back-token;
3092                  $token = {type => 'end tag',
3093                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3094                  return;
3095                }
3096                last INSCOPE;
3097              } elsif ({
3098                        table => 1, caption => 1, td => 1, th => 1,
3099                        button => 1, marquee => 1, object => 1, html => 1,
3100                       }->{$node->[1]}) {
3101                last INSCOPE;
3102              }
3103            } # INSCOPE
3104            
3105            if ($self->{open_elements}->[-1]->[1] eq $token->{tag_name}) {
3106              pop @{$self->{open_elements}};
3107            } else {
3108              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3109            }
3110    
3111            undef $self->{form_element};
3112            !!!next-token;
3113            return;
3114        } elsif ({        } elsif ({
3115                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
3116                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3117          ## has an element in scope          ## has an element in scope
3118          my $i;          my $i;
3119          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3120            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
3121            if ({            if ({
3122                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
3123                }->{$node->[1]}) {                }->{$node->[1]}) {
# Line 2660  sub _construct_tree ($) { Line 3125  sub _construct_tree ($) {
3125              if ({              if ({
3126                   dd => 1, dt => 1, li => 1, p => 1,                   dd => 1, dt => 1, li => 1, p => 1,
3127                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3128                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3129                !!!back-token;                !!!back-token;
3130                $token = {type => 'end tag',                $token = {type => 'end tag',
3131                          tag_name => $open_elements->[-1]->[1]}; # MUST                          tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3132                return;                return;
3133              }              }
3134              $i = $_;              $i = $_;
# Line 2676  sub _construct_tree ($) { Line 3141  sub _construct_tree ($) {
3141            }            }
3142          } # INSCOPE          } # INSCOPE
3143                    
3144          if ($open_elements->[-1]->[1] ne $token->{tag_name}) {          if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
3145            !!!parse-error;            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3146          }          }
3147                    
3148          splice @$open_elements, $i if defined $i;          splice @{$self->{open_elements}}, $i if defined $i;
3149          !!!next-token;          !!!next-token;
3150          return;          return;
3151        } elsif ({        } elsif ({
# Line 2690  sub _construct_tree ($) { Line 3155  sub _construct_tree ($) {
3155                  strong => 1, tt => 1, u => 1,                  strong => 1, tt => 1, u => 1,
3156                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3157          $formatting_end_tag->($token->{tag_name});          $formatting_end_tag->($token->{tag_name});
3158    ## TODO: <http://html5.org/tools/web-apps-tracker?from=883&to=884>
3159          return;          return;
3160        } elsif ({        } elsif ({
3161                  caption => 1, col => 1, colgroup => 1, frame => 1,                  caption => 1, col => 1, colgroup => 1, frame => 1,
# Line 2698  sub _construct_tree ($) { Line 3164  sub _construct_tree ($) {
3164                  thead => 1, tr => 1,                  thead => 1, tr => 1,
3165                  area => 1, basefont => 1, bgsound => 1, br => 1,                  area => 1, basefont => 1, bgsound => 1, br => 1,
3166                  embed => 1, hr => 1, iframe => 1, image => 1,                  embed => 1, hr => 1, iframe => 1, image => 1,
3167                  img => 1, input => 1, isindex=> 1, noembed => 1,                  img => 1, input => 1, isindex => 1, noembed => 1,
3168                  noframes => 1, param => 1, select => 1, spacer => 1,                  noframes => 1, param => 1, select => 1, spacer => 1,
3169                  table => 1, textarea => 1, wbr => 1,                  table => 1, textarea => 1, wbr => 1,
3170                  noscript => 0, ## TODO: if scripting is enabled                  noscript => 0, ## TODO: if scripting is enabled
3171                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3172          !!!parse-error;          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3173          ## Ignore the token          ## Ignore the token
3174          !!!next-token;          !!!next-token;
3175          return;          return;
# Line 2713  sub _construct_tree ($) { Line 3179  sub _construct_tree ($) {
3179        } else {        } else {
3180          ## Step 1          ## Step 1
3181          my $node_i = -1;          my $node_i = -1;
3182          my $node = $open_elements->[$node_i];          my $node = $self->{open_elements}->[$node_i];
3183    
3184          ## Step 2          ## Step 2
3185          S2: {          S2: {
# Line 2723  sub _construct_tree ($) { Line 3189  sub _construct_tree ($) {
3189              if ({              if ({
3190                   dd => 1, dt => 1, li => 1, p => 1,                   dd => 1, dt => 1, li => 1, p => 1,
3191                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3192                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3193                !!!back-token;                !!!back-token;
3194                $token = {type => 'end tag',                $token = {type => 'end tag',
3195                          tag_name => $open_elements->[-1]->[1]}; # MUST                          tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3196                return;                return;
3197              }              }
3198                    
3199              ## Step 2              ## Step 2
3200              if ($token->{tag_name} ne $open_elements->[-1]->[1]) {              if ($token->{tag_name} ne $self->{open_elements}->[-1]->[1]) {
3201                !!!parse-error;                !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3202              }              }
3203                            
3204              ## Step 3              ## Step 3
3205              splice @$open_elements, $node_i;              splice @{$self->{open_elements}}, $node_i;
3206    
3207                !!!next-token;
3208              last S2;              last S2;
3209            } else {            } else {
3210              ## Step 3              ## Step 3
# Line 2744  sub _construct_tree ($) { Line 3212  sub _construct_tree ($) {
3212                  #not $phrasing_category->{$node->[1]} and                  #not $phrasing_category->{$node->[1]} and
3213                  ($special_category->{$node->[1]} or                  ($special_category->{$node->[1]} or
3214                   $scoping_category->{$node->[1]})) {                   $scoping_category->{$node->[1]})) {
3215                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3216                ## Ignore the token                ## Ignore the token
3217                !!!next-token;                !!!next-token;
3218                last S2;                last S2;
# Line 2753  sub _construct_tree ($) { Line 3221  sub _construct_tree ($) {
3221                        
3222            ## Step 4            ## Step 4
3223            $node_i--;            $node_i--;
3224            $node = $open_elements->[$node_i];            $node = $self->{open_elements}->[$node_i];
3225                        
3226            ## Step 5;            ## Step 5;
3227            redo S2;            redo S2;
3228          } # S2          } # S2
3229            return;
3230        }        }
3231      }      }
3232    }; # $in_body    }; # $in_body
3233    
3234    B: {    B: {
3235      if ($phase eq 'initial') {      if ($phase eq 'main') {
3236        if ($token->{type} eq 'DOCTYPE') {        if ($token->{type} eq 'DOCTYPE') {
3237          if ($token->{error}) {          !!!parse-error (type => 'in html:#DOCTYPE');
           ## ISSUE: Spec currently left this case undefined.  
           !!!parse-error ('bogus DOCTYPE');  
         }  
         my $doctype = $self->{document}->create_document_type_definition  
           ($token->{name});  
         $self->{document}->append_child ($doctype);  
         $phase = 'root element';  
         !!!next-token;  
         redo B;  
       } elsif ({  
                 comment => 1,  
                 'start tag' => 1,  
                 'end tag' => 1,  
                 'end-of-file' => 1,  
                }->{$token->{type}}) {  
         ## ISSUE: Spec currently left this case undefined.  
         !!!parse-error ('missing DOCTYPE');  
         $phase = 'root element';  
         ## reprocess  
         redo B;  
       } elsif ($token->{type} eq 'character') {  
         if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {  
           $self->{document}->manakai_append_text ($1);  
           ## ISSUE: DOM3 Core does not allow Document > Text  
           unless (length $token->{data}) {  
             ## Stay in the phase  
             !!!next-token;  
             redo B;  
           }  
         }  
         ## ISSUE: Spec currently left this case undefined.  
         !!!parse-error ('missing DOCTYPE');  
         $phase = 'root element';  
         ## reprocess  
         redo B;  
       } else {  
         die "$0: $token->{type}: Unknown token";  
       }  
     } elsif ($phase eq 'root element') {  
       if ($token->{type} eq 'DOCTYPE') {  
         !!!parse-error;  
         ## Ignore the token  
         ## Stay in the phase  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'comment') {  
         my $comment = $self->{document}->create_comment ($token->{data});  
         $self->{document}->append_child ($comment);  
         ## Stay in the phase  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'character') {  
         if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {  
           $self->{document}->manakai_append_text ($1);  
           ## ISSUE: DOM3 Core does not allow Document > Text  
           unless (length $token->{data}) {  
             ## Stay in the phase  
             !!!next-token;  
             redo B;  
           }  
         }  
         #  
       } elsif ({  
                 'start tag' => 1,  
                 'end tag' => 1,  
                 'end-of-file' => 1,  
                }->{$token->{type}}) {  
         ## ISSUE: There is an issue in the spec  
         #  
       } else {  
         die "$0: $token->{type}: Unknown token";  
       }  
       my $root_element; !!!create-element ($root_element, 'html');  
       $self->{document}->append_child ($root_element);  
       $open_elements = [[$root_element, 'html']];  
       $phase = 'main';  
       ## reprocess  
       redo B;  
     } elsif ($phase eq 'main') {  
       if ($token->{type} eq 'DOCTYPE') {  
         !!!parse-error;  
3238          ## Ignore the token          ## Ignore the token
3239          ## Stay in the phase          ## Stay in the phase
3240          !!!next-token;          !!!next-token;
# Line 2854  sub _construct_tree ($) { Line 3242  sub _construct_tree ($) {
3242        } elsif ($token->{type} eq 'start tag' and        } elsif ($token->{type} eq 'start tag' and
3243                 $token->{tag_name} eq 'html') {                 $token->{tag_name} eq 'html') {
3244          ## TODO: unless it is the first start tag token, parse-error          ## TODO: unless it is the first start tag token, parse-error
3245          my $top_el = $open_elements->[0]->[0];          my $top_el = $self->{open_elements}->[0]->[0];
3246          for my $attr_name (keys %{$token->{attributes}}) {          for my $attr_name (keys %{$token->{attributes}}) {
3247            unless ($top_el->has_attribute_ns (undef, $attr_name)) {            unless ($top_el->has_attribute_ns (undef, $attr_name)) {
3248              $top_el->set_attribute_ns              $top_el->set_attribute_ns
# Line 2868  sub _construct_tree ($) { Line 3256  sub _construct_tree ($) {
3256          ## Generate implied end tags          ## Generate implied end tags
3257          if ({          if ({
3258               dd => 1, dt => 1, li => 1, p => 1, td => 1, th => 1, tr => 1,               dd => 1, dt => 1, li => 1, p => 1, td => 1, th => 1, tr => 1,
3259              }->{$open_elements->[-1]->[1]}) {              }->{$self->{open_elements}->[-1]->[1]}) {
3260            !!!back-token;            !!!back-token;
3261            $token = {type => 'end tag', tag_name => $open_elements->[-1]->[1]};            $token = {type => 'end tag', tag_name => $self->{open_elements}->[-1]->[1]};
3262            redo B;            redo B;
3263          }          }
3264                    
3265          if (@$open_elements > 2 or          if (@{$self->{open_elements}} > 2 or
3266              (@$open_elements == 2 and $open_elements->[1]->[1] ne 'body')) {              (@{$self->{open_elements}} == 2 and $self->{open_elements}->[1]->[1] ne 'body')) {
3267            !!!parse-error;            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3268          } else {          } elsif (defined $self->{inner_html_node} and
3269            ## TODO: inner_html parser and @$open_elements > 1 and $open_elements->[1] ne 'body', then parse-error                   @{$self->{open_elements}} > 1 and
3270                     $self->{open_elements}->[1]->[1] ne 'body') {
3271              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3272          }          }
3273    
3274          ## Stop parsing          ## Stop parsing
# Line 2886  sub _construct_tree ($) { Line 3276  sub _construct_tree ($) {
3276    
3277          ## ISSUE: There is an issue in the spec.          ## ISSUE: There is an issue in the spec.
3278        } else {        } else {
3279          if ($insertion_mode eq 'before head') {          if ($self->{insertion_mode} eq 'before head') {
3280            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3281              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3282                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3283                unless (length $token->{data}) {                unless (length $token->{data}) {
3284                  !!!next-token;                  !!!next-token;
3285                  redo B;                  redo B;
3286                }                }
3287              }              }
3288              ## As if <head>              ## As if <head>
3289              !!!create-element ($head_element, 'head');              !!!create-element ($self->{head_element}, 'head');
3290              $open_elements->[-1]->[0]->append_child ($head_element);              $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
3291              push @$open_elements, [$head_element, 'head'];              push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3292              $insertion_mode = 'in head';              $self->{insertion_mode} = 'in head';
3293              ## reprocess              ## reprocess
3294              redo B;              redo B;
3295            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3296              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3297              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3298              !!!next-token;              !!!next-token;
3299              redo B;              redo B;
3300            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3301              my $attr = $token->{tag_name} eq 'head' ? $token->{attributes} : {};              my $attr = $token->{tag_name} eq 'head' ? $token->{attributes} : {};
3302              !!!create-element ($head_element, 'head', $attr);              !!!create-element ($self->{head_element}, 'head', $attr);
3303              $open_elements->[-1]->[0]->append_child ($head_element);              $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
3304              push @$open_elements, [$head_element, 'head'];              push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3305              $insertion_mode = 'in head';              $self->{insertion_mode} = 'in head';
3306              if ($token->{tag_name} eq 'head') {              if ($token->{tag_name} eq 'head') {
3307                !!!next-token;                !!!next-token;
3308              #} elsif ({              #} elsif ({
# Line 2925  sub _construct_tree ($) { Line 3315  sub _construct_tree ($) {
3315              }              }
3316              redo B;              redo B;
3317            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3318              if ($token->{tag_name} eq 'html') {              if ({head => 1, body => 1, html => 1}->{$token->{tag_name}}) {
3319                ## As if <head>                ## As if <head>
3320                !!!create-element ($head_element, 'head');                !!!create-element ($self->{head_element}, 'head');
3321                $open_elements->[-1]->[0]->append_child ($head_element);                $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
3322                push @$open_elements, [$head_element, 'head'];                push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3323                $insertion_mode = 'in head';                $self->{insertion_mode} = 'in head';
3324                ## reprocess                ## reprocess
3325                redo B;                redo B;
3326              } else {              } else {
3327                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3328                ## Ignore the token                ## Ignore the token ## ISSUE: An issue in the spec.
3329                !!!next-token;                !!!next-token;
3330                redo B;                redo B;
3331              }              }
3332            } else {            } else {
3333              die "$0: $token->{type}: Unknown type";              die "$0: $token->{type}: Unknown type";
3334            }            }
3335          } elsif ($insertion_mode eq 'in head') {          } elsif ($self->{insertion_mode} eq 'in head' or
3336                     $self->{insertion_mode} eq 'in head noscript' or
3337                     $self->{insertion_mode} eq 'after head') {
3338            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3339              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3340                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3341                unless (length $token->{data}) {                unless (length $token->{data}) {
3342                  !!!next-token;                  !!!next-token;
3343                  redo B;                  redo B;
# Line 2955  sub _construct_tree ($) { Line 3347  sub _construct_tree ($) {
3347              #              #
3348            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3349              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3350              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3351              !!!next-token;              !!!next-token;
3352              redo B;              redo B;
3353            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3354              if ($token->{tag_name} eq 'title') {              if ({base => ($self->{insertion_mode} eq 'in head' or
3355                ## NOTE: There is an "as if in head" code clone                            $self->{insertion_mode} eq 'after head'),
3356                my $title_el;                   link => 1, meta => 1}->{$token->{tag_name}}) {
3357                !!!create-element ($title_el, 'title', $token->{attributes});                ## NOTE: There is a "as if in head" code clone.
3358                (defined $head_element ? $head_element : $open_elements->[-1]->[0])                if ($self->{insertion_mode} eq 'after head') {
3359                  ->append_child ($title_el);                  !!!parse-error (type => 'after head:'.$token->{tag_name});
3360                $self->{content_model_flag} = 'RCDATA';                  push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3361                  }
3362                my $text = '';                !!!insert-element ($token->{tag_name}, $token->{attributes});
3363                  pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
3364                  ## TODO: Extracting |charset| from |meta|.
3365                  pop @{$self->{open_elements}}
3366                      if $self->{insertion_mode} eq 'after head';
3367                !!!next-token;                !!!next-token;
3368                while ($token->{type} eq 'character') {                redo B;
3369                  $text .= $token->{data};              } elsif ($token->{tag_name} eq 'title' and
3370                         $self->{insertion_mode} eq 'in head') {
3371                  ## NOTE: There is a "as if in head" code clone.
3372                  if ($self->{insertion_mode} eq 'after head') {
3373                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3374                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3375                  }
3376                  $parse_rcdata->('RCDATA', $insert_to_current);
3377                  pop @{$self->{open_elements}}
3378                      if $self->{insertion_mode} eq 'after head';
3379                  redo B;
3380                } elsif ($token->{tag_name} eq 'style') {
3381                  ## NOTE: Or (scripting is enabled and tag_name eq 'noscript' and
3382                  ## insertion mode 'in head')
3383                  ## NOTE: There is a "as if in head" code clone.
3384                  if ($self->{insertion_mode} eq 'after head') {
3385                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3386                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3387                  }
3388                  $parse_rcdata->('CDATA', $insert_to_current);
3389                  pop @{$self->{open_elements}}
3390                      if $self->{insertion_mode} eq 'after head';
3391                  redo B;
3392                } elsif ($token->{tag_name} eq 'noscript') {
3393                  if ($self->{insertion_mode} eq 'in head') {
3394                    ## NOTE: and scripting is disalbed
3395                    !!!insert-element ($token->{tag_name}, $token->{attributes});
3396                    $self->{insertion_mode} = 'in head noscript';
3397                  !!!next-token;                  !!!next-token;
3398                }                  redo B;
3399                if (length $text) {                } elsif ($self->{insertion_mode} eq 'in head noscript') {
3400                  $title_el->manakai_append_text ($text);                  !!!parse-error (type => 'noscript in noscript');
               }  
                 
               $self->{content_model_flag} = 'PCDATA';  
                 
               if ($token->{type} eq 'end tag' and  
                   $token->{tag_name} eq 'title') {  
3401                  ## Ignore the token                  ## Ignore the token
3402                    redo B;
3403                } else {                } else {
3404                  !!!parse-error;                  #
                 ## ISSUE: And ignore?  
3405                }                }
3406                } elsif ($token->{tag_name} eq 'head' and
3407                         $self->{insertion_mode} ne 'after head') {
3408                  !!!parse-error (type => 'in head:head'); # or in head noscript
3409                  ## Ignore the token
3410                !!!next-token;                !!!next-token;
3411                redo B;                redo B;
3412              } elsif ($token->{tag_name} eq 'style') {              } elsif ($self->{insertion_mode} ne 'in head noscript' and
3413                $style_start_tag->();                       $token->{tag_name} eq 'script') {
3414                  if ($self->{insertion_mode} eq 'after head') {
3415                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3416                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3417                  }
3418                  ## NOTE: There is a "as if in head" code clone.
3419                  $script_start_tag->($insert_to_current);
3420                  pop @{$self->{open_elements}}
3421                      if $self->{insertion_mode} eq 'after head';
3422                redo B;                redo B;
3423              } elsif ($token->{tag_name} eq 'script') {              } elsif ($self->{insertion_mode} eq 'after head' and
3424                $script_start_tag->();                       $token->{tag_name} eq 'body') {
3425                redo B;                !!!insert-element ('body', $token->{attributes});
3426              } elsif ({base => 1, link => 1, meta => 1}->{$token->{tag_name}}) {                $self->{insertion_mode} = 'in body';
               ## NOTE: There are "as if in head" code clones  
               my $el;  
               !!!create-element ($el, $token->{tag_name}, $token->{attributes});  
               (defined $head_element ? $head_element : $open_elements->[-1]->[0])  
                 ->append_child ($el);  
   
3427                !!!next-token;                !!!next-token;
3428                redo B;                redo B;
3429              } elsif ($token->{tag_name} eq 'head') {              } elsif ($self->{insertion_mode} eq 'after head' and
3430                !!!parse-error;                       $token->{tag_name} eq 'frameset') {
3431                ## Ignore the token                !!!insert-element ('frameset', $token->{attributes});
3432                  $self->{insertion_mode} = 'in frameset';
3433                !!!next-token;                !!!next-token;
3434                redo B;                redo B;
3435              } else {              } else {
3436                #                #
3437              }              }
3438            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3439              if ($token->{tag_name} eq 'head') {              if ($self->{insertion_mode} eq 'in head' and
3440                if ($open_elements->[-1]->[1] eq 'head') {                  $token->{tag_name} eq 'head') {
3441                  pop @$open_elements;                pop @{$self->{open_elements}};
3442                } else {                $self->{insertion_mode} = 'after head';
3443                  !!!parse-error;                !!!next-token;
3444                }                redo B;
3445                $insertion_mode = 'after head';              } elsif ($self->{insertion_mode} eq 'in head noscript' and
3446                    $token->{tag_name} eq 'noscript') {
3447                  pop @{$self->{open_elements}};
3448                  $self->{insertion_mode} = 'in head';
3449                !!!next-token;                !!!next-token;
3450                redo B;                redo B;
3451              } elsif ($token->{tag_name} eq 'html') {              } elsif ($self->{insertion_mode} eq 'in head' and
3452                         ($token->{tag_name} eq 'body' or
3453                          $token->{tag_name} eq 'html')) {
3454                #                #
3455              } else {              } elsif ($self->{insertion_mode} ne 'after head') {
3456                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3457                ## Ignore the token                ## Ignore the token
3458                !!!next-token;                !!!next-token;
3459                redo B;                redo B;
3460                } else {
3461                  #
3462              }              }
3463            } else {            } else {
3464              #              #
3465            }            }
3466    
3467            if ($open_elements->[-1]->[1] eq 'head') {            ## As if </head> or </noscript> or <body>
3468              ## As if </head>            if ($self->{insertion_mode} eq 'in head') {
3469              pop @$open_elements;              pop @{$self->{open_elements}};
3470                $self->{insertion_mode} = 'after head';
3471              } elsif ($self->{insertion_mode} eq 'in head noscript') {
3472                pop @{$self->{open_elements}};
3473                !!!parse-error (type => 'in noscript:'.(defined $token->{tag_name} ? ($token->{type} eq 'end tag' ? '/' : '') . $token->{tag_name} : '#' . $token->{type}));
3474                $self->{insertion_mode} = 'in head';
3475              } else { # 'after head'
3476                !!!insert-element ('body');
3477                $self->{insertion_mode} = 'in body';
3478            }            }
           $insertion_mode = 'after head';  
3479            ## reprocess            ## reprocess
3480            redo B;            redo B;
3481    
3482            ## ISSUE: An issue in the spec.            ## ISSUE: An issue in the spec.
3483          } elsif ($insertion_mode eq 'after head') {          } elsif ($self->{insertion_mode} eq 'in body') {
           if ($token->{type} eq 'character') {  
             if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {  
               $open_elements->[-1]->[0]->manakai_append_text ($1);  
               unless (length $token->{data}) {  
                 !!!next-token;  
                 redo B;  
               }  
             }  
               
             #  
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
           } elsif ($token->{type} eq 'start tag') {  
             if ($token->{tag_name} eq 'body') {  
               !!!insert-element ('body', $token->{attributes});  
               $insertion_mode = 'in body';  
               !!!next-token;  
               redo B;  
             } elsif ($token->{tag_name} eq 'frameset') {  
               !!!insert-element ('frameset', $token->{attributes});  
               $insertion_mode = 'in frameset';  
               !!!next-token;  
               redo B;  
             } elsif ({  
                       base => 1, link => 1, meta => 1,  
                       script=> 1, style => 1, title => 1,  
                      }->{$token->{tag_name}}) {  
               !!!parse-error;  
                $insertion_mode = 'in head';  
               ## reprocess  
               redo B;  
             } else {  
               #  
             }  
           } else {  
             #  
           }  
             
           ## As if <body>  
           !!!insert-element ('body');  
           $insertion_mode = 'in body';  
           ## reprocess  
           redo B;  
         } elsif ($insertion_mode eq 'in body') {  
3484            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3485              ## NOTE: There is a code clone of "character in body".              ## NOTE: There is a code clone of "character in body".
3486              $reconstruct_active_formatting_elements->($insert_to_current);              $reconstruct_active_formatting_elements->($insert_to_current);
3487                            
3488              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
3489    
3490              !!!next-token;              !!!next-token;
3491              redo B;              redo B;
3492            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3493              ## NOTE: There is a code clone of "comment in body".              ## NOTE: There is a code clone of "comment in body".
3494              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3495              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3496              !!!next-token;              !!!next-token;
3497              redo B;              redo B;
3498            } else {            } else {
3499              $in_body->($insert_to_current);              $in_body->($insert_to_current);
3500              redo B;              redo B;
3501            }            }
3502          } elsif ($insertion_mode eq 'in table') {          } elsif ($self->{insertion_mode} eq 'in table') {
3503            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3504              ## NOTE: There are "character in table" code clones.              ## NOTE: There are "character in table" code clones.
3505              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3506                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3507                                
3508                unless (length $token->{data}) {                unless (length $token->{data}) {
3509                  !!!next-token;                  !!!next-token;
# Line 3120  sub _construct_tree ($) { Line 3511  sub _construct_tree ($) {
3511                }                }
3512              }              }
3513    
3514                !!!parse-error (type => 'in table:#character');
3515    
3516              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
3517              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
3518              ## into the current node" while characters might not be              ## into the current node" while characters might not be
# Line 3129  sub _construct_tree ($) { Line 3522  sub _construct_tree ($) {
3522              if ({              if ({
3523                   table => 1, tbody => 1, tfoot => 1,                   table => 1, tbody => 1, tfoot => 1,
3524                   thead => 1, tr => 1,                   thead => 1, tr => 1,
3525                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3526                # MUST                # MUST
3527                my $foster_parent_element;                my $foster_parent_element;
3528                my $next_sibling;                my $next_sibling;
3529                my $prev_sibling;                my $prev_sibling;
3530                OE: for (reverse 0..$#$open_elements) {                OE: for (reverse 0..$#{$self->{open_elements}}) {
3531                  if ($open_elements->[$_]->[1] eq 'table') {                  if ($self->{open_elements}->[$_]->[1] eq 'table') {
3532                    my $parent = $open_elements->[$_]->[0]->parent_node;                    my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
3533                    if (defined $parent and $parent->node_type == 1) {                    if (defined $parent and $parent->node_type == 1) {
3534                      $foster_parent_element = $parent;                      $foster_parent_element = $parent;
3535                      $next_sibling = $open_elements->[$_]->[0];                      $next_sibling = $self->{open_elements}->[$_]->[0];
3536                      $prev_sibling = $next_sibling->previous_sibling;                      $prev_sibling = $next_sibling->previous_sibling;
3537                    } else {                    } else {
3538                      $foster_parent_element = $open_elements->[$_ - 1]->[0];                      $foster_parent_element = $self->{open_elements}->[$_ - 1]->[0];
3539                      $prev_sibling = $foster_parent_element->last_child;                      $prev_sibling = $foster_parent_element->last_child;
3540                    }                    }
3541                    last OE;                    last OE;
3542                  }                  }
3543                } # OE                } # OE
3544                $foster_parent_element = $open_elements->[0]->[0] and                $foster_parent_element = $self->{open_elements}->[0]->[0] and
3545                $prev_sibling = $foster_parent_element->last_child                $prev_sibling = $foster_parent_element->last_child
3546                  unless defined $foster_parent_element;                  unless defined $foster_parent_element;
3547                if (defined $prev_sibling and                if (defined $prev_sibling and
# Line 3160  sub _construct_tree ($) { Line 3553  sub _construct_tree ($) {
3553                     $next_sibling);                     $next_sibling);
3554                }                }
3555              } else {              } else {
3556                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
3557              }              }
3558                            
3559              !!!next-token;              !!!next-token;
3560              redo B;              redo B;
3561            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3562              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3563              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3564              !!!next-token;              !!!next-token;
3565              redo B;              redo B;
3566            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 3177  sub _construct_tree ($) { Line 3570  sub _construct_tree ($) {
3570                   tbody => 1, tfoot => 1, thead => 1,                   tbody => 1, tfoot => 1, thead => 1,
3571                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
3572                ## Clear back to table context                ## Clear back to table context
3573                while ($open_elements->[-1]->[1] ne 'table' and                while ($self->{open_elements}->[-1]->[1] ne 'table' and
3574                       $open_elements->[-1]->[1] ne 'html') {                       $self->{open_elements}->[-1]->[1] ne 'html') {
3575                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3576                  pop @$open_elements;                  pop @{$self->{open_elements}};
3577                }                }
3578    
3579                push @$active_formatting_elements, ['#marker', '']                push @$active_formatting_elements, ['#marker', '']
3580                  if $token->{tag_name} eq 'caption';                  if $token->{tag_name} eq 'caption';
3581    
3582                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
3583                $insertion_mode = {                $self->{insertion_mode} = {
3584                                   caption => 'in caption',                                   caption => 'in caption',
3585                                   colgroup => 'in column group',                                   colgroup => 'in column group',
3586                                   tbody => 'in table body',                                   tbody => 'in table body',
# Line 3201  sub _construct_tree ($) { Line 3594  sub _construct_tree ($) {
3594                        td => 1, th => 1, tr => 1,                        td => 1, th => 1, tr => 1,
3595                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
3596                ## Clear back to table context                ## Clear back to table context
3597                while ($open_elements->[-1]->[1] ne 'table' and                while ($self->{open_elements}->[-1]->[1] ne 'table' and
3598                       $open_elements->[-1]->[1] ne 'html') {                       $self->{open_elements}->[-1]->[1] ne 'html') {
3599                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3600                  pop @$open_elements;                  pop @{$self->{open_elements}};
3601                }                }
3602    
3603                !!!insert-element ($token->{tag_name} eq 'col' ? 'colgroup' : 'tbody');                !!!insert-element ($token->{tag_name} eq 'col' ? 'colgroup' : 'tbody');
3604                $insertion_mode = $token->{tag_name} eq 'col'                $self->{insertion_mode} = $token->{tag_name} eq 'col'
3605                  ? 'in column group' : 'in table body';                  ? 'in column group' : 'in table body';
3606                ## reprocess                ## reprocess
3607                redo B;                redo B;
3608              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
3609                ## NOTE: There are code clones for this "table in table"                ## NOTE: There are code clones for this "table in table"
3610                !!!parse-error;                !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3611    
3612                ## As if </table>                ## As if </table>
3613                ## have a table element in table scope                ## have a table element in table scope
3614                my $i;                my $i;
3615                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3616                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3617                  if ($node->[1] eq 'table') {                  if ($node->[1] eq 'table') {
3618                    $i = $_;                    $i = $_;
3619                    last INSCOPE;                    last INSCOPE;
# Line 3231  sub _construct_tree ($) { Line 3624  sub _construct_tree ($) {
3624                  }                  }
3625                } # INSCOPE                } # INSCOPE
3626                unless (defined $i) {                unless (defined $i) {
3627                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:table');
3628                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
3629                  !!!next-token;                  !!!next-token;
3630                  redo B;                  redo B;
# Line 3241  sub _construct_tree ($) { Line 3634  sub _construct_tree ($) {
3634                if ({                if ({
3635                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3636                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3637                    }->{$open_elements->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
3638                  !!!back-token; # <table>                  !!!back-token; # <table>
3639                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
3640                  !!!back-token;                  !!!back-token;
3641                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3642                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3643                  redo B;                  redo B;
3644                }                }
3645    
3646                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
3647                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3648                }                }
3649    
3650                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3651    
3652                $reset_insertion_mode->();                              $self->_reset_insertion_mode;
3653    
3654                ## reprocess                ## reprocess
3655                redo B;                redo B;
# Line 3267  sub _construct_tree ($) { Line 3660  sub _construct_tree ($) {
3660              if ($token->{tag_name} eq 'table') {              if ($token->{tag_name} eq 'table') {
3661                ## have a table element in table scope                ## have a table element in table scope
3662                my $i;                my $i;
3663                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3664                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3665                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
3666                    $i = $_;                    $i = $_;
3667                    last INSCOPE;                    last INSCOPE;
# Line 3279  sub _construct_tree ($) { Line 3672  sub _construct_tree ($) {
3672                  }                  }
3673                } # INSCOPE                } # INSCOPE
3674                unless (defined $i) {                unless (defined $i) {
3675                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3676                  ## Ignore the token                  ## Ignore the token
3677                  !!!next-token;                  !!!next-token;
3678                  redo B;                  redo B;
# Line 3289  sub _construct_tree ($) { Line 3682  sub _construct_tree ($) {
3682                if ({                if ({
3683                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3684                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3685                    }->{$open_elements->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
3686                  !!!back-token;                  !!!back-token;
3687                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3688                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3689                  redo B;                  redo B;
3690                }                }
3691    
3692                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
3693                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3694                }                }
3695    
3696                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3697    
3698                $reset_insertion_mode->();                $self->_reset_insertion_mode;
3699    
3700                !!!next-token;                !!!next-token;
3701                redo B;                redo B;
# Line 3311  sub _construct_tree ($) { Line 3704  sub _construct_tree ($) {
3704                        html => 1, tbody => 1, td => 1, tfoot => 1, th => 1,                        html => 1, tbody => 1, td => 1, tfoot => 1, th => 1,
3705                        thead => 1, tr => 1,                        thead => 1, tr => 1,
3706                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
3707                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3708                ## Ignore the token                ## Ignore the token
3709                !!!next-token;                !!!next-token;
3710                redo B;                redo B;
# Line 3322  sub _construct_tree ($) { Line 3715  sub _construct_tree ($) {
3715              #              #
3716            }            }
3717    
3718            !!!parse-error;            !!!parse-error (type => 'in table:'.$token->{tag_name});
3719            $in_body->($insert_to_foster);            $in_body->($insert_to_foster);
3720            redo B;            redo B;
3721          } elsif ($insertion_mode eq 'in caption') {          } elsif ($self->{insertion_mode} eq 'in caption') {
3722            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3723              ## NOTE: This is a code clone of "character in body".              ## NOTE: This is a code clone of "character in body".
3724              $reconstruct_active_formatting_elements->($insert_to_current);              $reconstruct_active_formatting_elements->($insert_to_current);
3725                            
3726              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
3727    
3728              !!!next-token;              !!!next-token;
3729              redo B;              redo B;
3730            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3731              ## NOTE: This is a code clone of "comment in body".              ## NOTE: This is a code clone of "comment in body".
3732              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3733              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3734              !!!next-token;              !!!next-token;
3735              redo B;              redo B;
3736            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 3345  sub _construct_tree ($) { Line 3738  sub _construct_tree ($) {
3738                   caption => 1, col => 1, colgroup => 1, tbody => 1,                   caption => 1, col => 1, colgroup => 1, tbody => 1,
3739                   td => 1, tfoot => 1, th => 1, thead => 1, tr => 1,                   td => 1, tfoot => 1, th => 1, thead => 1, tr => 1,
3740                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
3741                !!!parse-error;                !!!parse-error (type => 'not closed:caption');
3742    
3743                ## As if </caption>                ## As if </caption>
3744                ## have a table element in table scope                ## have a table element in table scope
3745                my $i;                my $i;
3746                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3747                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3748                  if ($node->[1] eq 'caption') {                  if ($node->[1] eq 'caption') {
3749                    $i = $_;                    $i = $_;
3750                    last INSCOPE;                    last INSCOPE;
# Line 3362  sub _construct_tree ($) { Line 3755  sub _construct_tree ($) {
3755                  }                  }
3756                } # INSCOPE                } # INSCOPE
3757                unless (defined $i) {                unless (defined $i) {
3758                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:caption');
3759                  ## Ignore the token                  ## Ignore the token
3760                  !!!next-token;                  !!!next-token;
3761                  redo B;                  redo B;
# Line 3372  sub _construct_tree ($) { Line 3765  sub _construct_tree ($) {
3765                if ({                if ({
3766                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3767                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3768                    }->{$open_elements->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
3769                  !!!back-token; # <?>                  !!!back-token; # <?>
3770                  $token = {type => 'end tag', tag_name => 'caption'};                  $token = {type => 'end tag', tag_name => 'caption'};
3771                  !!!back-token;                  !!!back-token;
3772                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3773                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3774                  redo B;                  redo B;
3775                }                }
3776    
3777                if ($open_elements->[-1]->[1] ne 'caption') {                if ($self->{open_elements}->[-1]->[1] ne 'caption') {
3778                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3779                }                }
3780    
3781                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3782    
3783                $clear_up_to_marker->();                $clear_up_to_marker->();
3784    
3785                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
3786    
3787                ## reprocess                ## reprocess
3788                redo B;                redo B;
# Line 3400  sub _construct_tree ($) { Line 3793  sub _construct_tree ($) {
3793              if ($token->{tag_name} eq 'caption') {              if ($token->{tag_name} eq 'caption') {
3794                ## have a table element in table scope                ## have a table element in table scope
3795                my $i;                my $i;
3796                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3797                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3798                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
3799                    $i = $_;                    $i = $_;
3800                    last INSCOPE;                    last INSCOPE;
# Line 3412  sub _construct_tree ($) { Line 3805  sub _construct_tree ($) {
3805                  }                  }
3806                } # INSCOPE                } # INSCOPE
3807                unless (defined $i) {                unless (defined $i) {
3808                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3809                  ## Ignore the token                  ## Ignore the token
3810                  !!!next-token;                  !!!next-token;
3811                  redo B;                  redo B;
# Line 3422  sub _construct_tree ($) { Line 3815  sub _construct_tree ($) {
3815                if ({                if ({
3816                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3817                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3818                    }->{$open_elements->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
3819                  !!!back-token;                  !!!back-token;
3820                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3821                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3822                  redo B;                  redo B;
3823                }                }
3824    
3825                if ($open_elements->[-1]->[1] ne 'caption') {                if ($self->{open_elements}->[-1]->[1] ne 'caption') {
3826                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3827                }                }
3828    
3829                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3830    
3831                $clear_up_to_marker->();                $clear_up_to_marker->();
3832    
3833                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
3834    
3835                !!!next-token;                !!!next-token;
3836                redo B;                redo B;
3837              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
3838                !!!parse-error;                !!!parse-error (type => 'not closed:caption');
3839    
3840                ## As if </caption>                ## As if </caption>
3841                ## have a table element in table scope                ## have a table element in table scope
3842                my $i;                my $i;
3843                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3844                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3845                  if ($node->[1] eq 'caption') {                  if ($node->[1] eq 'caption') {
3846                    $i = $_;                    $i = $_;
3847                    last INSCOPE;                    last INSCOPE;
# Line 3459  sub _construct_tree ($) { Line 3852  sub _construct_tree ($) {
3852                  }                  }
3853                } # INSCOPE                } # INSCOPE
3854                unless (defined $i) {                unless (defined $i) {
3855                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:caption');
3856                  ## Ignore the token                  ## Ignore the token
3857                  !!!next-token;                  !!!next-token;
3858                  redo B;                  redo B;
# Line 3469  sub _construct_tree ($) { Line 3862  sub _construct_tree ($) {
3862                if ({                if ({
3863                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3864                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3865                    }->{$open_elements->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
3866                  !!!back-token; # </table>                  !!!back-token; # </table>
3867                  $token = {type => 'end tag', tag_name => 'caption'};                  $token = {type => 'end tag', tag_name => 'caption'};
3868                  !!!back-token;                  !!!back-token;
3869                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3870                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3871                  redo B;                  redo B;
3872                }                }
3873    
3874                if ($open_elements->[-1]->[1] ne 'caption') {                if ($self->{open_elements}->[-1]->[1] ne 'caption') {
3875                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3876                }                }
3877    
3878                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3879    
3880                $clear_up_to_marker->();                $clear_up_to_marker->();
3881    
3882                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
3883    
3884                ## reprocess                ## reprocess
3885                redo B;                redo B;
# Line 3495  sub _construct_tree ($) { Line 3888  sub _construct_tree ($) {
3888                        html => 1, tbody => 1, td => 1, tfoot => 1,                        html => 1, tbody => 1, td => 1, tfoot => 1,
3889                        th => 1, thead => 1, tr => 1,                        th => 1, thead => 1, tr => 1,
3890                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
3891                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3892                ## Ignore the token                ## Ignore the token
3893                redo B;                redo B;
3894              } else {              } else {
# Line 3507  sub _construct_tree ($) { Line 3900  sub _construct_tree ($) {
3900                                
3901            $in_body->($insert_to_current);            $in_body->($insert_to_current);
3902            redo B;            redo B;
3903          } elsif ($insertion_mode eq 'in column group') {          } elsif ($self->{insertion_mode} eq 'in column group') {
3904            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3905              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3906                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3907                unless (length $token->{data}) {                unless (length $token->{data}) {
3908                  !!!next-token;                  !!!next-token;
3909                  redo B;                  redo B;
# Line 3520  sub _construct_tree ($) { Line 3913  sub _construct_tree ($) {
3913              #              #
3914            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3915              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3916              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3917              !!!next-token;              !!!next-token;
3918              redo B;              redo B;
3919            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3920              if ($token->{tag_name} eq 'col') {              if ($token->{tag_name} eq 'col') {
3921                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
3922                pop @$open_elements;                pop @{$self->{open_elements}};
3923                !!!next-token;                !!!next-token;
3924                redo B;                redo B;
3925              } else {              } else {
# Line 3534  sub _construct_tree ($) { Line 3927  sub _construct_tree ($) {
3927              }              }
3928            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3929              if ($token->{tag_name} eq 'colgroup') {              if ($token->{tag_name} eq 'colgroup') {
3930                if ($open_elements->[-1]->[1] eq 'html') {                if ($self->{open_elements}->[-1]->[1] eq 'html') {
3931                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:colgroup');
3932                  ## Ignore the token                  ## Ignore the token
3933                  !!!next-token;                  !!!next-token;
3934                  redo B;                  redo B;
3935                } else {                } else {
3936                  pop @$open_elements; # colgroup                  pop @{$self->{open_elements}}; # colgroup
3937                  $insertion_mode = 'in table';                  $self->{insertion_mode} = 'in table';
3938                  !!!next-token;                  !!!next-token;
3939                  redo B;                              redo B;            
3940                }                }
3941              } elsif ($token->{tag_name} eq 'col') {              } elsif ($token->{tag_name} eq 'col') {
3942                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:col');
3943                ## Ignore the token                ## Ignore the token
3944                !!!next-token;                !!!next-token;
3945                redo B;                redo B;
# Line 3558  sub _construct_tree ($) { Line 3951  sub _construct_tree ($) {
3951            }            }
3952    
3953            ## As if </colgroup>            ## As if </colgroup>
3954            if ($open_elements->[-1]->[1] eq 'html') {            if ($self->{open_elements}->[-1]->[1] eq 'html') {
3955              !!!parse-error;              !!!parse-error (type => 'unmatched end tag:colgroup');
3956              ## Ignore the token              ## Ignore the token
3957              !!!next-token;              !!!next-token;
3958              redo B;              redo B;
3959            } else {            } else {
3960              pop @$open_elements; # colgroup              pop @{$self->{open_elements}}; # colgroup
3961              $insertion_mode = 'in table';              $self->{insertion_mode} = 'in table';
3962              ## reprocess              ## reprocess
3963              redo B;              redo B;
3964            }            }
3965          } elsif ($insertion_mode eq 'in table body') {          } elsif ($self->{insertion_mode} eq 'in table body') {
3966            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3967              ## NOTE: This is a "character in table" code clone.              ## NOTE: This is a "character in table" code clone.
3968              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3969                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3970                                
3971                unless (length $token->{data}) {                unless (length $token->{data}) {
3972                  !!!next-token;                  !!!next-token;
# Line 3581  sub _construct_tree ($) { Line 3974  sub _construct_tree ($) {
3974                }                }
3975              }              }
3976    
3977                !!!parse-error (type => 'in table:#character');
3978    
3979              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
3980              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
3981              ## into the current node" while characters might not be              ## into the current node" while characters might not be
# Line 3590  sub _construct_tree ($) { Line 3985  sub _construct_tree ($) {
3985              if ({              if ({
3986                   table => 1, tbody => 1, tfoot => 1,                   table => 1, tbody => 1, tfoot => 1,
3987                   thead => 1, tr => 1,                   thead => 1, tr => 1,
3988                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3989                # MUST                # MUST
3990                my $foster_parent_element;                my $foster_parent_element;
3991                my $next_sibling;                my $next_sibling;
3992                my $prev_sibling;                my $prev_sibling;
3993                OE: for (reverse 0..$#$open_elements) {                OE: for (reverse 0..$#{$self->{open_elements}}) {
3994                  if ($open_elements->[$_]->[1] eq 'table') {                  if ($self->{open_elements}->[$_]->[1] eq 'table') {
3995                    my $parent = $open_elements->[$_]->[0]->parent_node;                    my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
3996                    if (defined $parent and $parent->node_type == 1) {                    if (defined $parent and $parent->node_type == 1) {
3997                      $foster_parent_element = $parent;                      $foster_parent_element = $parent;
3998                      $next_sibling = $open_elements->[$_]->[0];                      $next_sibling = $self->{open_elements}->[$_]->[0];
3999                      $prev_sibling = $next_sibling->previous_sibling;                      $prev_sibling = $next_sibling->previous_sibling;
4000                    } else {                    } else {
4001                      $foster_parent_element = $open_elements->[$_ - 1]->[0];                      $foster_parent_element = $self->{open_elements}->[$_ - 1]->[0];
4002                      $prev_sibling = $foster_parent_element->last_child;                      $prev_sibling = $foster_parent_element->last_child;
4003                    }                    }
4004                    last OE;                    last OE;
4005                  }                  }
4006                } # OE                } # OE
4007                $foster_parent_element = $open_elements->[0]->[0] and                $foster_parent_element = $self->{open_elements}->[0]->[0] and
4008                $prev_sibling = $foster_parent_element->last_child                $prev_sibling = $foster_parent_element->last_child
4009                  unless defined $foster_parent_element;                  unless defined $foster_parent_element;
4010                if (defined $prev_sibling and                if (defined $prev_sibling and
# Line 3621  sub _construct_tree ($) { Line 4016  sub _construct_tree ($) {
4016                     $next_sibling);                     $next_sibling);
4017                }                }
4018              } else {              } else {
4019                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4020              }              }
4021                            
4022              !!!next-token;              !!!next-token;
# Line 3629  sub _construct_tree ($) { Line 4024  sub _construct_tree ($) {
4024            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4025              ## Copied from 'in table'              ## Copied from 'in table'
4026              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4027              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4028              !!!next-token;              !!!next-token;
4029              redo B;              redo B;
4030            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 3637  sub _construct_tree ($) { Line 4032  sub _construct_tree ($) {
4032                   tr => 1,                   tr => 1,
4033                   th => 1, td => 1,                   th => 1, td => 1,
4034                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
4035                  unless ($token->{tag_name} eq 'tr') {
4036                    !!!parse-error (type => 'missing start tag:tr');
4037                  }
4038    
4039                ## Clear back to table body context                ## Clear back to table body context
4040                while (not {                while (not {
4041                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4042                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4043                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4044                  pop @$open_elements;                  pop @{$self->{open_elements}};
4045                }                }
4046                                
4047                $insertion_mode = 'in row';                $self->{insertion_mode} = 'in row';
4048                if ($token->{tag_name} eq 'tr') {                if ($token->{tag_name} eq 'tr') {
4049                  !!!insert-element ($token->{tag_name}, $token->{attributes});                  !!!insert-element ($token->{tag_name}, $token->{attributes});
4050                  !!!next-token;                  !!!next-token;
# Line 3660  sub _construct_tree ($) { Line 4059  sub _construct_tree ($) {
4059                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4060                ## have an element in table scope                ## have an element in table scope
4061                my $i;                my $i;
4062                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4063                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4064                  if ({                  if ({
4065                       tbody => 1, thead => 1, tfoot => 1,                       tbody => 1, thead => 1, tfoot => 1,
4066                      }->{$node->[1]}) {                      }->{$node->[1]}) {
# Line 3674  sub _construct_tree ($) { Line 4073  sub _construct_tree ($) {
4073                  }                  }
4074                } # INSCOPE                } # INSCOPE
4075                unless (defined $i) {                unless (defined $i) {
4076                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4077                  ## Ignore the token                  ## Ignore the token
4078                  !!!next-token;                  !!!next-token;
4079                  redo B;                  redo B;
# Line 3683  sub _construct_tree ($) { Line 4082  sub _construct_tree ($) {
4082                ## Clear back to table body context                ## Clear back to table body context
4083                while (not {                while (not {
4084                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4085                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4086                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4087                  pop @$open_elements;                  pop @{$self->{open_elements}};
4088                }                }
4089    
4090                ## As if <{current node}>                ## As if <{current node}>
# Line 3695  sub _construct_tree ($) { Line 4094  sub _construct_tree ($) {
4094                ## Clear back to table body context                ## Clear back to table body context
4095                ## nop by definition                ## nop by definition
4096    
4097                pop @$open_elements;                pop @{$self->{open_elements}};
4098                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4099                ## reprocess                ## reprocess
4100                redo B;                redo B;
4101              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4102                ## NOTE: This is a code clone of "table in table"                ## NOTE: This is a code clone of "table in table"
4103                !!!parse-error;                !!!parse-error (type => 'not closed:table');
4104    
4105                ## As if </table>                ## As if </table>
4106                ## have a table element in table scope                ## have a table element in table scope
4107                my $i;                my $i;
4108                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4109                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4110                  if ($node->[1] eq 'table') {                  if ($node->[1] eq 'table') {
4111                    $i = $_;                    $i = $_;
4112                    last INSCOPE;                    last INSCOPE;
# Line 3718  sub _construct_tree ($) { Line 4117  sub _construct_tree ($) {
4117                  }                  }
4118                } # INSCOPE                } # INSCOPE
4119                unless (defined $i) {                unless (defined $i) {
4120                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:table');
4121                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
4122                  !!!next-token;                  !!!next-token;
4123                  redo B;                  redo B;
# Line 3728  sub _construct_tree ($) { Line 4127  sub _construct_tree ($) {
4127                if ({                if ({
4128                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4129                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4130                    }->{$open_elements->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
4131                  !!!back-token; # <table>                  !!!back-token; # <table>
4132                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
4133                  !!!back-token;                  !!!back-token;
4134                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4135                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4136                  redo B;                  redo B;
4137                }                }
4138    
4139                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
4140                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4141                }                }
4142    
4143                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4144    
4145                $reset_insertion_mode->();                              $self->_reset_insertion_mode;
4146    
4147                ## reprocess                ## reprocess
4148                redo B;                redo B;
# Line 3756  sub _construct_tree ($) { Line 4155  sub _construct_tree ($) {
4155                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
4156                ## have an element in table scope                ## have an element in table scope
4157                my $i;                my $i;
4158                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4159                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4160                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4161                    $i = $_;                    $i = $_;
4162                    last INSCOPE;                    last INSCOPE;
# Line 3768  sub _construct_tree ($) { Line 4167  sub _construct_tree ($) {
4167                  }                  }
4168                } # INSCOPE                } # INSCOPE
4169                unless (defined $i) {                unless (defined $i) {
4170                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4171                  ## Ignore the token                  ## Ignore the token
4172                  !!!next-token;                  !!!next-token;
4173                  redo B;                  redo B;
# Line 3777  sub _construct_tree ($) { Line 4176  sub _construct_tree ($) {
4176                ## Clear back to table body context                ## Clear back to table body context
4177                while (not {                while (not {
4178                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4179                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4180                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4181                  pop @$open_elements;                  pop @{$self->{open_elements}};
4182                }                }
4183    
4184                pop @$open_elements;                pop @{$self->{open_elements}};
4185                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4186                !!!next-token;                !!!next-token;
4187                redo B;                redo B;
4188              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4189                ## have an element in table scope                ## have an element in table scope
4190                my $i;                my $i;
4191                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4192                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4193                  if ({                  if ({
4194                       tbody => 1, thead => 1, tfoot => 1,                       tbody => 1, thead => 1, tfoot => 1,
4195                      }->{$node->[1]}) {                      }->{$node->[1]}) {
# Line 3803  sub _construct_tree ($) { Line 4202  sub _construct_tree ($) {
4202                  }                  }
4203                } # INSCOPE                } # INSCOPE
4204                unless (defined $i) {                unless (defined $i) {
4205                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4206                  ## Ignore the token                  ## Ignore the token
4207                  !!!next-token;                  !!!next-token;
4208                  redo B;                  redo B;
# Line 3812  sub _construct_tree ($) { Line 4211  sub _construct_tree ($) {
4211                ## Clear back to table body context                ## Clear back to table body context
4212                while (not {                while (not {
4213                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4214                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4215                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4216                  pop @$open_elements;                  pop @{$self->{open_elements}};
4217                }                }
4218    
4219                ## As if <{current node}>                ## As if <{current node}>
# Line 3824  sub _construct_tree ($) { Line 4223  sub _construct_tree ($) {
4223                ## Clear back to table body context                ## Clear back to table body context
4224                ## nop by definition                ## nop by definition
4225    
4226                pop @$open_elements;                pop @{$self->{open_elements}};
4227                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4228                ## reprocess                ## reprocess
4229                redo B;                redo B;
4230              } elsif ({              } elsif ({
4231                        body => 1, caption => 1, col => 1, colgroup => 1,                        body => 1, caption => 1, col => 1, colgroup => 1,
4232                        html => 1, td => 1, th => 1, tr => 1,                        html => 1, td => 1, th => 1, tr => 1,
4233                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4234                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4235                ## Ignore the token                ## Ignore the token
4236                !!!next-token;                !!!next-token;
4237                redo B;                redo B;
# Line 3844  sub _construct_tree ($) { Line 4243  sub _construct_tree ($) {
4243            }            }
4244                        
4245            ## As if in table            ## As if in table
4246            !!!parse-error;            !!!parse-error (type => 'in table:'.$token->{tag_name});
4247            $in_body->($insert_to_foster);            $in_body->($insert_to_foster);
4248            redo B;            redo B;
4249          } elsif ($insertion_mode eq 'in row') {          } elsif ($self->{insertion_mode} eq 'in row') {
4250            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4251              ## NOTE: This is a "character in table" code clone.              ## NOTE: This is a "character in table" code clone.
4252              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4253                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4254                                
4255                unless (length $token->{data}) {                unless (length $token->{data}) {
4256                  !!!next-token;                  !!!next-token;
# Line 3859  sub _construct_tree ($) { Line 4258  sub _construct_tree ($) {
4258                }                }
4259              }              }
4260    
4261                !!!parse-error (type => 'in table:#character');
4262    
4263              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
4264              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
4265              ## into the current node" while characters might not be              ## into the current node" while characters might not be
# Line 3868  sub _construct_tree ($) { Line 4269  sub _construct_tree ($) {
4269              if ({              if ({
4270                   table => 1, tbody => 1, tfoot => 1,                   table => 1, tbody => 1, tfoot => 1,
4271                   thead => 1, tr => 1,                   thead => 1, tr => 1,
4272                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
4273                # MUST                # MUST
4274                my $foster_parent_element;                my $foster_parent_element;
4275                my $next_sibling;                my $next_sibling;
4276                my $prev_sibling;                my $prev_sibling;
4277                OE: for (reverse 0..$#$open_elements) {                OE: for (reverse 0..$#{$self->{open_elements}}) {
4278                  if ($open_elements->[$_]->[1] eq 'table') {                  if ($self->{open_elements}->[$_]->[1] eq 'table') {
4279                    my $parent = $open_elements->[$_]->[0]->parent_node;                    my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
4280                    if (defined $parent and $parent->node_type == 1) {                    if (defined $parent and $parent->node_type == 1) {
4281                      $foster_parent_element = $parent;                      $foster_parent_element = $parent;
4282                      $next_sibling = $open_elements->[$_]->[0];                      $next_sibling = $self->{open_elements}->[$_]->[0];
4283                      $prev_sibling = $next_sibling->previous_sibling;                      $prev_sibling = $next_sibling->previous_sibling;
4284                    } else {                    } else {
4285                      $foster_parent_element = $open_elements->[$_ - 1]->[0];                      $foster_parent_element = $self->{open_elements}->[$_ - 1]->[0];
4286                      $prev_sibling = $foster_parent_element->last_child;                      $prev_sibling = $foster_parent_element->last_child;
4287                    }                    }
4288                    last OE;                    last OE;
4289                  }                  }
4290                } # OE                } # OE
4291                $foster_parent_element = $open_elements->[0]->[0] and                $foster_parent_element = $self->{open_elements}->[0]->[0] and
4292                $prev_sibling = $foster_parent_element->last_child                $prev_sibling = $foster_parent_element->last_child
4293                  unless defined $foster_parent_element;                  unless defined $foster_parent_element;
4294                if (defined $prev_sibling and                if (defined $prev_sibling and
# Line 3899  sub _construct_tree ($) { Line 4300  sub _construct_tree ($) {
4300                     $next_sibling);                     $next_sibling);
4301                }                }
4302              } else {              } else {
4303                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4304              }              }
4305                            
4306              !!!next-token;              !!!next-token;
# Line 3907  sub _construct_tree ($) { Line 4308  sub _construct_tree ($) {
4308            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4309              ## Copied from 'in table'              ## Copied from 'in table'
4310              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4311              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4312              !!!next-token;              !!!next-token;
4313              redo B;              redo B;
4314            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 3916  sub _construct_tree ($) { Line 4317  sub _construct_tree ($) {
4317                ## Clear back to table row context                ## Clear back to table row context
4318                while (not {                while (not {
4319                  tr => 1, html => 1,                  tr => 1, html => 1,
4320                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4321                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4322                  pop @$open_elements;                  pop @{$self->{open_elements}};
4323                }                }
4324                                
4325                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4326                $insertion_mode = 'in cell';                $self->{insertion_mode} = 'in cell';
4327    
4328                push @$active_formatting_elements, ['#marker', ''];                push @$active_formatting_elements, ['#marker', ''];
4329                                
# Line 3935  sub _construct_tree ($) { Line 4336  sub _construct_tree ($) {
4336                ## As if </tr>                ## As if </tr>
4337                ## have an element in table scope                ## have an element in table scope
4338                my $i;                my $i;
4339                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4340                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4341                  if ($node->[1] eq 'tr') {                  if ($node->[1] eq 'tr') {
4342                    $i = $_;                    $i = $_;
4343                    last INSCOPE;                    last INSCOPE;
# Line 3947  sub _construct_tree ($) { Line 4348  sub _construct_tree ($) {
4348                  }                  }
4349                } # INSCOPE                } # INSCOPE
4350                unless (defined $i) {                unless (defined $i) {
4351                  !!!parse-error;                  !!!parse-error (type => 'unmacthed end tag:'.$token->{tag_name});
4352                  ## Ignore the token                  ## Ignore the token
4353                  !!!next-token;                  !!!next-token;
4354                  redo B;                  redo B;
# Line 3956  sub _construct_tree ($) { Line 4357  sub _construct_tree ($) {
4357                ## Clear back to table row context                ## Clear back to table row context
4358                while (not {                while (not {
4359                  tr => 1, html => 1,                  tr => 1, html => 1,
4360                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4361                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4362                  pop @$open_elements;                  pop @{$self->{open_elements}};
4363                }                }
4364    
4365                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4366                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4367                ## reprocess                ## reprocess
4368                redo B;                redo B;
4369              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4370                ## NOTE: This is a code clone of "table in table"                ## NOTE: This is a code clone of "table in table"
4371                !!!parse-error;                !!!parse-error (type => 'not closed:table');
4372    
4373                ## As if </table>                ## As if </table>
4374                ## have a table element in table scope                ## have a table element in table scope
4375                my $i;                my $i;
4376                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4377                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4378                  if ($node->[1] eq 'table') {                  if ($node->[1] eq 'table') {
4379                    $i = $_;                    $i = $_;
4380                    last INSCOPE;                    last INSCOPE;
# Line 3984  sub _construct_tree ($) { Line 4385  sub _construct_tree ($) {
4385                  }                  }
4386                } # INSCOPE                } # INSCOPE
4387                unless (defined $i) {                unless (defined $i) {
4388                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:table');
4389                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
4390                  !!!next-token;                  !!!next-token;
4391                  redo B;                  redo B;
# Line 3994  sub _construct_tree ($) { Line 4395  sub _construct_tree ($) {
4395                if ({                if ({
4396                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4397                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4398                    }->{$open_elements->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
4399                  !!!back-token; # <table>                  !!!back-token; # <table>
4400                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
4401                  !!!back-token;                  !!!back-token;
4402                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4403                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4404                  redo B;                  redo B;
4405                }                }
4406    
4407                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
4408                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4409                }                }
4410    
4411                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4412    
4413                $reset_insertion_mode->();                              $self->_reset_insertion_mode;
4414    
4415                ## reprocess                ## reprocess
4416                redo B;                redo B;
# Line 4020  sub _construct_tree ($) { Line 4421  sub _construct_tree ($) {
4421              if ($token->{tag_name} eq 'tr') {              if ($token->{tag_name} eq 'tr') {
4422                ## have an element in table scope                ## have an element in table scope
4423                my $i;                my $i;
4424                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4425                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4426                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4427                    $i = $_;                    $i = $_;
4428                    last INSCOPE;                    last INSCOPE;
# Line 4032  sub _construct_tree ($) { Line 4433  sub _construct_tree ($) {
4433                  }                  }
4434                } # INSCOPE                } # INSCOPE
4435                unless (defined $i) {                unless (defined $i) {
4436                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4437                  ## Ignore the token                  ## Ignore the token
4438                  !!!next-token;                  !!!next-token;
4439                  redo B;                  redo B;
# Line 4041  sub _construct_tree ($) { Line 4442  sub _construct_tree ($) {
4442                ## Clear back to table row context                ## Clear back to table row context
4443                while (not {                while (not {
4444                  tr => 1, html => 1,                  tr => 1, html => 1,
4445                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4446                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4447                  pop @$open_elements;                  pop @{$self->{open_elements}};
4448                }                }
4449    
4450                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4451                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4452                !!!next-token;                !!!next-token;
4453                redo B;                redo B;
4454              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4455                ## As if </tr>                ## As if </tr>
4456                ## have an element in table scope                ## have an element in table scope
4457                my $i;                my $i;
4458                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4459                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4460                  if ($node->[1] eq 'tr') {                  if ($node->[1] eq 'tr') {
4461                    $i = $_;                    $i = $_;
4462                    last INSCOPE;                    last INSCOPE;
# Line 4066  sub _construct_tree ($) { Line 4467  sub _construct_tree ($) {
4467                  }                  }
4468                } # INSCOPE                } # INSCOPE
4469                unless (defined $i) {                unless (defined $i) {
4470                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{type});
4471                  ## Ignore the token                  ## Ignore the token
4472                  !!!next-token;                  !!!next-token;
4473                  redo B;                  redo B;
# Line 4075  sub _construct_tree ($) { Line 4476  sub _construct_tree ($) {
4476                ## Clear back to table row context                ## Clear back to table row context
4477                while (not {                while (not {
4478                  tr => 1, html => 1,                  tr => 1, html => 1,
4479                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4480                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4481                  pop @$open_elements;                  pop @{$self->{open_elements}};
4482                }                }
4483    
4484                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4485                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4486                ## reprocess                ## reprocess
4487                redo B;                redo B;
4488              } elsif ({              } elsif ({
# Line 4089  sub _construct_tree ($) { Line 4490  sub _construct_tree ($) {
4490                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4491                ## have an element in table scope                ## have an element in table scope
4492                my $i;                my $i;
4493                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4494                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4495                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4496                    $i = $_;                    $i = $_;
4497                    last INSCOPE;                    last INSCOPE;
# Line 4101  sub _construct_tree ($) { Line 4502  sub _construct_tree ($) {
4502                  }                  }
4503                } # INSCOPE                } # INSCOPE
4504                unless (defined $i) {                unless (defined $i) {
4505                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4506                  ## Ignore the token                  ## Ignore the token
4507                  !!!next-token;                  !!!next-token;
4508                  redo B;                  redo B;
# Line 4110  sub _construct_tree ($) { Line 4511  sub _construct_tree ($) {
4511                ## As if </tr>                ## As if </tr>
4512                ## have an element in table scope                ## have an element in table scope
4513                my $i;                my $i;
4514                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4515                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4516                  if ($node->[1] eq 'tr') {                  if ($node->[1] eq 'tr') {
4517                    $i = $_;                    $i = $_;
4518                    last INSCOPE;                    last INSCOPE;
# Line 4122  sub _construct_tree ($) { Line 4523  sub _construct_tree ($) {
4523                  }                  }
4524                } # INSCOPE                } # INSCOPE
4525                unless (defined $i) {                unless (defined $i) {
4526                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:tr');
4527                  ## Ignore the token                  ## Ignore the token
4528                  !!!next-token;                  !!!next-token;
4529                  redo B;                  redo B;
# Line 4131  sub _construct_tree ($) { Line 4532  sub _construct_tree ($) {
4532                ## Clear back to table row context                ## Clear back to table row context
4533                while (not {                while (not {
4534                  tr => 1, html => 1,                  tr => 1, html => 1,
4535                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4536                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4537                  pop @$open_elements;                  pop @{$self->{open_elements}};
4538                }                }
4539    
4540                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4541                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4542                ## reprocess                ## reprocess
4543                redo B;                redo B;
4544              } elsif ({              } elsif ({
4545                        body => 1, caption => 1, col => 1,                        body => 1, caption => 1, col => 1,
4546                        colgroup => 1, html => 1, td => 1, th => 1,                        colgroup => 1, html => 1, td => 1, th => 1,
4547                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4548                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4549                ## Ignore the token                ## Ignore the token
4550                !!!next-token;                !!!next-token;
4551                redo B;                redo B;
# Line 4156  sub _construct_tree ($) { Line 4557  sub _construct_tree ($) {
4557            }            }
4558    
4559            ## As if in table            ## As if in table
4560            !!!parse-error;            !!!parse-error (type => 'in table:'.$token->{tag_name});
4561            $in_body->($insert_to_foster);            $in_body->($insert_to_foster);
4562            redo B;            redo B;
4563          } elsif ($insertion_mode eq 'in cell') {          } elsif ($self->{insertion_mode} eq 'in cell') {
4564            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4565              ## NOTE: This is a code clone of "character in body".              ## NOTE: This is a code clone of "character in body".
4566              $reconstruct_active_formatting_elements->($insert_to_current);              $reconstruct_active_formatting_elements->($insert_to_current);
4567                            
4568              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4569    
4570              !!!next-token;              !!!next-token;
4571              redo B;              redo B;
4572            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4573              ## NOTE: This is a code clone of "comment in body".              ## NOTE: This is a code clone of "comment in body".
4574              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4575              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4576              !!!next-token;              !!!next-token;
4577              redo B;              redo B;
4578            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 4182  sub _construct_tree ($) { Line 4583  sub _construct_tree ($) {
4583                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
4584                ## have an element in table scope                ## have an element in table scope
4585                my $tn;                my $tn;
4586                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4587                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4588                  if ($node->[1] eq 'td' or $node->[1] eq 'th') {                  if ($node->[1] eq 'td' or $node->[1] eq 'th') {
4589                    $tn = $node->[1];                    $tn = $node->[1];
4590                    last INSCOPE;                    last INSCOPE;
# Line 4194  sub _construct_tree ($) { Line 4595  sub _construct_tree ($) {
4595                  }                  }
4596                } # INSCOPE                } # INSCOPE
4597                unless (defined $tn) {                unless (defined $tn) {
4598                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4599                  ## Ignore the token                  ## Ignore the token
4600                  !!!next-token;                  !!!next-token;
4601                  redo B;                  redo B;
# Line 4211  sub _construct_tree ($) { Line 4612  sub _construct_tree ($) {
4612              if ($token->{tag_name} eq 'td' or $token->{tag_name} eq 'th') {              if ($token->{tag_name} eq 'td' or $token->{tag_name} eq 'th') {
4613                ## have an element in table scope                ## have an element in table scope
4614                my $i;                my $i;
4615                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4616                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4617                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4618                    $i = $_;                    $i = $_;
4619                    last INSCOPE;                    last INSCOPE;
# Line 4223  sub _construct_tree ($) { Line 4624  sub _construct_tree ($) {
4624                  }                  }
4625                } # INSCOPE                } # INSCOPE
4626                unless (defined $i) {                unless (defined $i) {
4627                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4628                  ## Ignore the token                  ## Ignore the token
4629                  !!!next-token;                  !!!next-token;
4630                  redo B;                  redo B;
# Line 4235  sub _construct_tree ($) { Line 4636  sub _construct_tree ($) {
4636                     td => ($token->{tag_name} eq 'th'),                     td => ($token->{tag_name} eq 'th'),
4637                     th => ($token->{tag_name} eq 'td'),                     th => ($token->{tag_name} eq 'td'),
4638                     tr => 1,                     tr => 1,
4639                    }->{$open_elements->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
4640                  !!!back-token;                  !!!back-token;
4641                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4642                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4643                  redo B;                  redo B;
4644                }                }
4645    
4646                if ($open_elements->[-1]->[1] ne $token->{tag_name}) {                if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
4647                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4648                }                }
4649    
4650                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4651    
4652                $clear_up_to_marker->();                $clear_up_to_marker->();
4653    
4654                $insertion_mode = 'in row';                $self->{insertion_mode} = 'in row';
4655    
4656                !!!next-token;                !!!next-token;
4657                redo B;                redo B;
# Line 4258  sub _construct_tree ($) { Line 4659  sub _construct_tree ($) {
4659                        body => 1, caption => 1, col => 1,                        body => 1, caption => 1, col => 1,
4660                        colgroup => 1, html => 1,                        colgroup => 1, html => 1,
4661                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4662                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4663                ## Ignore the token                ## Ignore the token
4664                !!!next-token;                !!!next-token;
4665                redo B;                redo B;
# Line 4269  sub _construct_tree ($) { Line 4670  sub _construct_tree ($) {
4670                ## have an element in table scope                ## have an element in table scope
4671                my $i;                my $i;
4672                my $tn;                my $tn;
4673                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4674                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4675                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4676                    $i = $_;                    $i = $_;
4677                    last INSCOPE;                    last INSCOPE;
# Line 4285  sub _construct_tree ($) { Line 4686  sub _construct_tree ($) {
4686                  }                  }
4687                } # INSCOPE                } # INSCOPE
4688                unless (defined $i) {                unless (defined $i) {
4689                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4690                  ## Ignore the token                  ## Ignore the token
4691                  !!!next-token;                  !!!next-token;
4692                  redo B;                  redo B;
# Line 4304  sub _construct_tree ($) { Line 4705  sub _construct_tree ($) {
4705                        
4706            $in_body->($insert_to_current);            $in_body->($insert_to_current);
4707            redo B;            redo B;
4708          } elsif ($insertion_mode eq 'in select') {          } elsif ($self->{insertion_mode} eq 'in select') {
4709            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4710              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4711              !!!next-token;              !!!next-token;
4712              redo B;              redo B;
4713            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4714              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4715              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4716              !!!next-token;              !!!next-token;
4717              redo B;              redo B;
4718            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4719              if ($token->{tag_name} eq 'option') {              if ($token->{tag_name} eq 'option') {
4720                if ($open_elements->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
4721                  ## As if </option>                  ## As if </option>
4722                  pop @$open_elements;                  pop @{$self->{open_elements}};
4723                }                }
4724    
4725                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4726                !!!next-token;                !!!next-token;
4727                redo B;                redo B;
4728              } elsif ($token->{tag_name} eq 'optgroup') {              } elsif ($token->{tag_name} eq 'optgroup') {
4729                if ($open_elements->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
4730                  ## As if </option>                  ## As if </option>
4731                  pop @$open_elements;                  pop @{$self->{open_elements}};
4732                }                }
4733    
4734                if ($open_elements->[-1]->[1] eq 'optgroup') {                if ($self->{open_elements}->[-1]->[1] eq 'optgroup') {
4735                  ## As if </optgroup>                  ## As if </optgroup>
4736                  pop @$open_elements;                  pop @{$self->{open_elements}};
4737                }                }
4738    
4739                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4740                !!!next-token;                !!!next-token;
4741                redo B;                redo B;
4742              } elsif ($token->{tag_name} eq 'select') {              } elsif ($token->{tag_name} eq 'select') {
4743                !!!parse-error;                !!!parse-error (type => 'not closed:select');
4744                ## As if </select> instead                ## As if </select> instead
4745                ## have an element in table scope                ## have an element in table scope
4746                my $i;                my $i;
4747                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4748                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4749                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4750                    $i = $_;                    $i = $_;
4751                    last INSCOPE;                    last INSCOPE;
# Line 4355  sub _construct_tree ($) { Line 4756  sub _construct_tree ($) {
4756                  }                  }
4757                } # INSCOPE                } # INSCOPE
4758                unless (defined $i) {                unless (defined $i) {
4759                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:select');
4760                  ## Ignore the token                  ## Ignore the token
4761                  !!!next-token;                  !!!next-token;
4762                  redo B;                  redo B;
4763                }                }
4764                                
4765                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4766    
4767                $reset_insertion_mode->();                $self->_reset_insertion_mode;
4768    
4769                !!!next-token;                !!!next-token;
4770                redo B;                redo B;
# Line 4372  sub _construct_tree ($) { Line 4773  sub _construct_tree ($) {
4773              }              }
4774            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
4775              if ($token->{tag_name} eq 'optgroup') {              if ($token->{tag_name} eq 'optgroup') {
4776                if ($open_elements->[-1]->[1] eq 'option' and                if ($self->{open_elements}->[-1]->[1] eq 'option' and
4777                    $open_elements->[-2]->[1] eq 'optgroup') {                    $self->{open_elements}->[-2]->[1] eq 'optgroup') {
4778                  ## As if </option>                  ## As if </option>
4779                  splice @$open_elements, -2;                  splice @{$self->{open_elements}}, -2;
4780                } elsif ($open_elements->[-1]->[1] eq 'optgroup') {                } elsif ($self->{open_elements}->[-1]->[1] eq 'optgroup') {
4781                  pop @$open_elements;                  pop @{$self->{open_elements}};
4782                } else {                } else {
4783                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4784                  ## Ignore the token                  ## Ignore the token
4785                }                }
4786                !!!next-token;                !!!next-token;
4787                redo B;                redo B;
4788              } elsif ($token->{tag_name} eq 'option') {              } elsif ($token->{tag_name} eq 'option') {
4789                if ($open_elements->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
4790                  pop @$open_elements;                  pop @{$self->{open_elements}};
4791                } else {                } else {
4792                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4793                  ## Ignore the token                  ## Ignore the token
4794                }                }
4795                !!!next-token;                !!!next-token;
# Line 4396  sub _construct_tree ($) { Line 4797  sub _construct_tree ($) {
4797              } elsif ($token->{tag_name} eq 'select') {              } elsif ($token->{tag_name} eq 'select') {
4798                ## have an element in table scope                ## have an element in table scope
4799                my $i;                my $i;
4800                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4801                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4802                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4803                    $i = $_;                    $i = $_;
4804                    last INSCOPE;                    last INSCOPE;
# Line 4408  sub _construct_tree ($) { Line 4809  sub _construct_tree ($) {
4809                  }                  }
4810                } # INSCOPE                } # INSCOPE
4811                unless (defined $i) {                unless (defined $i) {
4812                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4813                  ## Ignore the token                  ## Ignore the token
4814                  !!!next-token;                  !!!next-token;
4815                  redo B;                  redo B;
4816                }                }
4817                                
4818                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4819    
4820                $reset_insertion_mode->();                $self->_reset_insertion_mode;
4821    
4822                !!!next-token;                !!!next-token;
4823                redo B;                redo B;
# Line 4424  sub _construct_tree ($) { Line 4825  sub _construct_tree ($) {
4825                        caption => 1, table => 1, tbody => 1,                        caption => 1, table => 1, tbody => 1,
4826                        tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,                        tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,
4827                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4828                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4829                                
4830                ## have an element in table scope                ## have an element in table scope
4831                my $i;                my $i;
4832                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4833                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4834                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4835                    $i = $_;                    $i = $_;
4836                    last INSCOPE;                    last INSCOPE;
# Line 4448  sub _construct_tree ($) { Line 4849  sub _construct_tree ($) {
4849                ## As if </select>                ## As if </select>
4850                ## have an element in table scope                ## have an element in table scope
4851                undef $i;                undef $i;
4852                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4853                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4854                  if ($node->[1] eq 'select') {                  if ($node->[1] eq 'select') {
4855                    $i = $_;                    $i = $_;
4856                    last INSCOPE;                    last INSCOPE;
# Line 4460  sub _construct_tree ($) { Line 4861  sub _construct_tree ($) {
4861                  }                  }
4862                } # INSCOPE                } # INSCOPE
4863                unless (defined $i) {                unless (defined $i) {
4864                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:select');
4865                  ## Ignore the </select> token                  ## Ignore the </select> token
4866                  !!!next-token; ## TODO: ok?                  !!!next-token; ## TODO: ok?
4867                  redo B;                  redo B;
4868                }                }
4869                                
4870                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4871    
4872                $reset_insertion_mode->();                $self->_reset_insertion_mode;
4873    
4874                ## reprocess                ## reprocess
4875                redo B;                redo B;
# Line 4479  sub _construct_tree ($) { Line 4880  sub _construct_tree ($) {
4880              #              #
4881            }            }
4882    
4883            !!!parse-error;            !!!parse-error (type => 'in select:'.$token->{tag_name});
4884            ## Ignore the token            ## Ignore the token
4885            !!!next-token;            !!!next-token;
4886            redo B;            redo B;
4887          } elsif ($insertion_mode eq 'after body') {          } elsif ($self->{insertion_mode} eq 'after body') {
4888            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4889              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4890                ## As if in body                ## As if in body
4891                $reconstruct_active_formatting_elements->($insert_to_current);                $reconstruct_active_formatting_elements->($insert_to_current);
4892                                
4893                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4894    
4895                unless (length $token->{data}) {                unless (length $token->{data}) {
4896                  !!!next-token;                  !!!next-token;
# Line 4498  sub _construct_tree ($) { Line 4899  sub _construct_tree ($) {
4899              }              }
4900                            
4901              #              #
4902                !!!parse-error (type => 'after body:#'.$token->{type});
4903            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4904              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4905              $open_elements->[0]->[0]->append_child ($comment);              $self->{open_elements}->[0]->[0]->append_child ($comment);
4906              !!!next-token;              !!!next-token;
4907              redo B;              redo B;
4908              } elsif ($token->{type} eq 'start tag') {
4909                !!!parse-error (type => 'after body:'.$token->{tag_name});
4910                #
4911            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
4912              if ($token->{tag_name} eq 'html') {              if ($token->{tag_name} eq 'html') {
4913                ## TODO: if inner_html, parse-error, ignore the token; otherwise,                if (defined $self->{inner_html_node}) {
4914                    !!!parse-error (type => 'unmatched end tag:html');
4915                $phase = 'trailing end';                  ## Ignore the token
4916                !!!next-token;                  !!!next-token;
4917                redo B;                  redo B;
4918                  } else {
4919                    $phase = 'trailing end';
4920                    !!!next-token;
4921                    redo B;
4922                  }
4923              } else {              } else {
4924                #                !!!parse-error (type => 'after body:/'.$token->{tag_name});
4925              }              }
4926            } else {            } else {
4927              #              !!!parse-error (type => 'after body:#'.$token->{type});
4928            }            }
4929    
4930            !!!parse-error ('data after body');            $self->{insertion_mode} = 'in body';
           $insertion_mode = 'in body';  
4931            ## reprocess            ## reprocess
4932            redo B;            redo B;
4933          } elsif ($insertion_mode eq 'in frameset') {          } elsif ($self->{insertion_mode} eq 'in frameset') {
4934            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4935              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4936                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4937    
4938                unless (length $token->{data}) {                unless (length $token->{data}) {
4939                  !!!next-token;                  !!!next-token;
# Line 4535  sub _construct_tree ($) { Line 4944  sub _construct_tree ($) {
4944              #              #
4945            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4946              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4947              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4948              !!!next-token;              !!!next-token;
4949              redo B;              redo B;
4950            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 4545  sub _construct_tree ($) { Line 4954  sub _construct_tree ($) {
4954                redo B;                redo B;
4955              } elsif ($token->{tag_name} eq 'frame') {              } elsif ($token->{tag_name} eq 'frame') {
4956                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4957                pop @$open_elements;                pop @{$self->{open_elements}};
4958                !!!next-token;                !!!next-token;
4959                redo B;                redo B;
4960              } elsif ($token->{tag_name} eq 'noframes') {              } elsif ($token->{tag_name} eq 'noframes') {
# Line 4556  sub _construct_tree ($) { Line 4965  sub _construct_tree ($) {
4965              }              }
4966            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
4967              if ($token->{tag_name} eq 'frameset') {              if ($token->{tag_name} eq 'frameset') {
4968                if ($open_elements->[-1]->[1] eq 'html' and                if ($self->{open_elements}->[-1]->[1] eq 'html' and
4969                    @$open_elements == 1) {                    @{$self->{open_elements}} == 1) {
4970                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4971                  ## Ignore the token                  ## Ignore the token
4972                  !!!next-token;                  !!!next-token;
4973                } else {                } else {
4974                  pop @$open_elements;                  pop @{$self->{open_elements}};
4975                  !!!next-token;                  !!!next-token;
4976                }                }
4977                                
4978                ## if not inner_html and                ## if not inner_html and
4979                if ($open_elements->[-1]->[1] ne 'frameset') {                if ($self->{open_elements}->[-1]->[1] ne 'frameset') {
4980                  $insertion_mode = 'after frameset';                  $self->{insertion_mode} = 'after frameset';
4981                }                }
4982                redo B;                redo B;
4983              } else {              } else {
# Line 4578  sub _construct_tree ($) { Line 4987  sub _construct_tree ($) {
4987              #              #
4988            }            }
4989                        
4990            !!!parse-error;            if (defined $token->{tag_name}) {
4991                !!!parse-error (type => 'in frameset:'.$token->{tag_name});
4992              } else {
4993                !!!parse-error (type => 'in frameset:#'.$token->{type});
4994              }
4995            ## Ignore the token            ## Ignore the token
4996            !!!next-token;            !!!next-token;
4997            redo B;            redo B;
4998          } elsif ($insertion_mode eq 'after frameset') {          } elsif ($self->{insertion_mode} eq 'after frameset') {
4999            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
5000              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5001                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
5002    
5003                unless (length $token->{data}) {                unless (length $token->{data}) {
5004                  !!!next-token;                  !!!next-token;
# Line 4596  sub _construct_tree ($) { Line 5009  sub _construct_tree ($) {
5009              #              #
5010            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
5011              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
5012              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
5013              !!!next-token;              !!!next-token;
5014              redo B;              redo B;
5015            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 4618  sub _construct_tree ($) { Line 5031  sub _construct_tree ($) {
5031              #              #
5032            }            }
5033                        
5034            !!!parse-error;            if (defined $token->{tag_name}) {
5035                !!!parse-error (type => 'after frameset:'.$token->{tag_name});
5036              } else {
5037                !!!parse-error (type => 'after frameset:#'.$token->{type});
5038              }
5039            ## Ignore the token            ## Ignore the token
5040            !!!next-token;            !!!next-token;
5041            redo B;            redo B;
5042    
5043            ## ISSUE: An issue in spec there            ## ISSUE: An issue in spec there
5044          } else {          } else {
5045            die "$0: $insertion_mode: Unknown insertion mode";            die "$0: $self->{insertion_mode}: Unknown insertion mode";
5046          }          }
5047        }        }
5048      } elsif ($phase eq 'trailing end') {      } elsif ($phase eq 'trailing end') {
5049        ## states in the main stage is preserved yet # MUST        ## states in the main stage is preserved yet # MUST
5050                
5051        if ($token->{type} eq 'DOCTYPE') {        if ($token->{type} eq 'DOCTYPE') {
5052          !!!parse-error;          !!!parse-error (type => 'after html:#DOCTYPE');
5053          ## Ignore the token          ## Ignore the token
5054          !!!next-token;          !!!next-token;
5055          redo B;          redo B;
# Line 4651  sub _construct_tree ($) { Line 5068  sub _construct_tree ($) {
5068            $reconstruct_active_formatting_elements->($insert_to_current)            $reconstruct_active_formatting_elements->($insert_to_current)
5069              if $phase eq 'main';              if $phase eq 'main';
5070                        
5071            $open_elements->[-1]->[0]->manakai_append_text ($data);            $self->{open_elements}->[-1]->[0]->manakai_append_text ($data);
5072                        
5073            unless (length $token->{data}) {            unless (length $token->{data}) {
5074              !!!next-token;              !!!next-token;
# Line 4659  sub _construct_tree ($) { Line 5076  sub _construct_tree ($) {
5076            }            }
5077          }          }
5078    
5079          !!!parse-error;          !!!parse-error (type => 'after html:#character');
5080          $phase = 'main';          $phase = 'main';
5081          ## reprocess          ## reprocess
5082          redo B;          redo B;
5083        } elsif ($token->{type} eq 'start tag' or        } elsif ($token->{type} eq 'start tag' or
5084                 $token->{type} eq 'end tag') {                 $token->{type} eq 'end tag') {
5085          !!!parse-error;          !!!parse-error (type => 'after html:'.$token->{tag_name});
5086          $phase = 'main';          $phase = 'main';
5087          ## reprocess          ## reprocess
5088          redo B;          redo B;
# Line 4681  sub _construct_tree ($) { Line 5098  sub _construct_tree ($) {
5098    ## Stop parsing # MUST    ## Stop parsing # MUST
5099        
5100    ## TODO: script stuffs    ## TODO: script stuffs
5101  } # _construct_tree  } # _tree_construct_main
5102    
5103    sub set_inner_html ($$$) {
5104      my $class = shift;
5105      my $node = shift;
5106      my $s = \$_[0];
5107      my $onerror = $_[1];
5108    
5109      my $nt = $node->node_type;
5110      if ($nt == 9) {
5111        # MUST
5112        
5113        ## Step 1 # MUST
5114        ## TODO: If the document has an active parser, ...
5115        ## ISSUE: There is an issue in the spec.
5116        
5117        ## Step 2 # MUST
5118        my @cn = @{$node->child_nodes};
5119        for (@cn) {
5120          $node->remove_child ($_);
5121        }
5122    
5123        ## Step 3, 4, 5 # MUST
5124        $class->parse_string ($$s => $node, $onerror);
5125      } elsif ($nt == 1) {
5126        ## TODO: If non-html element
5127    
5128        ## NOTE: Most of this code is copied from |parse_string|
5129    
5130        ## Step 1 # MUST
5131        my $this_doc = $node->owner_document;
5132        my $doc = $this_doc->implementation->create_document;
5133        $doc->manakai_is_html (1);
5134        my $p = $class->new;
5135        $p->{document} = $doc;
5136    
5137        ## Step 9 # MUST
5138        my $i = 0;
5139        my $line = 1;
5140        my $column = 0;
5141        $p->{set_next_input_character} = sub {
5142          my $self = shift;
5143    
5144          pop @{$self->{prev_input_character}};
5145          unshift @{$self->{prev_input_character}}, $self->{next_input_character};
5146    
5147          $self->{next_input_character} = -1 and return if $i >= length $$s;
5148          $self->{next_input_character} = ord substr $$s, $i++, 1;
5149          $column++;
5150    
5151          if ($self->{next_input_character} == 0x000A) { # LF
5152            $line++;
5153            $column = 0;
5154          } elsif ($self->{next_input_character} == 0x000D) { # CR
5155            $i++ if substr ($$s, $i, 1) eq "\x0A";
5156            $self->{next_input_character} = 0x000A; # LF # MUST
5157            $line++;
5158            $column = 0;
5159          } elsif ($self->{next_input_character} > 0x10FFFF) {
5160            $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5161          } elsif ($self->{next_input_character} == 0x0000) { # NULL
5162            !!!parse-error (type => 'NULL');
5163            $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5164          }
5165        };
5166        $p->{prev_input_character} = [-1, -1, -1];
5167        $p->{next_input_character} = -1;
5168        
5169        my $ponerror = $onerror || sub {
5170          my (%opt) = @_;
5171          warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n";
5172        };
5173        $p->{parse_error} = sub {
5174          $ponerror->(@_, line => $line, column => $column);
5175        };
5176        
5177        $p->_initialize_tokenizer;
5178        $p->_initialize_tree_constructor;
5179    
5180        ## Step 2
5181        my $node_ln = $node->local_name;
5182        $p->{content_model_flag} = {
5183          title => 'RCDATA',
5184          textarea => 'RCDATA',
5185          style => 'CDATA',
5186          script => 'CDATA',
5187          xmp => 'CDATA',
5188          iframe => 'CDATA',
5189          noembed => 'CDATA',
5190          noframes => 'CDATA',
5191          noscript => 'CDATA',
5192          plaintext => 'PLAINTEXT',
5193        }->{$node_ln} || 'PCDATA';
5194           ## ISSUE: What is "the name of the element"? local name?
5195    
5196        $p->{inner_html_node} = [$node, $node_ln];
5197    
5198        ## Step 4
5199        my $root = $doc->create_element_ns
5200          ('http://www.w3.org/1999/xhtml', [undef, 'html']);
5201    
5202        ## Step 5 # MUST
5203        $doc->append_child ($root);
5204    
5205        ## Step 6 # MUST
5206        push @{$p->{open_elements}}, [$root, 'html'];
5207    
5208        undef $p->{head_element};
5209    
5210        ## Step 7 # MUST
5211        $p->_reset_insertion_mode;
5212    
5213        ## Step 8 # MUST
5214        my $anode = $node;
5215        AN: while (defined $anode) {
5216          if ($anode->node_type == 1) {
5217            my $nsuri = $anode->namespace_uri;
5218            if (defined $nsuri and $nsuri eq 'http://www.w3.org/1999/xhtml') {
5219              if ($anode->local_name eq 'form') { ## TODO: case?
5220                $p->{form_element} = $anode;
5221                last AN;
5222              }
5223            }
5224          }
5225          $anode = $anode->parent_node;
5226        } # AN
5227        
5228        ## Step 3 # MUST
5229        ## Step 10 # MUST
5230        {
5231          my $self = $p;
5232          !!!next-token;
5233        }
5234        $p->_tree_construction_main;
5235    
5236        ## Step 11 # MUST
5237        my @cn = @{$node->child_nodes};
5238        for (@cn) {
5239          $node->remove_child ($_);
5240        }
5241        ## ISSUE: mutation events? read-only?
5242    
5243        ## Step 12 # MUST
5244        @cn = @{$root->child_nodes};
5245        for (@cn) {
5246          $this_doc->adopt_node ($_);
5247          $node->append_child ($_);
5248        }
5249        ## ISSUE: mutation events?
5250    
5251        $p->_terminate_tree_constructor;
5252      } else {
5253        die "$0: |set_inner_html| is not defined for node of type $nt";
5254      }
5255    } # set_inner_html
5256    
5257    } # tree construction stage
5258    
5259  sub get_inner_html ($$$) {  sub get_inner_html ($$$) {
5260    my ($class, $node, $on_error) = @_;    my (undef, $node, $on_error) = @_;
5261    
5262    ## Step 1    ## Step 1
5263    my $s = '';    my $s = '';
# Line 4718  sub get_inner_html ($$$) { Line 5291  sub get_inner_html ($$$) {
5291            
5292      my $nt = $child->node_type;      my $nt = $child->node_type;
5293      if ($nt == 1) { # Element      if ($nt == 1) { # Element
5294        my $tag_name = lc $child->tag_name; ## ISSUE: Definition of "lowercase"        my $tag_name = $child->tag_name; ## TODO: manakai_tag_name
5295        $s .= '<' . $tag_name;        $s .= '<' . $tag_name;
5296          ## NOTE: Non-HTML case:
5297        ## ISSUE: Non-html elements        ## <http://permalink.gmane.org/gmane.org.w3c.whatwg.discuss/11191>
5298    
5299        my @attrs = @{$child->attributes}; # sort order MUST be stable        my @attrs = @{$child->attributes}; # sort order MUST be stable
5300        for my $attr (@attrs) { # order is implementation dependent        for my $attr (@attrs) { # order is implementation dependent
5301          my $attr_name = lc $attr->name; ## ISSUE: Definition of "lowercase"          my $attr_name = $attr->name; ## TODO: manakai_name
5302          $s .= ' ' . $attr_name . '="';          $s .= ' ' . $attr_name . '="';
5303          my $attr_value = $attr->value;          my $attr_value = $attr->value;
5304          ## escape          ## escape
# Line 4744  sub get_inner_html ($$$) { Line 5317  sub get_inner_html ($$$) {
5317          spacer => 1, wbr => 1,          spacer => 1, wbr => 1,
5318        }->{$tag_name};        }->{$tag_name};
5319    
5320          $s .= "\x0A" if $tag_name eq 'pre' or $tag_name eq 'textarea';
5321    
5322        if (not $in_cdata and {        if (not $in_cdata and {
5323          style => 1, script => 1, xmp => 1, iframe => 1,          style => 1, script => 1, xmp => 1, iframe => 1,
5324          noembed => 1, noframes => 1, noscript => 1,          noembed => 1, noframes => 1, noscript => 1,
5325            plaintext => 1,
5326        }->{$tag_name}) {        }->{$tag_name}) {
5327          unshift @node, 'cdata-out';          unshift @node, 'cdata-out';
5328          $in_cdata = 1;          $in_cdata = 1;

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.27

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24