/[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.31 by wakaba, Sat Jun 30 14:13:19 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    ## ISSUE: HTML5 revision 967 says that the encoding layer MUST NOT
11    ## strip BOM and the HTML layer MUST ignore it.  Whether we can do it
12    ## is not yet clear.
13    ## "{U+FEFF}..." in UTF-16BE/UTF-16LE is three or four characters?
14    ## "{U+FEFF}..." in GB18030?
15    
16  my $permitted_slash_tag_name = {  my $permitted_slash_tag_name = {
17    base => 1,    base => 1,
# Line 18  my $permitted_slash_tag_name = { Line 27  my $permitted_slash_tag_name = {
27    input => 1,    input => 1,
28  };  };
29    
30  my $entity_char = {  my $c1_entity_char = {
31    AElig => "\x{00C6}",    0x80 => 0x20AC,
32    Aacute => "\x{00C1}",    0x81 => 0xFFFD,
33    Acirc => "\x{00C2}",    0x82 => 0x201A,
34    Agrave => "\x{00C0}",    0x83 => 0x0192,
35    Alpha => "\x{0391}",    0x84 => 0x201E,
36    Aring => "\x{00C5}",    0x85 => 0x2026,
37    Atilde => "\x{00C3}",    0x86 => 0x2020,
38    Auml => "\x{00C4}",    0x87 => 0x2021,
39    Beta => "\x{0392}",    0x88 => 0x02C6,
40    Ccedil => "\x{00C7}",    0x89 => 0x2030,
41    Chi => "\x{03A7}",    0x8A => 0x0160,
42    Dagger => "\x{2021}",    0x8B => 0x2039,
43    Delta => "\x{0394}",    0x8C => 0x0152,
44    ETH => "\x{00D0}",    0x8D => 0xFFFD,
45    Eacute => "\x{00C9}",    0x8E => 0x017D,
46    Ecirc => "\x{00CA}",    0x8F => 0xFFFD,
47    Egrave => "\x{00C8}",    0x90 => 0xFFFD,
48    Epsilon => "\x{0395}",    0x91 => 0x2018,
49    Eta => "\x{0397}",    0x92 => 0x2019,
50    Euml => "\x{00CB}",    0x93 => 0x201C,
51    Gamma => "\x{0393}",    0x94 => 0x201D,
52    Iacute => "\x{00CD}",    0x95 => 0x2022,
53    Icirc => "\x{00CE}",    0x96 => 0x2013,
54    Igrave => "\x{00CC}",    0x97 => 0x2014,
55    Iota => "\x{0399}",    0x98 => 0x02DC,
56    Iuml => "\x{00CF}",    0x99 => 0x2122,
57    Kappa => "\x{039A}",    0x9A => 0x0161,
58    Lambda => "\x{039B}",    0x9B => 0x203A,
59    Mu => "\x{039C}",    0x9C => 0x0153,
60    Ntilde => "\x{00D1}",    0x9D => 0xFFFD,
61    Nu => "\x{039D}",    0x9E => 0x017E,
62    OElig => "\x{0152}",    0x9F => 0x0178,
63    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}",  
 };  
64    
65  my $special_category = {  my $special_category = {
66    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 89  sub parse_string ($$$;$) {
89    my $s = \$_[0];    my $s = \$_[0];
90    $self->{document} = $_[1];    $self->{document} = $_[1];
91    
92    my $i;    ## NOTE: |set_inner_html| copies most of this method's code
93    
94    my $i = 0;    my $i = 0;
95      my $line = 1;
96      my $column = 0;
97    $self->{set_next_input_character} = sub {    $self->{set_next_input_character} = sub {
98      my $self = shift;      my $self = shift;
99    
100        pop @{$self->{prev_input_character}};
101        unshift @{$self->{prev_input_character}}, $self->{next_input_character};
102    
103      $self->{next_input_character} = -1 and return if $i >= length $$s;      $self->{next_input_character} = -1 and return if $i >= length $$s;
104      $self->{next_input_character} = ord substr $$s, $i++, 1;      $self->{next_input_character} = ord substr $$s, $i++, 1;
105        $column++;
106            
107      if ($self->{next_input_character} == 0x000D) { # CR      if ($self->{next_input_character} == 0x000A) { # LF
108        if ($i >= length $$s) {        $line++;
109          #        $column = 0;
110        } else {      } elsif ($self->{next_input_character} == 0x000D) { # CR
111          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;  
         }  
       }  
112        $self->{next_input_character} = 0x000A; # LF # MUST        $self->{next_input_character} = 0x000A; # LF # MUST
113          $line++;
114          $column = 0;
115      } elsif ($self->{next_input_character} > 0x10FFFF) {      } elsif ($self->{next_input_character} > 0x10FFFF) {
116        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
117      } elsif ($self->{next_input_character} == 0x0000) { # NULL      } elsif ($self->{next_input_character} == 0x0000) { # NULL
118          !!!parse-error (type => 'NULL');
119        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
120      }      }
121    };    };
122      $self->{prev_input_character} = [-1, -1, -1];
123      $self->{next_input_character} = -1;
124    
125    $self->{parse_error} = $_[2] || sub {    my $onerror = $_[2] || sub {
126      warn "Parse error at character $i\n"; ## TODO: Report (line, column) pair      my (%opt) = @_;
127        warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n";
128      };
129      $self->{parse_error} = sub {
130        $onerror->(@_, line => $line, column => $column);
131    };    };
132    
133    $self->_initialize_tokenizer;    $self->_initialize_tokenizer;
# Line 371  sub _initialize_tokenizer ($) { Line 164  sub _initialize_tokenizer ($) {
164    # $self->{next_input_character}    # $self->{next_input_character}
165    !!!next-input-character;    !!!next-input-character;
166    $self->{token} = [];    $self->{token} = [];
167      # $self->{escape}
168  } # _initialize_tokenizer  } # _initialize_tokenizer
169    
170  ## A token has:  ## A token has:
171  ##   ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',  ##   ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',
172  ##       'character', or 'end-of-file'  ##       'character', or 'end-of-file'
173  ##   ->{name} (DOCTYPE, start tag (tagname), end tag (tagname))  ##   ->{name} (DOCTYPE, start tag (tag name), end tag (tag name))
174      ## ISSUE: the spec need s/tagname/tag name/  ##   ->{public_identifier} (DOCTYPE)
175  ##   ->{error} == 1 or 0 (DOCTYPE)  ##   ->{system_identifier} (DOCTYPE)
176    ##   ->{correct} == 1 or 0 (DOCTYPE)
177  ##   ->{attributes} isa HASH (start tag, end tag)  ##   ->{attributes} isa HASH (start tag, end tag)
178  ##   ->{data} (comment, character)  ##   ->{data} (comment, character)
179    
 ## Macros  
 ##   Macros MUST be preceded by three EXCLAMATION MARKs.  
 ##   emit ($token)  
 ##     Emits the specified token.  
   
180  ## Emitted token MUST immediately be handled by the tree construction state.  ## Emitted token MUST immediately be handled by the tree construction state.
181    
182  ## 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 202  sub _get_next_token ($) {
202          } else {          } else {
203            #            #
204          }          }
205          } elsif ($self->{next_input_character} == 0x002D) { # -
206            if ($self->{content_model_flag} eq 'RCDATA' or
207                $self->{content_model_flag} eq 'CDATA') {
208              unless ($self->{escape}) {
209                if ($self->{prev_input_character}->[0] == 0x002D and # -
210                    $self->{prev_input_character}->[1] == 0x0021 and # !
211                    $self->{prev_input_character}->[2] == 0x003C) { # <
212                  $self->{escape} = 1;
213                }
214              }
215            }
216            
217            #
218        } elsif ($self->{next_input_character} == 0x003C) { # <        } elsif ($self->{next_input_character} == 0x003C) { # <
219          if ($self->{content_model_flag} ne 'PLAINTEXT') {          if ($self->{content_model_flag} eq 'PCDATA' or
220                (($self->{content_model_flag} eq 'CDATA' or
221                  $self->{content_model_flag} eq 'RCDATA') and
222                 not $self->{escape})) {
223            $self->{state} = 'tag open';            $self->{state} = 'tag open';
224            !!!next-input-character;            !!!next-input-character;
225            redo A;            redo A;
226          } else {          } else {
227            #            #
228          }          }
229          } elsif ($self->{next_input_character} == 0x003E) { # >
230            if ($self->{escape} and
231                ($self->{content_model_flag} eq 'RCDATA' or
232                 $self->{content_model_flag} eq 'CDATA')) {
233              if ($self->{prev_input_character}->[0] == 0x002D and # -
234                  $self->{prev_input_character}->[1] == 0x002D) { # -
235                delete $self->{escape};
236              }
237            }
238            
239            #
240        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
241          !!!emit ({type => 'end-of-file'});          !!!emit ({type => 'end-of-file'});
242          last A; ## TODO: ok?          last A; ## TODO: ok?
# Line 436  sub _get_next_token ($) { Line 253  sub _get_next_token ($) {
253      } elsif ($self->{state} eq 'entity data') {      } elsif ($self->{state} eq 'entity data') {
254        ## (cannot happen in CDATA state)        ## (cannot happen in CDATA state)
255                
256        my $token = $self->_tokenize_attempt_to_consume_an_entity;        my $token = $self->_tokenize_attempt_to_consume_an_entity (0);
257    
258        $self->{state} = 'data';        $self->{state} = 'data';
259        # next-input-character is already done        # next-input-character is already done
# Line 488  sub _get_next_token ($) { Line 305  sub _get_next_token ($) {
305            !!!next-input-character;            !!!next-input-character;
306            redo A;            redo A;
307          } elsif ($self->{next_input_character} == 0x003E) { # >          } elsif ($self->{next_input_character} == 0x003E) { # >
308            !!!parse-error;            !!!parse-error (type => 'empty start tag');
309            $self->{state} = 'data';            $self->{state} = 'data';
310            !!!next-input-character;            !!!next-input-character;
311    
# Line 496  sub _get_next_token ($) { Line 313  sub _get_next_token ($) {
313    
314            redo A;            redo A;
315          } elsif ($self->{next_input_character} == 0x003F) { # ?          } elsif ($self->{next_input_character} == 0x003F) { # ?
316            !!!parse-error;            !!!parse-error (type => 'pio');
317            $self->{state} = 'bogus comment';            $self->{state} = 'bogus comment';
318            ## $self->{next_input_character} is intentionally left as is            ## $self->{next_input_character} is intentionally left as is
319            redo A;            redo A;
320          } else {          } else {
321            !!!parse-error;            !!!parse-error (type => 'bare stago');
322            $self->{state} = 'data';            $self->{state} = 'data';
323            ## reconsume            ## reconsume
324    
# Line 515  sub _get_next_token ($) { Line 332  sub _get_next_token ($) {
332      } elsif ($self->{state} eq 'close tag open') {      } elsif ($self->{state} eq 'close tag open') {
333        if ($self->{content_model_flag} eq 'RCDATA' or        if ($self->{content_model_flag} eq 'RCDATA' or
334            $self->{content_model_flag} eq 'CDATA') {            $self->{content_model_flag} eq 'CDATA') {
335          my @next_char;          if (defined $self->{last_emitted_start_tag_name}) {
336          TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>
337              my @next_char;
338              TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {
339                push @next_char, $self->{next_input_character};
340                my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);
341                my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;
342                if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {
343                  !!!next-input-character;
344                  next TAGNAME;
345                } else {
346                  $self->{next_input_character} = shift @next_char; # reconsume
347                  !!!back-next-input-character (@next_char);
348                  $self->{state} = 'data';
349    
350                  !!!emit ({type => 'character', data => '</'});
351      
352                  redo A;
353                }
354              }
355            push @next_char, $self->{next_input_character};            push @next_char, $self->{next_input_character};
356            my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);        
357            my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;            unless ($self->{next_input_character} == 0x0009 or # HT
358            if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {                    $self->{next_input_character} == 0x000A or # LF
359              !!!next-input-character;                    $self->{next_input_character} == 0x000B or # VT
360              next TAGNAME;                    $self->{next_input_character} == 0x000C or # FF
361            } else {                    $self->{next_input_character} == 0x0020 or # SP
362              !!!parse-error;                    $self->{next_input_character} == 0x003E or # >
363                      $self->{next_input_character} == 0x002F or # /
364                      $self->{next_input_character} == -1) {
365              $self->{next_input_character} = shift @next_char; # reconsume              $self->{next_input_character} = shift @next_char; # reconsume
366              !!!back-next-input-character (@next_char);              !!!back-next-input-character (@next_char);
367              $self->{state} = 'data';              $self->{state} = 'data';
   
368              !!!emit ({type => 'character', data => '</'});              !!!emit ({type => 'character', data => '</'});
   
369              redo A;              redo A;
370              } else {
371                $self->{next_input_character} = shift @next_char;
372                !!!back-next-input-character (@next_char);
373                # and consume...
374            }            }
375          }          } else {
376          push @next_char, $self->{next_input_character};            ## No start tag token has ever been emitted
377                  # 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);  
378            $self->{state} = 'data';            $self->{state} = 'data';
   
379            !!!emit ({type => 'character', data => '</'});            !!!emit ({type => 'character', data => '</'});
   
380            redo A;            redo A;
         } else {  
           $self->{next_input_character} = shift @next_char;  
           !!!back-next-input-character (@next_char);  
           # and consume...  
381          }          }
382        }        }
383                
# Line 575  sub _get_next_token ($) { Line 396  sub _get_next_token ($) {
396          !!!next-input-character;          !!!next-input-character;
397          redo A;          redo A;
398        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
399          !!!parse-error;          !!!parse-error (type => 'empty end tag');
400          $self->{state} = 'data';          $self->{state} = 'data';
401          !!!next-input-character;          !!!next-input-character;
402          redo A;          redo A;
403        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
404          !!!parse-error;          !!!parse-error (type => 'bare etago');
405          $self->{state} = 'data';          $self->{state} = 'data';
406          # reconsume          # reconsume
407    
# Line 588  sub _get_next_token ($) { Line 409  sub _get_next_token ($) {
409    
410          redo A;          redo A;
411        } else {        } else {
412          !!!parse-error;          !!!parse-error (type => 'bogus end tag');
413          $self->{state} = 'bogus comment';          $self->{state} = 'bogus comment';
414          ## $self->{next_input_character} is intentionally left as is          ## $self->{next_input_character} is intentionally left as is
415          redo A;          redo A;
# Line 604  sub _get_next_token ($) { Line 425  sub _get_next_token ($) {
425          redo A;          redo A;
426        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
427          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
428              $self->{current_token}->{first_start_tag}
429                  = not defined $self->{last_emitted_start_tag_name};
430            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
431          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
432            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
433            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
434              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
435            }            }
436          } else {          } else {
437            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 440  sub _get_next_token ($) {
440          !!!next-input-character;          !!!next-input-character;
441    
442          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
443    
444          redo A;          redo A;
445        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 627  sub _get_next_token ($) { Line 449  sub _get_next_token ($) {
449          ## Stay in this state          ## Stay in this state
450          !!!next-input-character;          !!!next-input-character;
451          redo A;          redo A;
452        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
453                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
454          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
455              $self->{current_token}->{first_start_tag}
456                  = not defined $self->{last_emitted_start_tag_name};
457            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
458          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
459            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
460            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
461              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
462            }            }
463          } else {          } else {
464            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 467  sub _get_next_token ($) {
467          # reconsume          # reconsume
468    
469          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
470    
471          redo A;          redo A;
472        } elsif ($self->{next_input_character} == 0x002F) { # /        } elsif ($self->{next_input_character} == 0x002F) { # /
# Line 655  sub _get_next_token ($) { Line 477  sub _get_next_token ($) {
477            # permitted slash            # permitted slash
478            #            #
479          } else {          } else {
480            !!!parse-error;            !!!parse-error (type => 'nestc');
481          }          }
482          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
483          # next-input-character is already done          # next-input-character is already done
# Line 678  sub _get_next_token ($) { Line 500  sub _get_next_token ($) {
500          redo A;          redo A;
501        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
502          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
503              $self->{current_token}->{first_start_tag}
504                  = not defined $self->{last_emitted_start_tag_name};
505            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
506          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
507            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
508            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
509              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
510            }            }
511          } else {          } else {
512            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 515  sub _get_next_token ($) {
515          !!!next-input-character;          !!!next-input-character;
516    
517          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
518    
519          redo A;          redo A;
520        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 709  sub _get_next_token ($) { Line 532  sub _get_next_token ($) {
532            # permitted slash            # permitted slash
533            #            #
534          } else {          } else {
535            !!!parse-error;            !!!parse-error (type => 'nestc');
536          }          }
537          ## Stay in the state          ## Stay in the state
538          # next-input-character is already done          # next-input-character is already done
539          redo A;          redo A;
540        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
541                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
542          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
543              $self->{current_token}->{first_start_tag}
544                  = not defined $self->{last_emitted_start_tag_name};
545            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
546          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
547            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
548            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
549              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
550            }            }
551          } else {          } else {
552            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 555  sub _get_next_token ($) {
555          # reconsume          # reconsume
556    
557          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
558    
559          redo A;          redo A;
560        } else {        } else {
# Line 745  sub _get_next_token ($) { Line 568  sub _get_next_token ($) {
568        my $before_leave = sub {        my $before_leave = sub {
569          if (exists $self->{current_token}->{attributes} # start tag or end tag          if (exists $self->{current_token}->{attributes} # start tag or end tag
570              ->{$self->{current_attribute}->{name}}) { # MUST              ->{$self->{current_attribute}->{name}}) { # MUST
571            !!!parse-error;            !!!parse-error (type => 'dupulicate attribute');
572            ## Discard $self->{current_attribute} # MUST            ## Discard $self->{current_attribute} # MUST
573          } else {          } else {
574            $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}}            $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}}
# Line 770  sub _get_next_token ($) { Line 593  sub _get_next_token ($) {
593        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
594          $before_leave->();          $before_leave->();
595          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
596              $self->{current_token}->{first_start_tag}
597                  = not defined $self->{last_emitted_start_tag_name};
598            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
599          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
600            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
601            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
602              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
603            }            }
604          } else {          } else {
605            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 608  sub _get_next_token ($) {
608          !!!next-input-character;          !!!next-input-character;
609    
610          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
611    
612          redo A;          redo A;
613        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 801  sub _get_next_token ($) { Line 625  sub _get_next_token ($) {
625            # permitted slash            # permitted slash
626            #            #
627          } else {          } else {
628            !!!parse-error;            !!!parse-error (type => 'nestc');
629          }          }
630          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
631          # next-input-character is already done          # next-input-character is already done
632          redo A;          redo A;
633        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
634                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
635          $before_leave->();          $before_leave->();
636          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
637              $self->{current_token}->{first_start_tag}
638                  = not defined $self->{last_emitted_start_tag_name};
639            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
640          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
641            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
642            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
643              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
644            }            }
645          } else {          } else {
646            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 649  sub _get_next_token ($) {
649          # reconsume          # reconsume
650    
651          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
652    
653          redo A;          redo A;
654        } else {        } else {
# Line 848  sub _get_next_token ($) { Line 672  sub _get_next_token ($) {
672          redo A;          redo A;
673        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
674          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
675              $self->{current_token}->{first_start_tag}
676                  = not defined $self->{last_emitted_start_tag_name};
677            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
678          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
679            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
680            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
681              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
682            }            }
683          } else {          } else {
684            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 687  sub _get_next_token ($) {
687          !!!next-input-character;          !!!next-input-character;
688    
689          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
690    
691          redo A;          redo A;
692        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 879  sub _get_next_token ($) { Line 704  sub _get_next_token ($) {
704            # permitted slash            # permitted slash
705            #            #
706          } else {          } else {
707            !!!parse-error;            !!!parse-error (type => 'nestc');
708          }          }
709          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
710          # next-input-character is already done          # next-input-character is already done
711          redo A;          redo A;
712        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
713                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
714          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
715              $self->{current_token}->{first_start_tag}
716                  = not defined $self->{last_emitted_start_tag_name};
717            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
718          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
719            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
720            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
721              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
722            }            }
723          } else {          } else {
724            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 727  sub _get_next_token ($) {
727          # reconsume          # reconsume
728    
729          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
730    
731          redo A;          redo A;
732        } else {        } else {
# Line 934  sub _get_next_token ($) { Line 759  sub _get_next_token ($) {
759          redo A;          redo A;
760        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
761          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
762              $self->{current_token}->{first_start_tag}
763                  = not defined $self->{last_emitted_start_tag_name};
764            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
765          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
766            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
767            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
768              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
769            }            }
770          } else {          } else {
771            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 774  sub _get_next_token ($) {
774          !!!next-input-character;          !!!next-input-character;
775    
776          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
777    
778          redo A;          redo A;
779        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
780                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
781          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
782              $self->{current_token}->{first_start_tag}
783                  = not defined $self->{last_emitted_start_tag_name};
784            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
785          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
786            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
787            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
788              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
789            }            }
790          } else {          } else {
791            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 794  sub _get_next_token ($) {
794          ## reconsume          ## reconsume
795    
796          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
797    
798          redo A;          redo A;
799        } else {        } else {
# Line 987  sub _get_next_token ($) { Line 813  sub _get_next_token ($) {
813          !!!next-input-character;          !!!next-input-character;
814          redo A;          redo A;
815        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
816          !!!parse-error;          !!!parse-error (type => 'unclosed attribute value');
817          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
818              $self->{current_token}->{first_start_tag}
819                  = not defined $self->{last_emitted_start_tag_name};
820            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
821          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
822            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
823            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
824              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
825            }            }
826          } else {          } else {
827            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 830  sub _get_next_token ($) {
830          ## reconsume          ## reconsume
831    
832          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
833    
834          redo A;          redo A;
835        } else {        } else {
# Line 1022  sub _get_next_token ($) { Line 849  sub _get_next_token ($) {
849          !!!next-input-character;          !!!next-input-character;
850          redo A;          redo A;
851        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
852          !!!parse-error;          !!!parse-error (type => 'unclosed attribute value');
853          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
854              $self->{current_token}->{first_start_tag}
855                  = not defined $self->{last_emitted_start_tag_name};
856            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
857          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
858            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
859            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
860              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
861            }            }
862          } else {          } else {
863            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 866  sub _get_next_token ($) {
866          ## reconsume          ## reconsume
867    
868          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
869    
870          redo A;          redo A;
871        } else {        } else {
# Line 1062  sub _get_next_token ($) { Line 890  sub _get_next_token ($) {
890          redo A;          redo A;
891        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
892          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
893              $self->{current_token}->{first_start_tag}
894                  = not defined $self->{last_emitted_start_tag_name};
895            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
896          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
897            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
898            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
899              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
900            }            }
901          } else {          } else {
902            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 905  sub _get_next_token ($) {
905          !!!next-input-character;          !!!next-input-character;
906    
907          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
908    
909          redo A;          redo A;
910        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
911                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
912          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
913              $self->{current_token}->{first_start_tag}
914                  = not defined $self->{last_emitted_start_tag_name};
915            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
916          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
917            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
918            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
919              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
920            }            }
921          } else {          } else {
922            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 925  sub _get_next_token ($) {
925          ## reconsume          ## reconsume
926    
927          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
928    
929          redo A;          redo A;
930        } else {        } else {
# Line 1105  sub _get_next_token ($) { Line 934  sub _get_next_token ($) {
934          redo A;          redo A;
935        }        }
936      } elsif ($self->{state} eq 'entity in attribute value') {      } elsif ($self->{state} eq 'entity in attribute value') {
937        my $token = $self->_tokenize_attempt_to_consume_an_entity;        my $token = $self->_tokenize_attempt_to_consume_an_entity (1);
938    
939        unless (defined $token) {        unless (defined $token) {
940          $self->{current_attribute}->{value} .= '&';          $self->{current_attribute}->{value} .= '&';
# Line 1154  sub _get_next_token ($) { Line 983  sub _get_next_token ($) {
983          push @next_char, $self->{next_input_character};          push @next_char, $self->{next_input_character};
984          if ($self->{next_input_character} == 0x002D) { # -          if ($self->{next_input_character} == 0x002D) { # -
985            $self->{current_token} = {type => 'comment', data => ''};            $self->{current_token} = {type => 'comment', data => ''};
986            $self->{state} = 'comment';            $self->{state} = 'comment start';
987            !!!next-input-character;            !!!next-input-character;
988            redo A;            redo A;
989          }          }
# Line 1196  sub _get_next_token ($) { Line 1025  sub _get_next_token ($) {
1025          }          }
1026        }        }
1027    
1028        !!!parse-error;        !!!parse-error (type => 'bogus comment');
1029        $self->{next_input_character} = shift @next_char;        $self->{next_input_character} = shift @next_char;
1030        !!!back-next-input-character (@next_char);        !!!back-next-input-character (@next_char);
1031        $self->{state} = 'bogus comment';        $self->{state} = 'bogus comment';
# Line 1204  sub _get_next_token ($) { Line 1033  sub _get_next_token ($) {
1033                
1034        ## ISSUE: typos in spec: chacacters, is is a parse error        ## ISSUE: typos in spec: chacacters, is is a parse error
1035        ## 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?
1036        } elsif ($self->{state} eq 'comment start') {
1037          if ($self->{next_input_character} == 0x002D) { # -
1038            $self->{state} = 'comment start dash';
1039            !!!next-input-character;
1040            redo A;
1041          } elsif ($self->{next_input_character} == 0x003E) { # >
1042            !!!parse-error (type => 'bogus comment');
1043            $self->{state} = 'data';
1044            !!!next-input-character;
1045    
1046            !!!emit ($self->{current_token}); # comment
1047    
1048            redo A;
1049          } elsif ($self->{next_input_character} == -1) {
1050            !!!parse-error (type => 'unclosed comment');
1051            $self->{state} = 'data';
1052            ## reconsume
1053    
1054            !!!emit ($self->{current_token}); # comment
1055    
1056            redo A;
1057          } else {
1058            $self->{current_token}->{data} # comment
1059                .= chr ($self->{next_input_character});
1060            $self->{state} = 'comment';
1061            !!!next-input-character;
1062            redo A;
1063          }
1064        } elsif ($self->{state} eq 'comment start dash') {
1065          if ($self->{next_input_character} == 0x002D) { # -
1066            $self->{state} = 'comment end';
1067            !!!next-input-character;
1068            redo A;
1069          } elsif ($self->{next_input_character} == 0x003E) { # >
1070            !!!parse-error (type => 'bogus comment');
1071            $self->{state} = 'data';
1072            !!!next-input-character;
1073    
1074            !!!emit ($self->{current_token}); # comment
1075    
1076            redo A;
1077          } elsif ($self->{next_input_character} == -1) {
1078            !!!parse-error (type => 'unclosed comment');
1079            $self->{state} = 'data';
1080            ## reconsume
1081    
1082            !!!emit ($self->{current_token}); # comment
1083    
1084            redo A;
1085          } else {
1086            $self->{current_token}->{data} # comment
1087                .= chr ($self->{next_input_character});
1088            $self->{state} = 'comment';
1089            !!!next-input-character;
1090            redo A;
1091          }
1092      } elsif ($self->{state} eq 'comment') {      } elsif ($self->{state} eq 'comment') {
1093        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1094          $self->{state} = 'comment dash';          $self->{state} = 'comment end dash';
1095          !!!next-input-character;          !!!next-input-character;
1096          redo A;          redo A;
1097        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1098          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1099          $self->{state} = 'data';          $self->{state} = 'data';
1100          ## reconsume          ## reconsume
1101    
1102          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1103    
1104          redo A;          redo A;
1105        } else {        } else {
# Line 1224  sub _get_next_token ($) { Line 1108  sub _get_next_token ($) {
1108          !!!next-input-character;          !!!next-input-character;
1109          redo A;          redo A;
1110        }        }
1111      } elsif ($self->{state} eq 'comment dash') {      } elsif ($self->{state} eq 'comment end dash') {
1112        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1113          $self->{state} = 'comment end';          $self->{state} = 'comment end';
1114          !!!next-input-character;          !!!next-input-character;
1115          redo A;          redo A;
1116        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1117          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1118          $self->{state} = 'data';          $self->{state} = 'data';
1119          ## reconsume          ## reconsume
1120    
1121          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1122    
1123          redo A;          redo A;
1124        } else {        } else {
# Line 1250  sub _get_next_token ($) { Line 1133  sub _get_next_token ($) {
1133          !!!next-input-character;          !!!next-input-character;
1134    
1135          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1136    
1137          redo A;          redo A;
1138        } elsif ($self->{next_input_character} == 0x002D) { # -        } elsif ($self->{next_input_character} == 0x002D) { # -
1139          !!!parse-error;          !!!parse-error (type => 'dash in comment');
1140          $self->{current_token}->{data} .= '-'; # comment          $self->{current_token}->{data} .= '-'; # comment
1141          ## Stay in the state          ## Stay in the state
1142          !!!next-input-character;          !!!next-input-character;
1143          redo A;          redo A;
1144        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1145          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1146          $self->{state} = 'data';          $self->{state} = 'data';
1147          ## reconsume          ## reconsume
1148    
1149          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1150    
1151          redo A;          redo A;
1152        } else {        } else {
1153          !!!parse-error;          !!!parse-error (type => 'dash in comment');
1154          $self->{current_token}->{data} .= '--' . chr ($self->{next_input_character}); # comment          $self->{current_token}->{data} .= '--' . chr ($self->{next_input_character}); # comment
1155          $self->{state} = 'comment';          $self->{state} = 'comment';
1156          !!!next-input-character;          !!!next-input-character;
# Line 1285  sub _get_next_token ($) { Line 1166  sub _get_next_token ($) {
1166          !!!next-input-character;          !!!next-input-character;
1167          redo A;          redo A;
1168        } else {        } else {
1169          !!!parse-error;          !!!parse-error (type => 'no space before DOCTYPE name');
1170          $self->{state} = 'before DOCTYPE name';          $self->{state} = 'before DOCTYPE name';
1171          ## reconsume          ## reconsume
1172          redo A;          redo A;
# Line 1299  sub _get_next_token ($) { Line 1180  sub _get_next_token ($) {
1180          ## Stay in the state          ## Stay in the state
1181          !!!next-input-character;          !!!next-input-character;
1182          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;  
1183        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
1184          !!!parse-error;          !!!parse-error (type => 'no DOCTYPE name');
1185          $self->{state} = 'data';          $self->{state} = 'data';
1186          !!!next-input-character;          !!!next-input-character;
1187    
1188          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1189    
1190          redo A;          redo A;
1191        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1192          !!!parse-error;          !!!parse-error (type => 'no DOCTYPE name');
1193          $self->{state} = 'data';          $self->{state} = 'data';
1194          ## reconsume          ## reconsume
1195    
1196          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1197    
1198          redo A;          redo A;
1199        } else {        } else {
1200          $self->{current_token} = {type => 'DOCTYPE',          $self->{current_token}
1201                            name => chr ($self->{next_input_character}),              = {type => 'DOCTYPE',
1202                            error => 1};                 name => chr ($self->{next_input_character}),
1203                   correct => 1};
1204    ## ISSUE: "Set the token's name name to the" in the spec
1205          $self->{state} = 'DOCTYPE name';          $self->{state} = 'DOCTYPE name';
1206          !!!next-input-character;          !!!next-input-character;
1207          redo A;          redo A;
1208        }        }
1209      } elsif ($self->{state} eq 'DOCTYPE name') {      } elsif ($self->{state} eq 'DOCTYPE name') {
1210    ## ISSUE: Redundant "First," in the spec.
1211        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1212            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1213            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
1214            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
1215            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1216          $self->{state} = 'after DOCTYPE name';          $self->{state} = 'after DOCTYPE name';
1217          !!!next-input-character;          !!!next-input-character;
1218          redo A;          redo A;
1219        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1220          $self->{state} = 'data';          $self->{state} = 'data';
1221          !!!next-input-character;          !!!next-input-character;
1222    
1223          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1224    
1225          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;  
1226        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1227          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1228          $self->{state} = 'data';          $self->{state} = 'data';
1229          ## reconsume          ## reconsume
1230    
1231          !!!emit ($self->{current_token});          delete $self->{current_token}->{correct};
1232          undef $self->{current_token};          !!!emit ($self->{current_token}); # DOCTYPE
1233    
1234          redo A;          redo A;
1235        } else {        } else {
1236          $self->{current_token}->{name}          $self->{current_token}->{name}
1237            .= chr ($self->{next_input_character}); # DOCTYPE            .= chr ($self->{next_input_character}); # DOCTYPE
         #$self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML');  
1238          ## Stay in the state          ## Stay in the state
1239          !!!next-input-character;          !!!next-input-character;
1240          redo A;          redo A;
# Line 1389  sub _get_next_token ($) { Line 1253  sub _get_next_token ($) {
1253          !!!next-input-character;          !!!next-input-character;
1254    
1255          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1256    
1257          redo A;          redo A;
1258        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1259          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
1260            $self->{state} = 'data';
1261            ## reconsume
1262    
1263            delete $self->{current_token}->{correct};
1264            !!!emit ($self->{current_token}); # DOCTYPE
1265    
1266            redo A;
1267          } elsif ($self->{next_input_character} == 0x0050 or # P
1268                   $self->{next_input_character} == 0x0070) { # p
1269            !!!next-input-character;
1270            if ($self->{next_input_character} == 0x0055 or # U
1271                $self->{next_input_character} == 0x0075) { # u
1272              !!!next-input-character;
1273              if ($self->{next_input_character} == 0x0042 or # B
1274                  $self->{next_input_character} == 0x0062) { # b
1275                !!!next-input-character;
1276                if ($self->{next_input_character} == 0x004C or # L
1277                    $self->{next_input_character} == 0x006C) { # l
1278                  !!!next-input-character;
1279                  if ($self->{next_input_character} == 0x0049 or # I
1280                      $self->{next_input_character} == 0x0069) { # i
1281                    !!!next-input-character;
1282                    if ($self->{next_input_character} == 0x0043 or # C
1283                        $self->{next_input_character} == 0x0063) { # c
1284                      $self->{state} = 'before DOCTYPE public identifier';
1285                      !!!next-input-character;
1286                      redo A;
1287                    }
1288                  }
1289                }
1290              }
1291            }
1292    
1293            #
1294          } elsif ($self->{next_input_character} == 0x0053 or # S
1295                   $self->{next_input_character} == 0x0073) { # s
1296            !!!next-input-character;
1297            if ($self->{next_input_character} == 0x0059 or # Y
1298                $self->{next_input_character} == 0x0079) { # y
1299              !!!next-input-character;
1300              if ($self->{next_input_character} == 0x0053 or # S
1301                  $self->{next_input_character} == 0x0073) { # s
1302                !!!next-input-character;
1303                if ($self->{next_input_character} == 0x0054 or # T
1304                    $self->{next_input_character} == 0x0074) { # t
1305                  !!!next-input-character;
1306                  if ($self->{next_input_character} == 0x0045 or # E
1307                      $self->{next_input_character} == 0x0065) { # e
1308                    !!!next-input-character;
1309                    if ($self->{next_input_character} == 0x004D or # M
1310                        $self->{next_input_character} == 0x006D) { # m
1311                      $self->{state} = 'before DOCTYPE system identifier';
1312                      !!!next-input-character;
1313                      redo A;
1314                    }
1315                  }
1316                }
1317              }
1318            }
1319    
1320            #
1321          } else {
1322            !!!next-input-character;
1323            #
1324          }
1325    
1326          !!!parse-error (type => 'string after DOCTYPE name');
1327          $self->{state} = 'bogus DOCTYPE';
1328          # next-input-character is already done
1329          redo A;
1330        } elsif ($self->{state} eq 'before DOCTYPE public identifier') {
1331          if ({
1332                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1333                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1334              }->{$self->{next_input_character}}) {
1335            ## Stay in the state
1336            !!!next-input-character;
1337            redo A;
1338          } elsif ($self->{next_input_character} eq 0x0022) { # "
1339            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1340            $self->{state} = 'DOCTYPE public identifier (double-quoted)';
1341            !!!next-input-character;
1342            redo A;
1343          } elsif ($self->{next_input_character} eq 0x0027) { # '
1344            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1345            $self->{state} = 'DOCTYPE public identifier (single-quoted)';
1346            !!!next-input-character;
1347            redo A;
1348          } elsif ($self->{next_input_character} eq 0x003E) { # >
1349            !!!parse-error (type => 'no PUBLIC literal');
1350    
1351            $self->{state} = 'data';
1352            !!!next-input-character;
1353    
1354            delete $self->{current_token}->{correct};
1355            !!!emit ($self->{current_token}); # DOCTYPE
1356    
1357            redo A;
1358          } elsif ($self->{next_input_character} == -1) {
1359            !!!parse-error (type => 'unclosed DOCTYPE');
1360    
1361            $self->{state} = 'data';
1362            ## reconsume
1363    
1364            delete $self->{current_token}->{correct};
1365            !!!emit ($self->{current_token}); # DOCTYPE
1366    
1367            redo A;
1368          } else {
1369            !!!parse-error (type => 'string after PUBLIC');
1370            $self->{state} = 'bogus DOCTYPE';
1371            !!!next-input-character;
1372            redo A;
1373          }
1374        } elsif ($self->{state} eq 'DOCTYPE public identifier (double-quoted)') {
1375          if ($self->{next_input_character} == 0x0022) { # "
1376            $self->{state} = 'after DOCTYPE public identifier';
1377            !!!next-input-character;
1378            redo A;
1379          } elsif ($self->{next_input_character} == -1) {
1380            !!!parse-error (type => 'unclosed PUBLIC literal');
1381    
1382            $self->{state} = 'data';
1383            ## reconsume
1384    
1385            delete $self->{current_token}->{correct};
1386            !!!emit ($self->{current_token}); # DOCTYPE
1387    
1388            redo A;
1389          } else {
1390            $self->{current_token}->{public_identifier} # DOCTYPE
1391                .= chr $self->{next_input_character};
1392            ## Stay in the state
1393            !!!next-input-character;
1394            redo A;
1395          }
1396        } elsif ($self->{state} eq 'DOCTYPE public identifier (single-quoted)') {
1397          if ($self->{next_input_character} == 0x0027) { # '
1398            $self->{state} = 'after DOCTYPE public identifier';
1399            !!!next-input-character;
1400            redo A;
1401          } elsif ($self->{next_input_character} == -1) {
1402            !!!parse-error (type => 'unclosed PUBLIC literal');
1403    
1404            $self->{state} = 'data';
1405            ## reconsume
1406    
1407            delete $self->{current_token}->{correct};
1408            !!!emit ($self->{current_token}); # DOCTYPE
1409    
1410            redo A;
1411          } else {
1412            $self->{current_token}->{public_identifier} # DOCTYPE
1413                .= chr $self->{next_input_character};
1414            ## Stay in the state
1415            !!!next-input-character;
1416            redo A;
1417          }
1418        } elsif ($self->{state} eq 'after DOCTYPE public identifier') {
1419          if ({
1420                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1421                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1422              }->{$self->{next_input_character}}) {
1423            ## Stay in the state
1424            !!!next-input-character;
1425            redo A;
1426          } elsif ($self->{next_input_character} == 0x0022) { # "
1427            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1428            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1429            !!!next-input-character;
1430            redo A;
1431          } elsif ($self->{next_input_character} == 0x0027) { # '
1432            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1433            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1434            !!!next-input-character;
1435            redo A;
1436          } elsif ($self->{next_input_character} == 0x003E) { # >
1437            $self->{state} = 'data';
1438            !!!next-input-character;
1439    
1440            !!!emit ($self->{current_token}); # DOCTYPE
1441    
1442            redo A;
1443          } elsif ($self->{next_input_character} == -1) {
1444            !!!parse-error (type => 'unclosed DOCTYPE');
1445    
1446            $self->{state} = 'data';
1447            ## reconsume
1448    
1449            delete $self->{current_token}->{correct};
1450            !!!emit ($self->{current_token}); # DOCTYPE
1451    
1452            redo A;
1453          } else {
1454            !!!parse-error (type => 'string after PUBLIC literal');
1455            $self->{state} = 'bogus DOCTYPE';
1456            !!!next-input-character;
1457            redo A;
1458          }
1459        } elsif ($self->{state} eq 'before DOCTYPE system identifier') {
1460          if ({
1461                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1462                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1463              }->{$self->{next_input_character}}) {
1464            ## Stay in the state
1465            !!!next-input-character;
1466            redo A;
1467          } elsif ($self->{next_input_character} == 0x0022) { # "
1468            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1469            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1470            !!!next-input-character;
1471            redo A;
1472          } elsif ($self->{next_input_character} == 0x0027) { # '
1473            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1474            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1475            !!!next-input-character;
1476            redo A;
1477          } elsif ($self->{next_input_character} == 0x003E) { # >
1478            !!!parse-error (type => 'no SYSTEM literal');
1479            $self->{state} = 'data';
1480            !!!next-input-character;
1481    
1482            delete $self->{current_token}->{correct};
1483            !!!emit ($self->{current_token}); # DOCTYPE
1484    
1485            redo A;
1486          } elsif ($self->{next_input_character} == -1) {
1487            !!!parse-error (type => 'unclosed DOCTYPE');
1488    
1489            $self->{state} = 'data';
1490            ## reconsume
1491    
1492            delete $self->{current_token}->{correct};
1493            !!!emit ($self->{current_token}); # DOCTYPE
1494    
1495            redo A;
1496          } else {
1497            !!!parse-error (type => 'string after SYSTEM');
1498            $self->{state} = 'bogus DOCTYPE';
1499            !!!next-input-character;
1500            redo A;
1501          }
1502        } elsif ($self->{state} eq 'DOCTYPE system identifier (double-quoted)') {
1503          if ($self->{next_input_character} == 0x0022) { # "
1504            $self->{state} = 'after DOCTYPE system identifier';
1505            !!!next-input-character;
1506            redo A;
1507          } elsif ($self->{next_input_character} == -1) {
1508            !!!parse-error (type => 'unclosed SYSTEM literal');
1509    
1510            $self->{state} = 'data';
1511            ## reconsume
1512    
1513            delete $self->{current_token}->{correct};
1514            !!!emit ($self->{current_token}); # DOCTYPE
1515    
1516            redo A;
1517          } else {
1518            $self->{current_token}->{system_identifier} # DOCTYPE
1519                .= chr $self->{next_input_character};
1520            ## Stay in the state
1521            !!!next-input-character;
1522            redo A;
1523          }
1524        } elsif ($self->{state} eq 'DOCTYPE system identifier (single-quoted)') {
1525          if ($self->{next_input_character} == 0x0027) { # '
1526            $self->{state} = 'after DOCTYPE system identifier';
1527            !!!next-input-character;
1528            redo A;
1529          } elsif ($self->{next_input_character} == -1) {
1530            !!!parse-error (type => 'unclosed SYSTEM literal');
1531    
1532            $self->{state} = 'data';
1533            ## reconsume
1534    
1535            delete $self->{current_token}->{correct};
1536            !!!emit ($self->{current_token}); # DOCTYPE
1537    
1538            redo A;
1539          } else {
1540            $self->{current_token}->{system_identifier} # DOCTYPE
1541                .= chr $self->{next_input_character};
1542            ## Stay in the state
1543            !!!next-input-character;
1544            redo A;
1545          }
1546        } elsif ($self->{state} eq 'after DOCTYPE system identifier') {
1547          if ({
1548                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1549                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1550              }->{$self->{next_input_character}}) {
1551            ## Stay in the state
1552            !!!next-input-character;
1553            redo A;
1554          } elsif ($self->{next_input_character} == 0x003E) { # >
1555            $self->{state} = 'data';
1556            !!!next-input-character;
1557    
1558            !!!emit ($self->{current_token}); # DOCTYPE
1559    
1560            redo A;
1561          } elsif ($self->{next_input_character} == -1) {
1562            !!!parse-error (type => 'unclosed DOCTYPE');
1563    
1564          $self->{state} = 'data';          $self->{state} = 'data';
1565          ## reconsume          ## reconsume
1566    
1567            delete $self->{current_token}->{correct};
1568          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1569    
1570          redo A;          redo A;
1571        } else {        } else {
1572          !!!parse-error;          !!!parse-error (type => 'string after SYSTEM literal');
         $self->{current_token}->{error} = 1; # DOCTYPE  
1573          $self->{state} = 'bogus DOCTYPE';          $self->{state} = 'bogus DOCTYPE';
1574          !!!next-input-character;          !!!next-input-character;
1575          redo A;          redo A;
# Line 1413  sub _get_next_token ($) { Line 1579  sub _get_next_token ($) {
1579          $self->{state} = 'data';          $self->{state} = 'data';
1580          !!!next-input-character;          !!!next-input-character;
1581    
1582            delete $self->{current_token}->{correct};
1583          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1584    
1585          redo A;          redo A;
1586        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1587          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
1588          $self->{state} = 'data';          $self->{state} = 'data';
1589          ## reconsume          ## reconsume
1590    
1591            delete $self->{current_token}->{correct};
1592          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1593    
1594          redo A;          redo A;
1595        } else {        } else {
# Line 1439  sub _get_next_token ($) { Line 1605  sub _get_next_token ($) {
1605    die "$0: _get_next_token: unexpected case";    die "$0: _get_next_token: unexpected case";
1606  } # _get_next_token  } # _get_next_token
1607    
1608  sub _tokenize_attempt_to_consume_an_entity ($) {  sub _tokenize_attempt_to_consume_an_entity ($$) {
1609    my $self = shift;    my ($self, $in_attr) = @_;
1610      
1611    if ($self->{next_input_character} == 0x0023) { # #    if ({
1612           0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
1613           0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR
1614          }->{$self->{next_input_character}}) {
1615        ## Don't consume
1616        ## No error
1617        return undef;
1618      } elsif ($self->{next_input_character} == 0x0023) { # #
1619      !!!next-input-character;      !!!next-input-character;
     my $num;  
1620      if ($self->{next_input_character} == 0x0078 or # x      if ($self->{next_input_character} == 0x0078 or # x
1621          $self->{next_input_character} == 0x0058) { # X          $self->{next_input_character} == 0x0058) { # X
1622          my $code;
1623        X: {        X: {
1624          my $x_char = $self->{next_input_character};          my $x_char = $self->{next_input_character};
1625          !!!next-input-character;          !!!next-input-character;
1626          if (0x0030 <= $self->{next_input_character} and          if (0x0030 <= $self->{next_input_character} and
1627              $self->{next_input_character} <= 0x0039) { # 0..9              $self->{next_input_character} <= 0x0039) { # 0..9
1628            $num ||= 0;            $code ||= 0;
1629            $num *= 0x10;            $code *= 0x10;
1630            $num += $self->{next_input_character} - 0x0030;            $code += $self->{next_input_character} - 0x0030;
1631            redo X;            redo X;
1632          } elsif (0x0061 <= $self->{next_input_character} and          } elsif (0x0061 <= $self->{next_input_character} and
1633                   $self->{next_input_character} <= 0x0066) { # a..f                   $self->{next_input_character} <= 0x0066) { # a..f
1634            ## ISSUE: the spec says U+0078, which is apparently incorrect            $code ||= 0;
1635            $num ||= 0;            $code *= 0x10;
1636            $num *= 0x10;            $code += $self->{next_input_character} - 0x0060 + 9;
           $num += $self->{next_input_character} - 0x0060 + 9;  
1637            redo X;            redo X;
1638          } elsif (0x0041 <= $self->{next_input_character} and          } elsif (0x0041 <= $self->{next_input_character} and
1639                   $self->{next_input_character} <= 0x0046) { # A..F                   $self->{next_input_character} <= 0x0046) { # A..F
1640            ## ISSUE: the spec says U+0058, which is apparently incorrect            $code ||= 0;
1641            $num ||= 0;            $code *= 0x10;
1642            $num *= 0x10;            $code += $self->{next_input_character} - 0x0040 + 9;
           $num += $self->{next_input_character} - 0x0040 + 9;  
1643            redo X;            redo X;
1644          } elsif (not defined $num) { # no hexadecimal digit          } elsif (not defined $code) { # no hexadecimal digit
1645            !!!parse-error;            !!!parse-error (type => 'bare hcro');
1646            $self->{next_input_character} = 0x0023; # #            $self->{next_input_character} = 0x0023; # #
1647            !!!back-next-input-character ($x_char);            !!!back-next-input-character ($x_char);
1648            return undef;            return undef;
1649          } elsif ($self->{next_input_character} == 0x003B) { # ;          } elsif ($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 ($num > 1114111 or $num == 0) {            !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1657            $num = 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 character reference:U+%04X', $code);
1666              $code = $c1_entity_char->{$code};
1667          }          }
1668    
1669          return {type => 'character', data => chr $num};          return {type => 'character', data => chr $code};
1670        } # X        } # X
1671      } elsif (0x0030 <= $self->{next_input_character} and      } elsif (0x0030 <= $self->{next_input_character} and
1672               $self->{next_input_character} <= 0x0039) { # 0..9               $self->{next_input_character} <= 0x0039) { # 0..9
# Line 1505  sub _tokenize_attempt_to_consume_an_enti Line 1684  sub _tokenize_attempt_to_consume_an_enti
1684        if ($self->{next_input_character} == 0x003B) { # ;        if ($self->{next_input_character} == 0x003B) { # ;
1685          !!!next-input-character;          !!!next-input-character;
1686        } else {        } else {
1687          !!!parse-error;          !!!parse-error (type => 'no refc');
1688        }        }
1689    
1690        ## TODO: check the definition for |a valid Unicode character|.        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
1691        if ($code > 1114111 or $code == 0) {          !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1692          $code = 0xFFFD; # REPLACEMENT CHARACTER          $code = 0xFFFD;
1693          ## ISSUE: Why this is not an error?        } elsif ($code > 0x10FFFF) {
1694            !!!parse-error (type => sprintf 'invalid character reference:U-%08X', $code);
1695            $code = 0xFFFD;
1696          } elsif ($code == 0x000D) {
1697            !!!parse-error (type => 'CR character reference');
1698            $code = 0x000A;
1699          } elsif (0x80 <= $code and $code <= 0x9F) {
1700            !!!parse-error (type => sprintf 'C1 character reference:U+%04X', $code);
1701            $code = $c1_entity_char->{$code};
1702        }        }
1703                
1704        return {type => 'character', data => chr $code};        return {type => 'character', data => chr $code};
1705      } else {      } else {
1706        !!!parse-error;        !!!parse-error (type => 'bare nero');
1707        !!!back-next-input-character ($self->{next_input_character});        !!!back-next-input-character ($self->{next_input_character});
1708        $self->{next_input_character} = 0x0023; # #        $self->{next_input_character} = 0x0023; # #
1709        return undef;        return undef;
# Line 1530  sub _tokenize_attempt_to_consume_an_enti Line 1717  sub _tokenize_attempt_to_consume_an_enti
1717    
1718      my $value = $entity_name;      my $value = $entity_name;
1719      my $match;      my $match;
1720        require Whatpm::_NamedEntityList;
1721        our $EntityChar;
1722    
1723      while (length $entity_name < 10 and      while (length $entity_name < 10 and
1724             ## NOTE: Some number greater than the maximum length of entity name             ## NOTE: Some number greater than the maximum length of entity name
1725             ((0x0041 <= $self->{next_input_character} and             ((0x0041 <= $self->{next_input_character} and # a
1726               $self->{next_input_character} <= 0x005A) or               $self->{next_input_character} <= 0x005A) or # x
1727              (0x0061 <= $self->{next_input_character} and              (0x0061 <= $self->{next_input_character} and # a
1728               $self->{next_input_character} <= 0x007A) or               $self->{next_input_character} <= 0x007A) or # z
1729              (0x0030 <= $self->{next_input_character} and              (0x0030 <= $self->{next_input_character} and # 0
1730               $self->{next_input_character} <= 0x0039))) {               $self->{next_input_character} <= 0x0039) or # 9
1731                $self->{next_input_character} == 0x003B)) { # ;
1732        $entity_name .= chr $self->{next_input_character};        $entity_name .= chr $self->{next_input_character};
1733        if (defined $entity_char->{$entity_name}) {        if (defined $EntityChar->{$entity_name}) {
1734          $value = $entity_char->{$entity_name};          if ($self->{next_input_character} == 0x003B) { # ;
1735          $match = 1;            $value = $EntityChar->{$entity_name};
1736              $match = 1;
1737              !!!next-input-character;
1738              last;
1739            } elsif (not $in_attr) {
1740              $value = $EntityChar->{$entity_name};
1741              $match = -1;
1742            } else {
1743              $value .= chr $self->{next_input_character};
1744            }
1745        } else {        } else {
1746          $value .= chr $self->{next_input_character};          $value .= chr $self->{next_input_character};
1747        }        }
1748        !!!next-input-character;        !!!next-input-character;
1749      }      }
1750            
1751      if ($match) {      if ($match > 0) {
1752        if ($self->{next_input_character} == 0x003B) { # ;        return {type => 'character', data => $value};
1753          !!!next-input-character;      } elsif ($match < 0) {
1754        } else {        !!!parse-error (type => 'no refc');
         !!!parse-error;  
       }  
   
1755        return {type => 'character', data => $value};        return {type => 'character', data => $value};
1756      } else {      } else {
1757        !!!parse-error;        !!!parse-error (type => 'bare ero');
1758        ## NOTE: No characters are consumed in the spec.        ## NOTE: No characters are consumed in the spec.
1759        !!!back-token ({type => 'character', data => $value});        return {type => 'character', data => '&'.$value};
       return undef;  
1760      }      }
1761    } else {    } else {
1762      ## no characters are consumed      ## no characters are consumed
1763      !!!parse-error;      !!!parse-error (type => 'bare ero');
1764      return undef;      return undef;
1765    }    }
1766  } # _tokenize_attempt_to_consume_an_entity  } # _tokenize_attempt_to_consume_an_entity
# Line 1576  sub _initialize_tree_constructor ($) { Line 1771  sub _initialize_tree_constructor ($) {
1771    $self->{document}->strict_error_checking (0);    $self->{document}->strict_error_checking (0);
1772    ## TODO: Turn mutation events off # MUST    ## TODO: Turn mutation events off # MUST
1773    ## TODO: Turn loose Document option (manakai extension) on    ## TODO: Turn loose Document option (manakai extension) on
1774    ## TODO: Mark the Document as an HTML document # MUST    $self->{document}->manakai_is_html (1); # MUST
1775  } # _initialize_tree_constructor  } # _initialize_tree_constructor
1776    
1777  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 1587  sub _terminate_tree_constructor ($) { Line 1782  sub _terminate_tree_constructor ($) {
1782    
1783  ## 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?
1784    
1785    { # tree construction stage
1786      my $token;
1787    
1788  sub _construct_tree ($) {  sub _construct_tree ($) {
1789    my ($self) = @_;    my ($self) = @_;
1790    
# Line 1598  sub _construct_tree ($) { Line 1796  sub _construct_tree ($) {
1796    ## characters and insert one Text node whose data is concatenation    ## characters and insert one Text node whose data is concatenation
1797    ## of all those characters. # MUST    ## of all those characters. # MUST
1798        
   my $token;  
1799    !!!next-token;    !!!next-token;
1800    
1801    my $phase = 'initial'; # MUST    $self->{insertion_mode} = 'before head';
1802      undef $self->{form_element};
1803      undef $self->{head_element};
1804      $self->{open_elements} = [];
1805      undef $self->{inner_html_node};
1806    
1807      $self->_tree_construction_initial; # MUST
1808      $self->_tree_construction_root_element;
1809      $self->_tree_construction_main;
1810    } # _construct_tree
1811    
1812    sub _tree_construction_initial ($) {
1813      my $self = shift;
1814      INITIAL: {
1815        if ($token->{type} eq 'DOCTYPE') {
1816          ## NOTE: Conformance checkers MAY, instead of reporting "not HTML5"
1817          ## error, switch to a conformance checking mode for another
1818          ## language.
1819          my $doctype_name = $token->{name};
1820          $doctype_name = '' unless defined $doctype_name;
1821          $doctype_name =~ tr/a-z/A-Z/;
1822          if (not defined $token->{name} or # <!DOCTYPE>
1823              defined $token->{public_identifier} or
1824              defined $token->{system_identifier}) {
1825            !!!parse-error (type => 'not HTML5');
1826          } elsif ($doctype_name ne 'HTML') {
1827            ## ISSUE: ASCII case-insensitive? (in fact it does not matter)
1828            !!!parse-error (type => 'not HTML5');
1829          }
1830          
1831          my $doctype = $self->{document}->create_document_type_definition
1832            ($token->{name}); ## ISSUE: If name is missing (e.g. <!DOCTYPE>)?
1833          $doctype->public_id ($token->{public_identifier})
1834              if defined $token->{public_identifier};
1835          $doctype->system_id ($token->{system_identifier})
1836              if defined $token->{system_identifier};
1837          ## NOTE: Other DocumentType attributes are null or empty lists.
1838          ## ISSUE: internalSubset = null??
1839          $self->{document}->append_child ($doctype);
1840          
1841          if (not $token->{correct} or $doctype_name ne 'HTML') {
1842            $self->{document}->manakai_compat_mode ('quirks');
1843          } elsif (defined $token->{public_identifier}) {
1844            my $pubid = $token->{public_identifier};
1845            $pubid =~ tr/a-z/A-z/;
1846            if ({
1847              "+//SILMARIL//DTD HTML PRO V0R11 19970101//EN" => 1,
1848              "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1849              "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1850              "-//IETF//DTD HTML 2.0 LEVEL 1//EN" => 1,
1851              "-//IETF//DTD HTML 2.0 LEVEL 2//EN" => 1,
1852              "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//EN" => 1,
1853              "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//EN" => 1,
1854              "-//IETF//DTD HTML 2.0 STRICT//EN" => 1,
1855              "-//IETF//DTD HTML 2.0//EN" => 1,
1856              "-//IETF//DTD HTML 2.1E//EN" => 1,
1857              "-//IETF//DTD HTML 3.0//EN" => 1,
1858              "-//IETF//DTD HTML 3.0//EN//" => 1,
1859              "-//IETF//DTD HTML 3.2 FINAL//EN" => 1,
1860              "-//IETF//DTD HTML 3.2//EN" => 1,
1861              "-//IETF//DTD HTML 3//EN" => 1,
1862              "-//IETF//DTD HTML LEVEL 0//EN" => 1,
1863              "-//IETF//DTD HTML LEVEL 0//EN//2.0" => 1,
1864              "-//IETF//DTD HTML LEVEL 1//EN" => 1,
1865              "-//IETF//DTD HTML LEVEL 1//EN//2.0" => 1,
1866              "-//IETF//DTD HTML LEVEL 2//EN" => 1,
1867              "-//IETF//DTD HTML LEVEL 2//EN//2.0" => 1,
1868              "-//IETF//DTD HTML LEVEL 3//EN" => 1,
1869              "-//IETF//DTD HTML LEVEL 3//EN//3.0" => 1,
1870              "-//IETF//DTD HTML STRICT LEVEL 0//EN" => 1,
1871              "-//IETF//DTD HTML STRICT LEVEL 0//EN//2.0" => 1,
1872              "-//IETF//DTD HTML STRICT LEVEL 1//EN" => 1,
1873              "-//IETF//DTD HTML STRICT LEVEL 1//EN//2.0" => 1,
1874              "-//IETF//DTD HTML STRICT LEVEL 2//EN" => 1,
1875              "-//IETF//DTD HTML STRICT LEVEL 2//EN//2.0" => 1,
1876              "-//IETF//DTD HTML STRICT LEVEL 3//EN" => 1,
1877              "-//IETF//DTD HTML STRICT LEVEL 3//EN//3.0" => 1,
1878              "-//IETF//DTD HTML STRICT//EN" => 1,
1879              "-//IETF//DTD HTML STRICT//EN//2.0" => 1,
1880              "-//IETF//DTD HTML STRICT//EN//3.0" => 1,
1881              "-//IETF//DTD HTML//EN" => 1,
1882              "-//IETF//DTD HTML//EN//2.0" => 1,
1883              "-//IETF//DTD HTML//EN//3.0" => 1,
1884              "-//METRIUS//DTD METRIUS PRESENTATIONAL//EN" => 1,
1885              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//EN" => 1,
1886              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//EN" => 1,
1887              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//EN" => 1,
1888              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//EN" => 1,
1889              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//EN" => 1,
1890              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//EN" => 1,
1891              "-//NETSCAPE COMM. CORP.//DTD HTML//EN" => 1,
1892              "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//EN" => 1,
1893              "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//EN" => 1,
1894              "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//EN" => 1,
1895              "-//SPYGLASS//DTD HTML 2.0 EXTENDED//EN" => 1,
1896              "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//EN" => 1,
1897              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//EN" => 1,
1898              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//EN" => 1,
1899              "-//W3C//DTD HTML 3 1995-03-24//EN" => 1,
1900              "-//W3C//DTD HTML 3.2 DRAFT//EN" => 1,
1901              "-//W3C//DTD HTML 3.2 FINAL//EN" => 1,
1902              "-//W3C//DTD HTML 3.2//EN" => 1,
1903              "-//W3C//DTD HTML 3.2S DRAFT//EN" => 1,
1904              "-//W3C//DTD HTML 4.0 FRAMESET//EN" => 1,
1905              "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN" => 1,
1906              "-//W3C//DTD HTML EXPERIMETNAL 19960712//EN" => 1,
1907              "-//W3C//DTD HTML EXPERIMENTAL 970421//EN" => 1,
1908              "-//W3C//DTD W3 HTML//EN" => 1,
1909              "-//W3O//DTD W3 HTML 3.0//EN" => 1,
1910              "-//W3O//DTD W3 HTML 3.0//EN//" => 1,
1911              "-//W3O//DTD W3 HTML STRICT 3.0//EN//" => 1,
1912              "-//WEBTECHS//DTD MOZILLA HTML 2.0//EN" => 1,
1913              "-//WEBTECHS//DTD MOZILLA HTML//EN" => 1,
1914              "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" => 1,
1915              "HTML" => 1,
1916            }->{$pubid}) {
1917              $self->{document}->manakai_compat_mode ('quirks');
1918            } elsif ($pubid eq "-//W3C//DTD HTML 4.01 FRAMESET//EN" or
1919                     $pubid eq "-//W3C//DTD HTML 4.01 TRANSITIONAL//EN") {
1920              if (defined $token->{system_identifier}) {
1921                $self->{document}->manakai_compat_mode ('quirks');
1922              } else {
1923                $self->{document}->manakai_compat_mode ('limited quirks');
1924              }
1925            } elsif ($pubid eq "-//W3C//DTD XHTML 1.0 Frameset//EN" or
1926                     $pubid eq "-//W3C//DTD XHTML 1.0 Transitional//EN") {
1927              $self->{document}->manakai_compat_mode ('limited quirks');
1928            }
1929          }
1930          if (defined $token->{system_identifier}) {
1931            my $sysid = $token->{system_identifier};
1932            $sysid =~ tr/A-Z/a-z/;
1933            if ($sysid eq "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd") {
1934              $self->{document}->manakai_compat_mode ('quirks');
1935            }
1936          }
1937          
1938          ## Go to the root element phase.
1939          !!!next-token;
1940          return;
1941        } elsif ({
1942                  'start tag' => 1,
1943                  'end tag' => 1,
1944                  'end-of-file' => 1,
1945                 }->{$token->{type}}) {
1946          !!!parse-error (type => 'no DOCTYPE');
1947          $self->{document}->manakai_compat_mode ('quirks');
1948          ## Go to the root element phase
1949          ## reprocess
1950          return;
1951        } elsif ($token->{type} eq 'character') {
1952          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
1953            ## Ignore the token
1954    
1955            unless (length $token->{data}) {
1956              ## Stay in the phase
1957              !!!next-token;
1958              redo INITIAL;
1959            }
1960          }
1961    
1962          !!!parse-error (type => 'no DOCTYPE');
1963          $self->{document}->manakai_compat_mode ('quirks');
1964          ## Go to the root element phase
1965          ## reprocess
1966          return;
1967        } elsif ($token->{type} eq 'comment') {
1968          my $comment = $self->{document}->create_comment ($token->{data});
1969          $self->{document}->append_child ($comment);
1970          
1971          ## Stay in the phase.
1972          !!!next-token;
1973          redo INITIAL;
1974        } else {
1975          die "$0: $token->{type}: Unknown token";
1976        }
1977      } # INITIAL
1978    } # _tree_construction_initial
1979    
1980    sub _tree_construction_root_element ($) {
1981      my $self = shift;
1982      
1983      B: {
1984          if ($token->{type} eq 'DOCTYPE') {
1985            !!!parse-error (type => 'in html:#DOCTYPE');
1986            ## Ignore the token
1987            ## Stay in the phase
1988            !!!next-token;
1989            redo B;
1990          } elsif ($token->{type} eq 'comment') {
1991            my $comment = $self->{document}->create_comment ($token->{data});
1992            $self->{document}->append_child ($comment);
1993            ## Stay in the phase
1994            !!!next-token;
1995            redo B;
1996          } elsif ($token->{type} eq 'character') {
1997            if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
1998              ## Ignore the token.
1999    
2000              unless (length $token->{data}) {
2001                ## Stay in the phase
2002                !!!next-token;
2003                redo B;
2004              }
2005            }
2006            #
2007          } elsif ({
2008                    'start tag' => 1,
2009                    'end tag' => 1,
2010                    'end-of-file' => 1,
2011                   }->{$token->{type}}) {
2012            ## ISSUE: There is an issue in the spec
2013            #
2014          } else {
2015            die "$0: $token->{type}: Unknown token";
2016          }
2017          my $root_element; !!!create-element ($root_element, 'html');
2018          $self->{document}->append_child ($root_element);
2019          push @{$self->{open_elements}}, [$root_element, 'html'];
2020          #$phase = 'main';
2021          ## reprocess
2022          #redo B;
2023          return;
2024      } # B
2025    } # _tree_construction_root_element
2026    
2027    sub _reset_insertion_mode ($) {
2028      my $self = shift;
2029    
2030        ## Step 1
2031        my $last;
2032        
2033        ## Step 2
2034        my $i = -1;
2035        my $node = $self->{open_elements}->[$i];
2036        
2037        ## Step 3
2038        S3: {
2039          ## ISSUE: Oops! "If node is the first node in the stack of open
2040          ## elements, then set last to true. If the context element of the
2041          ## HTML fragment parsing algorithm is neither a td element nor a
2042          ## th element, then set node to the context element. (fragment case)":
2043          ## The second "if" is in the scope of the first "if"!?
2044          if ($self->{open_elements}->[0]->[0] eq $node->[0]) {
2045            $last = 1;
2046            if (defined $self->{inner_html_node}) {
2047              if ($self->{inner_html_node}->[1] eq 'td' or
2048                  $self->{inner_html_node}->[1] eq 'th') {
2049                #
2050              } else {
2051                $node = $self->{inner_html_node};
2052              }
2053            }
2054          }
2055        
2056          ## Step 4..13
2057          my $new_mode = {
2058                          select => 'in select',
2059                          td => 'in cell',
2060                          th => 'in cell',
2061                          tr => 'in row',
2062                          tbody => 'in table body',
2063                          thead => 'in table head',
2064                          tfoot => 'in table foot',
2065                          caption => 'in caption',
2066                          colgroup => 'in column group',
2067                          table => 'in table',
2068                          head => 'in body', # not in head!
2069                          body => 'in body',
2070                          frameset => 'in frameset',
2071                         }->{$node->[1]};
2072          $self->{insertion_mode} = $new_mode and return if defined $new_mode;
2073          
2074          ## Step 14
2075          if ($node->[1] eq 'html') {
2076            unless (defined $self->{head_element}) {
2077              $self->{insertion_mode} = 'before head';
2078            } else {
2079              $self->{insertion_mode} = 'after head';
2080            }
2081            return;
2082          }
2083          
2084          ## Step 15
2085          $self->{insertion_mode} = 'in body' and return if $last;
2086          
2087          ## Step 16
2088          $i--;
2089          $node = $self->{open_elements}->[$i];
2090          
2091          ## Step 17
2092          redo S3;
2093        } # S3
2094    } # _reset_insertion_mode
2095    
2096    sub _tree_construction_main ($) {
2097      my $self = shift;
2098    
2099      my $phase = 'main';
2100    
   my $open_elements = [];  
2101    my $active_formatting_elements = [];    my $active_formatting_elements = [];
   my $head_element;  
   my $form_element;  
   my $insertion_mode = 'before head';  
2102    
2103    my $reconstruct_active_formatting_elements = sub { # MUST    my $reconstruct_active_formatting_elements = sub { # MUST
2104      my $insert = shift;      my $insert = shift;
# Line 1621  sub _construct_tree ($) { Line 2112  sub _construct_tree ($) {
2112    
2113      ## Step 2      ## Step 2
2114      return if $entry->[0] eq '#marker';      return if $entry->[0] eq '#marker';
2115      for (@$open_elements) {      for (@{$self->{open_elements}}) {
2116        if ($entry->[0] eq $_->[0]) {        if ($entry->[0] eq $_->[0]) {
2117          return;          return;
2118        }        }
# Line 1640  sub _construct_tree ($) { Line 2131  sub _construct_tree ($) {
2131          #          #
2132        } else {        } else {
2133          my $in_open_elements;          my $in_open_elements;
2134          OE: for (@$open_elements) {          OE: for (@{$self->{open_elements}}) {
2135            if ($entry->[0] eq $_->[0]) {            if ($entry->[0] eq $_->[0]) {
2136              $in_open_elements = 1;              $in_open_elements = 1;
2137              last OE;              last OE;
# Line 1664  sub _construct_tree ($) { Line 2155  sub _construct_tree ($) {
2155            
2156        ## Step 9        ## Step 9
2157        $insert->($clone->[0]);        $insert->($clone->[0]);
2158        push @$open_elements, $clone;        push @{$self->{open_elements}}, $clone;
2159                
2160        ## Step 10        ## Step 10
2161        $active_formatting_elements->[$i] = $open_elements->[-1];        $active_formatting_elements->[$i] = $self->{open_elements}->[-1];
2162    
2163        ## Step 11        ## Step 11
2164        unless ($clone->[0] eq $active_formatting_elements->[-1]->[0]) {        unless ($clone->[0] eq $active_formatting_elements->[-1]->[0]) {
# Line 1689  sub _construct_tree ($) { Line 2180  sub _construct_tree ($) {
2180      }      }
2181    }; # $clear_up_to_marker    }; # $clear_up_to_marker
2182    
2183    my $reset_insertion_mode = sub {    my $parse_rcdata = sub ($$) {
2184        my ($content_model_flag, $insert) = @_;
2185    
2186      ## Step 1      ## Step 1
2187      my $last;      my $start_tag_name = $token->{tag_name};
2188            my $el;
2189        !!!create-element ($el, $start_tag_name, $token->{attributes});
2190    
2191      ## Step 2      ## Step 2
2192      my $i = -1;      $insert->($el); # /context node/->append_child ($el)
2193      my $node = $open_elements->[$i];  
       
2194      ## Step 3      ## Step 3
2195      S3: {      $self->{content_model_flag} = $content_model_flag; # CDATA or RCDATA
2196        $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  
2197    
2198    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';  
                 
2199      my $text = '';      my $text = '';
2200      !!!next-token;      !!!next-token;
2201      while ($token->{type} eq 'character') {      while ($token->{type} eq 'character') { # or until stop tokenizing
2202        $text .= $token->{data};        $text .= $token->{data};
2203        !!!next-token;        !!!next-token;
2204      } # stop if non-character token or tokenizer stops tokenising      }
2205    
2206        ## Step 5
2207      if (length $text) {      if (length $text) {
2208        $style_el->manakai_append_text ($text);        my $text = $self->{document}->create_text_node ($text);
2209          $el->append_child ($text);
2210      }      }
2211        
2212        ## Step 6
2213      $self->{content_model_flag} = 'PCDATA';      $self->{content_model_flag} = 'PCDATA';
2214                  
2215      if ($token->{type} eq 'end tag' and $token->{tag_name} eq 'style') {      ## Step 7
2216        if ($token->{type} eq 'end tag' and $token->{tag_name} eq $start_tag_name) {
2217        ## Ignore the token        ## Ignore the token
2218      } else {      } else {
2219        !!!parse-error;        !!!parse-error (type => 'in '.$content_model_flag.':#'.$token->{type});
       ## ISSUE: And ignore?  
2220      }      }
2221      !!!next-token;      !!!next-token;
2222    }; # $style_start_tag    }; # $parse_rcdata
2223    
2224    my $script_start_tag = sub {    my $script_start_tag = sub ($) {
2225        my $insert = $_[0];
2226      my $script_el;      my $script_el;
2227      !!!create-element ($script_el, 'script', $token->{attributes});      !!!create-element ($script_el, 'script', $token->{attributes});
2228      ## TODO: mark as "parser-inserted"      ## TODO: mark as "parser-inserted"
2229    
2230      $self->{content_model_flag} = 'CDATA';      $self->{content_model_flag} = 'CDATA';
2231        delete $self->{escape}; # MUST
2232            
2233      my $text = '';      my $text = '';
2234      !!!next-token;      !!!next-token;
# Line 1794  sub _construct_tree ($) { Line 2246  sub _construct_tree ($) {
2246          $token->{tag_name} eq 'script') {          $token->{tag_name} eq 'script') {
2247        ## Ignore the token        ## Ignore the token
2248      } else {      } else {
2249        !!!parse-error;        !!!parse-error (type => 'in CDATA:#'.$token->{type});
2250        ## ISSUE: And ignore?        ## ISSUE: And ignore?
2251        ## TODO: mark as "already executed"        ## TODO: mark as "already executed"
2252      }      }
2253            
2254      ## TODO: inner_html mode then mark as "already executed" and skip      if (defined $self->{inner_html_node}) {
2255      if (1) {        ## TODO: mark as "already executed"
2256        } else {
2257        ## TODO: $old_insertion_point = current insertion point        ## TODO: $old_insertion_point = current insertion point
2258        ## TODO: insertion point = just before the next input character        ## TODO: insertion point = just before the next input character
2259          
2260        (($insertion_mode eq 'in head' and defined $head_element)        $insert->($script_el);
        ? $head_element : $open_elements->[-1]->[0])->append_child ($script_el);  
2261                
2262        ## TODO: insertion point = $old_insertion_point (might be "undefined")        ## TODO: insertion point = $old_insertion_point (might be "undefined")
2263                
# Line 1832  sub _construct_tree ($) { Line 2284  sub _construct_tree ($) {
2284          }          }
2285        } # AFE        } # AFE
2286        unless (defined $formatting_element) {        unless (defined $formatting_element) {
2287          !!!parse-error;          !!!parse-error (type => 'unmatched end tag:'.$tag_name);
2288          ## Ignore the token          ## Ignore the token
2289          !!!next-token;          !!!next-token;
2290          return;          return;
# Line 1840  sub _construct_tree ($) { Line 2292  sub _construct_tree ($) {
2292        ## has an element in scope        ## has an element in scope
2293        my $in_scope = 1;        my $in_scope = 1;
2294        my $formatting_element_i_in_open;          my $formatting_element_i_in_open;  
2295        INSCOPE: for (reverse 0..$#$open_elements) {        INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2296          my $node = $open_elements->[$_];          my $node = $self->{open_elements}->[$_];
2297          if ($node->[0] eq $formatting_element->[0]) {          if ($node->[0] eq $formatting_element->[0]) {
2298            if ($in_scope) {            if ($in_scope) {
2299              $formatting_element_i_in_open = $_;              $formatting_element_i_in_open = $_;
2300              last INSCOPE;              last INSCOPE;
2301            } else { # in open elements but not in scope            } else { # in open elements but not in scope
2302              !!!parse-error;              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
2303              ## Ignore the token              ## Ignore the token
2304              !!!next-token;              !!!next-token;
2305              return;              return;
# Line 1860  sub _construct_tree ($) { Line 2312  sub _construct_tree ($) {
2312          }          }
2313        } # INSCOPE        } # INSCOPE
2314        unless (defined $formatting_element_i_in_open) {        unless (defined $formatting_element_i_in_open) {
2315          !!!parse-error;          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
2316          pop @$active_formatting_elements; # $formatting_element          pop @$active_formatting_elements; # $formatting_element
2317          !!!next-token; ## TODO: ok?          !!!next-token; ## TODO: ok?
2318          return;          return;
2319        }        }
2320        if (not $open_elements->[-1]->[0] eq $formatting_element->[0]) {        if (not $self->{open_elements}->[-1]->[0] eq $formatting_element->[0]) {
2321          !!!parse-error;          !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
2322        }        }
2323                
2324        ## Step 2        ## Step 2
2325        my $furthest_block;        my $furthest_block;
2326        my $furthest_block_i_in_open;        my $furthest_block_i_in_open;
2327        OE: for (reverse 0..$#$open_elements) {        OE: for (reverse 0..$#{$self->{open_elements}}) {
2328          my $node = $open_elements->[$_];          my $node = $self->{open_elements}->[$_];
2329          if (not $formatting_category->{$node->[1]} and          if (not $formatting_category->{$node->[1]} and
2330              #not $phrasing_category->{$node->[1]} and              #not $phrasing_category->{$node->[1]} and
2331              ($special_category->{$node->[1]} or              ($special_category->{$node->[1]} or
# Line 1887  sub _construct_tree ($) { Line 2339  sub _construct_tree ($) {
2339                
2340        ## Step 3        ## Step 3
2341        unless (defined $furthest_block) { # MUST        unless (defined $furthest_block) { # MUST
2342          splice @$open_elements, $formatting_element_i_in_open;          splice @{$self->{open_elements}}, $formatting_element_i_in_open;
2343          splice @$active_formatting_elements, $formatting_element_i_in_active, 1;          splice @$active_formatting_elements, $formatting_element_i_in_active, 1;
2344          !!!next-token;          !!!next-token;
2345          return;          return;
2346        }        }
2347                
2348        ## Step 4        ## Step 4
2349        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];
2350                
2351        ## Step 5        ## Step 5
2352        my $furthest_block_parent = $furthest_block->[0]->parent_node;        my $furthest_block_parent = $furthest_block->[0]->parent_node;
# Line 1914  sub _construct_tree ($) { Line 2366  sub _construct_tree ($) {
2366        S7: {        S7: {
2367          ## Step 1          ## Step 1
2368          $node_i_in_open--;          $node_i_in_open--;
2369          $node = $open_elements->[$node_i_in_open];          $node = $self->{open_elements}->[$node_i_in_open];
2370                    
2371          ## Step 2          ## Step 2
2372          my $node_i_in_active;          my $node_i_in_active;
# Line 1925  sub _construct_tree ($) { Line 2377  sub _construct_tree ($) {
2377                last S7S2;                last S7S2;
2378              }              }
2379            }            }
2380            splice @$open_elements, $node_i_in_open, 1;            splice @{$self->{open_elements}}, $node_i_in_open, 1;
2381            redo S7;            redo S7;
2382          } # S7S2          } # S7S2
2383                    
# Line 1941  sub _construct_tree ($) { Line 2393  sub _construct_tree ($) {
2393          if ($node->[0]->has_child_nodes ()) {          if ($node->[0]->has_child_nodes ()) {
2394            my $clone = [$node->[0]->clone_node (0), $node->[1]];            my $clone = [$node->[0]->clone_node (0), $node->[1]];
2395            $active_formatting_elements->[$node_i_in_active] = $clone;            $active_formatting_elements->[$node_i_in_active] = $clone;
2396            $open_elements->[$node_i_in_open] = $clone;            $self->{open_elements}->[$node_i_in_open] = $clone;
2397            $node = $clone;            $node = $clone;
2398          }          }
2399                    
# Line 1983  sub _construct_tree ($) { Line 2435  sub _construct_tree ($) {
2435                
2436        ## Step 13        ## Step 13
2437        undef $i;        undef $i;
2438        OE: for (reverse 0..$#$open_elements) {        OE: for (reverse 0..$#{$self->{open_elements}}) {
2439          if ($open_elements->[$_]->[0] eq $formatting_element->[0]) {          if ($self->{open_elements}->[$_]->[0] eq $formatting_element->[0]) {
2440            splice @$open_elements, $_, 1;            splice @{$self->{open_elements}}, $_, 1;
2441            $i-- and last OE if defined $i;            $i-- and last OE if defined $i;
2442          } elsif ($open_elements->[$_]->[0] eq $furthest_block->[0]) {          } elsif ($self->{open_elements}->[$_]->[0] eq $furthest_block->[0]) {
2443            $i = $_;            $i = $_;
2444          }          }
2445        } # OE        } # OE
2446        splice @$open_elements, $i + 1, 1, $clone;        splice @{$self->{open_elements}}, $i + 1, 1, $clone;
2447                
2448        ## Step 14        ## Step 14
2449        redo FET;        redo FET;
# Line 1999  sub _construct_tree ($) { Line 2451  sub _construct_tree ($) {
2451    }; # $formatting_end_tag    }; # $formatting_end_tag
2452    
2453    my $insert_to_current = sub {    my $insert_to_current = sub {
2454      $open_elements->[-1]->[0]->append_child (shift);      $self->{open_elements}->[-1]->[0]->append_child ($_[0]);
2455    }; # $insert_to_current    }; # $insert_to_current
2456    
2457    my $insert_to_foster = sub {    my $insert_to_foster = sub {
# Line 2007  sub _construct_tree ($) { Line 2459  sub _construct_tree ($) {
2459                         if ({                         if ({
2460                              table => 1, tbody => 1, tfoot => 1,                              table => 1, tbody => 1, tfoot => 1,
2461                              thead => 1, tr => 1,                              thead => 1, tr => 1,
2462                             }->{$open_elements->[-1]->[1]}) {                             }->{$self->{open_elements}->[-1]->[1]}) {
2463                           # MUST                           # MUST
2464                           my $foster_parent_element;                           my $foster_parent_element;
2465                           my $next_sibling;                           my $next_sibling;
2466                           OE: for (reverse 0..$#$open_elements) {                           OE: for (reverse 0..$#{$self->{open_elements}}) {
2467                             if ($open_elements->[$_]->[1] eq 'table') {                             if ($self->{open_elements}->[$_]->[1] eq 'table') {
2468                               my $parent = $open_elements->[$_]->[0]->parent_node;                               my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
2469                               if (defined $parent and $parent->node_type == 1) {                               if (defined $parent and $parent->node_type == 1) {
2470                                 $foster_parent_element = $parent;                                 $foster_parent_element = $parent;
2471                                 $next_sibling = $open_elements->[$_]->[0];                                 $next_sibling = $self->{open_elements}->[$_]->[0];
2472                               } else {                               } else {
2473                                 $foster_parent_element                                 $foster_parent_element
2474                                   = $open_elements->[$_ - 1]->[0];                                   = $self->{open_elements}->[$_ - 1]->[0];
2475                               }                               }
2476                               last OE;                               last OE;
2477                             }                             }
2478                           } # OE                           } # OE
2479                           $foster_parent_element = $open_elements->[0]->[0]                           $foster_parent_element = $self->{open_elements}->[0]->[0]
2480                             unless defined $foster_parent_element;                             unless defined $foster_parent_element;
2481                           $foster_parent_element->insert_before                           $foster_parent_element->insert_before
2482                             ($child, $next_sibling);                             ($child, $next_sibling);
2483                         } else {                         } else {
2484                           $open_elements->[-1]->[0]->append_child ($child);                           $self->{open_elements}->[-1]->[0]->append_child ($child);
2485                         }                         }
2486    }; # $insert_to_foster    }; # $insert_to_foster
2487    
# Line 2037  sub _construct_tree ($) { Line 2489  sub _construct_tree ($) {
2489      my $insert = shift;      my $insert = shift;
2490      if ($token->{type} eq 'start tag') {      if ($token->{type} eq 'start tag') {
2491        if ($token->{tag_name} eq 'script') {        if ($token->{tag_name} eq 'script') {
2492          $script_start_tag->();          ## NOTE: This is an "as if in head" code clone
2493            $script_start_tag->($insert);
2494          return;          return;
2495        } elsif ($token->{tag_name} eq 'style') {        } elsif ($token->{tag_name} eq 'style') {
2496          $style_start_tag->();          ## NOTE: This is an "as if in head" code clone
2497            $parse_rcdata->('CDATA', $insert);
2498          return;          return;
2499        } elsif ({        } elsif ({
2500                  base => 1, link => 1, meta => 1,                  base => 1, link => 1, meta => 1,
2501                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2502          !!!parse-error ($token->{tag_name}.' in body');          ## NOTE: This is an "as if in head" code clone, only "-t" differs
2503          ## NOTE: This is an "as if in head" code clone          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2504          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);  
         }  
           
2505          !!!next-token;          !!!next-token;
2506            ## TODO: Extracting |charset| from |meta|.
2507          return;          return;
2508        } elsif ($token->{tag_name} eq 'title') {        } elsif ($token->{tag_name} eq 'title') {
2509          !!!parse-error ('title in body');          !!!parse-error (type => 'in body:title');
2510          ## NOTE: There is an "as if in head" code clone          ## NOTE: This is an "as if in head" code clone
2511          my $title_el;          $parse_rcdata->('RCDATA', sub {
2512          !!!create-element ($title_el, 'title', $token->{attributes});            if (defined $self->{head_element}) {
2513          (defined $head_element ? $head_element : $open_elements->[-1]->[0])              $self->{head_element}->append_child ($_[0]);
2514            ->append_child ($title_el);            } else {
2515          $self->{content_model_flag} = 'RCDATA';              $insert->($_[0]);
2516                      }
2517          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;  
2518          return;          return;
2519        } elsif ($token->{tag_name} eq 'body') {        } elsif ($token->{tag_name} eq 'body') {
2520          !!!parse-error;          !!!parse-error (type => 'in body:body');
2521                                
2522          if (@$open_elements == 1 or          if (@{$self->{open_elements}} == 1 or
2523              $open_elements->[1]->[1] ne 'body') {              $self->{open_elements}->[1]->[1] ne 'body') {
2524            ## Ignore the token            ## Ignore the token
2525          } else {          } else {
2526            my $body_el = $open_elements->[1]->[0];            my $body_el = $self->{open_elements}->[1]->[0];
2527            for my $attr_name (keys %{$token->{attributes}}) {            for my $attr_name (keys %{$token->{attributes}}) {
2528              unless ($body_el->has_attribute_ns (undef, $attr_name)) {              unless ($body_el->has_attribute_ns (undef, $attr_name)) {
2529                $body_el->set_attribute_ns                $body_el->set_attribute_ns
# Line 2112  sub _construct_tree ($) { Line 2541  sub _construct_tree ($) {
2541                  pre => 1,                  pre => 1,
2542                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2543          ## has a p element in scope          ## has a p element in scope
2544          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2545            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2546              !!!back-token;              !!!back-token;
2547              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2139  sub _construct_tree ($) { Line 2568  sub _construct_tree ($) {
2568          }          }
2569          return;          return;
2570        } elsif ($token->{tag_name} eq 'form') {        } elsif ($token->{tag_name} eq 'form') {
2571          if (defined $form_element) {          if (defined $self->{form_element}) {
2572            !!!parse-error;            !!!parse-error (type => 'in form:form');
2573            ## Ignore the token            ## Ignore the token
2574              !!!next-token;
2575              return;
2576          } else {          } else {
2577            ## has a p element in scope            ## has a p element in scope
2578            INSCOPE: for (reverse @$open_elements) {            INSCOPE: for (reverse @{$self->{open_elements}}) {
2579              if ($_->[1] eq 'p') {              if ($_->[1] eq 'p') {
2580                !!!back-token;                !!!back-token;
2581                $token = {type => 'end tag', tag_name => 'p'};                $token = {type => 'end tag', tag_name => 'p'};
# Line 2158  sub _construct_tree ($) { Line 2589  sub _construct_tree ($) {
2589            } # INSCOPE            } # INSCOPE
2590                            
2591            !!!insert-element-t ($token->{tag_name}, $token->{attributes});            !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2592            $form_element = $open_elements->[-1]->[0];            $self->{form_element} = $self->{open_elements}->[-1]->[0];
2593            !!!next-token;            !!!next-token;
2594            return;            return;
2595          }          }
2596        } elsif ($token->{tag_name} eq 'li') {        } elsif ($token->{tag_name} eq 'li') {
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 2179  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 'li') {            if ($node->[1] eq 'li') {
2617              splice @$open_elements, $i;              if ($i != -1) {
2618                  !!!parse-error (type => 'end tag missing:'.
2619                                  $self->{open_elements}->[-1]->[1]);
2620                }
2621                splice @{$self->{open_elements}}, $i;
2622              last LI;              last LI;
2623            }            }
2624                        
# Line 2198  sub _construct_tree ($) { Line 2633  sub _construct_tree ($) {
2633                        
2634            ## Step 4            ## Step 4
2635            $i--;            $i--;
2636            $node = $open_elements->[$i];            $node = $self->{open_elements}->[$i];
2637            redo LI;            redo LI;
2638          } # LI          } # LI
2639                        
# Line 2207  sub _construct_tree ($) { Line 2642  sub _construct_tree ($) {
2642          return;          return;
2643        } elsif ($token->{tag_name} eq 'dd' or $token->{tag_name} eq 'dt') {        } elsif ($token->{tag_name} eq 'dd' or $token->{tag_name} eq 'dt') {
2644          ## has a p element in scope          ## has a p element in scope
2645          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2646            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2647              !!!back-token;              !!!back-token;
2648              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2222  sub _construct_tree ($) { Line 2657  sub _construct_tree ($) {
2657                        
2658          ## Step 1          ## Step 1
2659          my $i = -1;          my $i = -1;
2660          my $node = $open_elements->[$i];          my $node = $self->{open_elements}->[$i];
2661          LI: {          LI: {
2662            ## Step 2            ## Step 2
2663            if ($node->[1] eq 'dt' or $node->[1] eq 'dd') {            if ($node->[1] eq 'dt' or $node->[1] eq 'dd') {
2664              splice @$open_elements, $i;              if ($i != -1) {
2665                  !!!parse-error (type => 'end tag missing:'.
2666                                  $self->{open_elements}->[-1]->[1]);
2667                }
2668                splice @{$self->{open_elements}}, $i;
2669              last LI;              last LI;
2670            }            }
2671                        
# Line 2241  sub _construct_tree ($) { Line 2680  sub _construct_tree ($) {
2680                        
2681            ## Step 4            ## Step 4
2682            $i--;            $i--;
2683            $node = $open_elements->[$i];            $node = $self->{open_elements}->[$i];
2684            redo LI;            redo LI;
2685          } # LI          } # LI
2686                        
# Line 2250  sub _construct_tree ($) { Line 2689  sub _construct_tree ($) {
2689          return;          return;
2690        } elsif ($token->{tag_name} eq 'plaintext') {        } elsif ($token->{tag_name} eq 'plaintext') {
2691          ## has a p element in scope          ## has a p element in scope
2692          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2693            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2694              !!!back-token;              !!!back-token;
2695              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2273  sub _construct_tree ($) { Line 2712  sub _construct_tree ($) {
2712                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
2713                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2714          ## has a p element in scope          ## has a p element in scope
2715          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2716            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
2717            if ($node->[1] eq 'p') {            if ($node->[1] eq 'p') {
2718              !!!back-token;              !!!back-token;
2719              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2287  sub _construct_tree ($) { Line 2726  sub _construct_tree ($) {
2726            }            }
2727          } # INSCOPE          } # INSCOPE
2728                        
2729            ## NOTE: See <http://html5.org/tools/web-apps-tracker?from=925&to=926>
2730          ## has an element in scope          ## has an element in scope
2731          my $i;          #my $i;
2732          INSCOPE: for (reverse 0..$#$open_elements) {          #INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2733            my $node = $open_elements->[$_];          #  my $node = $self->{open_elements}->[$_];
2734            if ({          #  if ({
2735                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,          #       h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
2736                }->{$node->[1]}) {          #      }->{$node->[1]}) {
2737              $i = $_;          #    $i = $_;
2738              last INSCOPE;          #    last INSCOPE;
2739            } elsif ({          #  } elsif ({
2740                      table => 1, caption => 1, td => 1, th => 1,          #            table => 1, caption => 1, td => 1, th => 1,
2741                      button => 1, marquee => 1, object => 1, html => 1,          #            button => 1, marquee => 1, object => 1, html => 1,
2742                     }->{$node->[1]}) {          #           }->{$node->[1]}) {
2743              last INSCOPE;          #    last INSCOPE;
2744            }          #  }
2745          } # INSCOPE          #} # INSCOPE
2746                      #  
2747          if (defined $i) {          #if (defined $i) {
2748            !!!parse-error;          #  !!! parse-error (type => 'in hn:hn');
2749            splice @$open_elements, $i;          #  splice @{$self->{open_elements}}, $i;
2750          }          #}
2751                        
2752          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2753                        
# Line 2317  sub _construct_tree ($) { Line 2757  sub _construct_tree ($) {
2757          AFE: for my $i (reverse 0..$#$active_formatting_elements) {          AFE: for my $i (reverse 0..$#$active_formatting_elements) {
2758            my $node = $active_formatting_elements->[$i];            my $node = $active_formatting_elements->[$i];
2759            if ($node->[1] eq 'a') {            if ($node->[1] eq 'a') {
2760              !!!parse-error ('a in a');              !!!parse-error (type => 'in a:a');
2761                            
2762              !!!back-token;              !!!back-token;
2763              $token = {type => 'end tag', tag_name => 'a'};              $token = {type => 'end tag', tag_name => 'a'};
# Line 2329  sub _construct_tree ($) { Line 2769  sub _construct_tree ($) {
2769                  last AFE2;                  last AFE2;
2770                }                }
2771              } # AFE2              } # AFE2
2772              OE: for (reverse 0..$#$open_elements) {              OE: for (reverse 0..$#{$self->{open_elements}}) {
2773                if ($open_elements->[$_]->[0] eq $node->[0]) {                if ($self->{open_elements}->[$_]->[0] eq $node->[0]) {
2774                  splice @$open_elements, $_, 1;                  splice @{$self->{open_elements}}, $_, 1;
2775                  last OE;                  last OE;
2776                }                }
2777              } # OE              } # OE
# Line 2344  sub _construct_tree ($) { Line 2784  sub _construct_tree ($) {
2784          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2785    
2786          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2787          push @$active_formatting_elements, $open_elements->[-1];          push @$active_formatting_elements, $self->{open_elements}->[-1];
2788    
2789          !!!next-token;          !!!next-token;
2790          return;          return;
2791        } elsif ({        } elsif ({
2792                  b => 1, big => 1, em => 1, font => 1, i => 1,                  b => 1, big => 1, em => 1, font => 1, i => 1,
2793                  nobr => 1, s => 1, small => 1, strile => 1,                  s => 1, small => 1, strile => 1,
2794                  strong => 1, tt => 1, u => 1,                  strong => 1, tt => 1, u => 1,
2795                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2796          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2797                    
2798          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2799          push @$active_formatting_elements, $open_elements->[-1];          push @$active_formatting_elements, $self->{open_elements}->[-1];
2800            
2801            !!!next-token;
2802            return;
2803          } elsif ($token->{tag_name} eq 'nobr') {
2804            $reconstruct_active_formatting_elements->($insert_to_current);
2805    
2806            ## has a |nobr| element in scope
2807            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2808              my $node = $self->{open_elements}->[$_];
2809              if ($node->[1] eq 'nobr') {
2810                !!!parse-error (type => 'not closed:nobr');
2811                !!!back-token;
2812                $token = {type => 'end tag', tag_name => 'nobr'};
2813                return;
2814              } elsif ({
2815                        table => 1, caption => 1, td => 1, th => 1,
2816                        button => 1, marquee => 1, object => 1, html => 1,
2817                       }->{$node->[1]}) {
2818                last INSCOPE;
2819              }
2820            } # INSCOPE
2821            
2822            !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2823            push @$active_formatting_elements, $self->{open_elements}->[-1];
2824                    
2825          !!!next-token;          !!!next-token;
2826          return;          return;
2827        } elsif ($token->{tag_name} eq 'button') {        } elsif ($token->{tag_name} eq 'button') {
2828          ## has a button element in scope          ## has a button element in scope
2829          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2830            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
2831            if ($node->[1] eq 'button') {            if ($node->[1] eq 'button') {
2832              !!!parse-error;              !!!parse-error (type => 'in button:button');
2833              !!!back-token;              !!!back-token;
2834              $token = {type => 'end tag', tag_name => 'button'};              $token = {type => 'end tag', tag_name => 'button'};
2835              return;              return;
# Line 2395  sub _construct_tree ($) { Line 2859  sub _construct_tree ($) {
2859          return;          return;
2860        } elsif ($token->{tag_name} eq 'xmp') {        } elsif ($token->{tag_name} eq 'xmp') {
2861          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2862                    $parse_rcdata->('CDATA', $insert);
         !!!insert-element-t ($token->{tag_name}, $token->{attributes});  
           
         $self->{content_model_flag} = 'CDATA';  
           
         !!!next-token;  
2863          return;          return;
2864        } elsif ($token->{tag_name} eq 'table') {        } elsif ($token->{tag_name} eq 'table') {
2865          ## has a p element in scope          ## has a p element in scope
2866          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2867            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2868              !!!back-token;              !!!back-token;
2869              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2419  sub _construct_tree ($) { Line 2878  sub _construct_tree ($) {
2878                        
2879          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2880                        
2881          $insertion_mode = 'in table';          $self->{insertion_mode} = 'in table';
2882                        
2883          !!!next-token;          !!!next-token;
2884          return;          return;
# Line 2429  sub _construct_tree ($) { Line 2888  sub _construct_tree ($) {
2888                  image => 1,                  image => 1,
2889                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2890          if ($token->{tag_name} eq 'image') {          if ($token->{tag_name} eq 'image') {
2891            !!!parse-error;            !!!parse-error (type => 'image');
2892            $token->{tag_name} = 'img';            $token->{tag_name} = 'img';
2893          }          }
2894            
2895            ## NOTE: There is an "as if <br>" code clone.
2896          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2897                    
2898          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2899          pop @$open_elements;          pop @{$self->{open_elements}};
2900                    
2901          !!!next-token;          !!!next-token;
2902          return;          return;
2903        } elsif ($token->{tag_name} eq 'hr') {        } elsif ($token->{tag_name} eq 'hr') {
2904          ## has a p element in scope          ## has a p element in scope
2905          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2906            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2907              !!!back-token;              !!!back-token;
2908              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2456  sub _construct_tree ($) { Line 2916  sub _construct_tree ($) {
2916          } # INSCOPE          } # INSCOPE
2917                        
2918          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2919          pop @$open_elements;          pop @{$self->{open_elements}};
2920                        
2921          !!!next-token;          !!!next-token;
2922          return;          return;
# Line 2464  sub _construct_tree ($) { Line 2924  sub _construct_tree ($) {
2924          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2925                    
2926          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2927          ## TODO: associate with $form_element if defined          ## TODO: associate with $self->{form_element} if defined
2928          pop @$open_elements;          pop @{$self->{open_elements}};
2929                    
2930          !!!next-token;          !!!next-token;
2931          return;          return;
2932        } elsif ($token->{tag_name} eq 'isindex') {        } elsif ($token->{tag_name} eq 'isindex') {
2933          !!!parse-error;          !!!parse-error (type => 'isindex');
2934                    
2935          if (defined $form_element) {          if (defined $self->{form_element}) {
2936            ## Ignore the token            ## Ignore the token
2937            !!!next-token;            !!!next-token;
2938            return;            return;
2939          } else {          } else {
2940            my $at = $token->{attributes};            my $at = $token->{attributes};
2941              my $form_attrs;
2942              $form_attrs->{action} = $at->{action} if $at->{action};
2943              my $prompt_attr = $at->{prompt};
2944            $at->{name} = {name => 'name', value => 'isindex'};            $at->{name} = {name => 'name', value => 'isindex'};
2945              delete $at->{action};
2946              delete $at->{prompt};
2947            my @tokens = (            my @tokens = (
2948                          {type => 'start tag', tag_name => 'form'},                          {type => 'start tag', tag_name => 'form',
2949                             attributes => $form_attrs},
2950                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2951                          {type => 'start tag', tag_name => 'p'},                          {type => 'start tag', tag_name => 'p'},
2952                          {type => 'start tag', tag_name => 'label'},                          {type => 'start tag', tag_name => 'label'},
2953                          {type => 'character',                         );
2954                           data => 'This is a searchable index. Insert your search keywords here: '}, # SHOULD            if ($prompt_attr) {
2955                          ## TODO: make this configurable              push @tokens, {type => 'character', data => $prompt_attr->{value}};
2956              } else {
2957                push @tokens, {type => 'character',
2958                               data => 'This is a searchable index. Insert your search keywords here: '}; # SHOULD
2959                ## TODO: make this configurable
2960              }
2961              push @tokens,
2962                          {type => 'start tag', tag_name => 'input', attributes => $at},                          {type => 'start tag', tag_name => 'input', attributes => $at},
2963                          #{type => 'character', data => ''}, # SHOULD                          #{type => 'character', data => ''}, # SHOULD
2964                          {type => 'end tag', tag_name => 'label'},                          {type => 'end tag', tag_name => 'label'},
2965                          {type => 'end tag', tag_name => 'p'},                          {type => 'end tag', tag_name => 'p'},
2966                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2967                          {type => 'end tag', tag_name => 'form'},                          {type => 'end tag', tag_name => 'form'};
                        );  
2968            $token = shift @tokens;            $token = shift @tokens;
2969            !!!back-token (@tokens);            !!!back-token (@tokens);
2970            return;            return;
2971          }          }
2972        } elsif ({        } elsif ($token->{tag_name} eq 'textarea') {
                 textarea => 1,  
                 noembed => 1,  
                 noframes => 1,  
                 noscript => 0, ## TODO: 1 if scripting is enabled  
                }->{$token->{tag_name}}) {  
2973          my $tag_name = $token->{tag_name};          my $tag_name = $token->{tag_name};
2974          my $el;          my $el;
2975          !!!create-element ($el, $token->{tag_name}, $token->{attributes});          !!!create-element ($el, $token->{tag_name}, $token->{attributes});
2976                    
2977          if ($token->{tag_name} eq 'textarea') {          ## TODO: $self->{form_element} if defined
2978            ## TODO: form_element if defined          $self->{content_model_flag} = 'RCDATA';
2979            $self->{content_model_flag} = 'RCDATA';          delete $self->{escape}; # MUST
         } else {  
           $self->{content_model_flag} = 'CDATA';  
         }  
2980                    
2981          $insert->($el);          $insert->($el);
2982                    
2983          my $text = '';          my $text = '';
2984          !!!next-token;          !!!next-token;
2985            if ($token->{type} eq 'character') {
2986              $token->{data} =~ s/^\x0A//;
2987              unless (length $token->{data}) {
2988                !!!next-token;
2989              }
2990            }
2991          while ($token->{type} eq 'character') {          while ($token->{type} eq 'character') {
2992            $text .= $token->{data};            $text .= $token->{data};
2993            !!!next-token;            !!!next-token;
# Line 2533  sub _construct_tree ($) { Line 3002  sub _construct_tree ($) {
3002              $token->{tag_name} eq $tag_name) {              $token->{tag_name} eq $tag_name) {
3003            ## Ignore the token            ## Ignore the token
3004          } else {          } else {
3005            !!!parse-error;            !!!parse-error (type => 'in RCDATA:#'.$token->{type});
           ## ISSUE: And ignore?  
3006          }          }
3007          !!!next-token;          !!!next-token;
3008          return;          return;
3009          } elsif ({
3010                    iframe => 1,
3011                    noembed => 1,
3012                    noframes => 1,
3013                    noscript => 0, ## TODO: 1 if scripting is enabled
3014                   }->{$token->{tag_name}}) {
3015            $parse_rcdata->('CDATA', $insert);
3016            return;
3017        } elsif ($token->{tag_name} eq 'select') {        } elsif ($token->{tag_name} eq 'select') {
3018          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
3019                    
3020          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
3021                    
3022          $insertion_mode = 'in select';          $self->{insertion_mode} = 'in select';
3023          !!!next-token;          !!!next-token;
3024          return;          return;
3025        } elsif ({        } elsif ({
# Line 2552  sub _construct_tree ($) { Line 3028  sub _construct_tree ($) {
3028                  tbody => 1, td => 1, tfoot => 1, th => 1,                  tbody => 1, td => 1, tfoot => 1, th => 1,
3029                  thead => 1, tr => 1,                  thead => 1, tr => 1,
3030                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3031          !!!parse-error;          !!!parse-error (type => 'in body:'.$token->{tag_name});
3032          ## Ignore the token          ## Ignore the token
3033          !!!next-token;          !!!next-token;
3034          return;          return;
# Line 2568  sub _construct_tree ($) { Line 3044  sub _construct_tree ($) {
3044        }        }
3045      } elsif ($token->{type} eq 'end tag') {      } elsif ($token->{type} eq 'end tag') {
3046        if ($token->{tag_name} eq 'body') {        if ($token->{tag_name} eq 'body') {
3047          if (@$open_elements > 1 and $open_elements->[1]->[1] eq 'body') {          if (@{$self->{open_elements}} > 1 and
3048            ## ISSUE: There is an issue in the spec.              $self->{open_elements}->[1]->[1] eq 'body') {
3049            if ($open_elements->[-1]->[1] ne 'body') {            for (@{$self->{open_elements}}) {
3050              !!!parse-error;              unless ({
3051                           dd => 1, dt => 1, li => 1, p => 1, td => 1,
3052                           th => 1, tr => 1, body => 1, html => 1,
3053                         tbody => 1, tfoot => 1, thead => 1,
3054                        }->{$_->[1]}) {
3055                  !!!parse-error (type => 'not closed:'.$_->[1]);
3056                }
3057            }            }
3058            $insertion_mode = 'after body';  
3059              $self->{insertion_mode} = 'after body';
3060            !!!next-token;            !!!next-token;
3061            return;            return;
3062          } else {          } else {
3063            !!!parse-error;            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3064            ## Ignore the token            ## Ignore the token
3065            !!!next-token;            !!!next-token;
3066            return;            return;
3067          }          }
3068        } elsif ($token->{tag_name} eq 'html') {        } elsif ($token->{tag_name} eq 'html') {
3069          if (@$open_elements > 1 and $open_elements->[1]->[1] eq 'body') {          if (@{$self->{open_elements}} > 1 and $self->{open_elements}->[1]->[1] eq 'body') {
3070            ## ISSUE: There is an issue in the spec.            ## ISSUE: There is an issue in the spec.
3071            if ($open_elements->[-1]->[1] ne 'body') {            if ($self->{open_elements}->[-1]->[1] ne 'body') {
3072              !!!parse-error;              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[1]->[1]);
3073            }            }
3074            $insertion_mode = 'after body';            $self->{insertion_mode} = 'after body';
3075            ## reprocess            ## reprocess
3076            return;            return;
3077          } else {          } else {
3078            !!!parse-error;            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3079            ## Ignore the token            ## Ignore the token
3080            !!!next-token;            !!!next-token;
3081            return;            return;
# Line 2601  sub _construct_tree ($) { Line 3084  sub _construct_tree ($) {
3084                  address => 1, blockquote => 1, center => 1, dir => 1,                  address => 1, blockquote => 1, center => 1, dir => 1,
3085                  div => 1, dl => 1, fieldset => 1, listing => 1,                  div => 1, dl => 1, fieldset => 1, listing => 1,
3086                  menu => 1, ol => 1, pre => 1, ul => 1,                  menu => 1, ol => 1, pre => 1, ul => 1,
                 form => 1,  
3087                  p => 1,                  p => 1,
3088                  dd => 1, dt => 1, li => 1,                  dd => 1, dt => 1, li => 1,
3089                  button => 1, marquee => 1, object => 1,                  button => 1, marquee => 1, object => 1,
3090                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3091          ## has an element in scope          ## has an element in scope
3092          my $i;          my $i;
3093          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3094            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
3095            if ($node->[1] eq $token->{tag_name}) {            if ($node->[1] eq $token->{tag_name}) {
3096              ## generate implied end tags              ## generate implied end tags
3097              if ({              if ({
# Line 2618  sub _construct_tree ($) { Line 3100  sub _construct_tree ($) {
3100                   li => ($token->{tag_name} ne 'li'),                   li => ($token->{tag_name} ne 'li'),
3101                   p => ($token->{tag_name} ne 'p'),                   p => ($token->{tag_name} ne 'p'),
3102                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3103                  }->{$open_elements->[-1]->[1]}) {                   tbody => 1, tfoot=> 1, thead => 1,
3104                    }->{$self->{open_elements}->[-1]->[1]}) {
3105                !!!back-token;                !!!back-token;
3106                $token = {type => 'end tag',                $token = {type => 'end tag',
3107                          tag_name => $open_elements->[-1]->[1]}; # MUST                          tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3108                return;                return;
3109              }              }
3110              $i = $_;              $i = $_;
# Line 2634  sub _construct_tree ($) { Line 3117  sub _construct_tree ($) {
3117            }            }
3118          } # INSCOPE          } # INSCOPE
3119                    
3120          if ($open_elements->[-1]->[1] ne $token->{tag_name}) {          if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
3121            !!!parse-error;            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3122          }          }
3123                    
3124          splice @$open_elements, $i if defined $i;          if (defined $i) {
3125          undef $form_element if $token->{tag_name} eq 'form';            splice @{$self->{open_elements}}, $i;
3126            } elsif ($token->{tag_name} eq 'p') {
3127              ## As if <p>, then reprocess the current token
3128              my $el;
3129              !!!create-element ($el, 'p');
3130              $insert->($el);
3131            }
3132          $clear_up_to_marker->()          $clear_up_to_marker->()
3133            if {            if {
3134              button => 1, marquee => 1, object => 1,              button => 1, marquee => 1, object => 1,
3135            }->{$token->{tag_name}};            }->{$token->{tag_name}};
3136          !!!next-token;          !!!next-token;
3137          return;          return;
3138          } elsif ($token->{tag_name} eq 'form') {
3139            ## has an element in scope
3140            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3141              my $node = $self->{open_elements}->[$_];
3142              if ($node->[1] eq $token->{tag_name}) {
3143                ## generate implied end tags
3144                if ({
3145                     dd => 1, dt => 1, li => 1, p => 1,
3146                     td => 1, th => 1, tr => 1,
3147                     tbody => 1, tfoot=> 1, thead => 1,
3148                    }->{$self->{open_elements}->[-1]->[1]}) {
3149                  !!!back-token;
3150                  $token = {type => 'end tag',
3151                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3152                  return;
3153                }
3154                last INSCOPE;
3155              } elsif ({
3156                        table => 1, caption => 1, td => 1, th => 1,
3157                        button => 1, marquee => 1, object => 1, html => 1,
3158                       }->{$node->[1]}) {
3159                last INSCOPE;
3160              }
3161            } # INSCOPE
3162            
3163            if ($self->{open_elements}->[-1]->[1] eq $token->{tag_name}) {
3164              pop @{$self->{open_elements}};
3165            } else {
3166              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3167            }
3168    
3169            undef $self->{form_element};
3170            !!!next-token;
3171            return;
3172        } elsif ({        } elsif ({
3173                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
3174                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3175          ## has an element in scope          ## has an element in scope
3176          my $i;          my $i;
3177          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3178            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
3179            if ({            if ({
3180                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
3181                }->{$node->[1]}) {                }->{$node->[1]}) {
# Line 2660  sub _construct_tree ($) { Line 3183  sub _construct_tree ($) {
3183              if ({              if ({
3184                   dd => 1, dt => 1, li => 1, p => 1,                   dd => 1, dt => 1, li => 1, p => 1,
3185                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3186                  }->{$open_elements->[-1]->[1]}) {                   tbody => 1, tfoot=> 1, thead => 1,
3187                    }->{$self->{open_elements}->[-1]->[1]}) {
3188                !!!back-token;                !!!back-token;
3189                $token = {type => 'end tag',                $token = {type => 'end tag',
3190                          tag_name => $open_elements->[-1]->[1]}; # MUST                          tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3191                return;                return;
3192              }              }
3193              $i = $_;              $i = $_;
# Line 2676  sub _construct_tree ($) { Line 3200  sub _construct_tree ($) {
3200            }            }
3201          } # INSCOPE          } # INSCOPE
3202                    
3203          if ($open_elements->[-1]->[1] ne $token->{tag_name}) {          if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
3204            !!!parse-error;            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3205          }          }
3206                    
3207          splice @$open_elements, $i if defined $i;          splice @{$self->{open_elements}}, $i if defined $i;
3208          !!!next-token;          !!!next-token;
3209          return;          return;
3210        } elsif ({        } elsif ({
# Line 2691  sub _construct_tree ($) { Line 3215  sub _construct_tree ($) {
3215                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3216          $formatting_end_tag->($token->{tag_name});          $formatting_end_tag->($token->{tag_name});
3217          return;          return;
3218          } elsif ($token->{tag_name} eq 'br') {
3219            !!!parse-error (type => 'unmatched end tag:br');
3220    
3221            ## As if <br>
3222            $reconstruct_active_formatting_elements->($insert_to_current);
3223            
3224            my $el;
3225            !!!create-element ($el, 'br');
3226            $insert->($el);
3227            
3228            ## Ignore the token.
3229            !!!next-token;
3230            return;
3231        } elsif ({        } elsif ({
3232                  caption => 1, col => 1, colgroup => 1, frame => 1,                  caption => 1, col => 1, colgroup => 1, frame => 1,
3233                  frameset => 1, head => 1, option => 1, optgroup => 1,                  frameset => 1, head => 1, option => 1, optgroup => 1,
3234                  tbody => 1, td => 1, tfoot => 1, th => 1,                  tbody => 1, td => 1, tfoot => 1, th => 1,
3235                  thead => 1, tr => 1,                  thead => 1, tr => 1,
3236                  area => 1, basefont => 1, bgsound => 1, br => 1,                  area => 1, basefont => 1, bgsound => 1,
3237                  embed => 1, hr => 1, iframe => 1, image => 1,                  embed => 1, hr => 1, iframe => 1, image => 1,
3238                  img => 1, input => 1, isindex=> 1, noembed => 1,                  img => 1, input => 1, isindex => 1, noembed => 1,
3239                  noframes => 1, param => 1, select => 1, spacer => 1,                  noframes => 1, param => 1, select => 1, spacer => 1,
3240                  table => 1, textarea => 1, wbr => 1,                  table => 1, textarea => 1, wbr => 1,
3241                  noscript => 0, ## TODO: if scripting is enabled                  noscript => 0, ## TODO: if scripting is enabled
3242                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3243          !!!parse-error;          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3244          ## Ignore the token          ## Ignore the token
3245          !!!next-token;          !!!next-token;
3246          return;          return;
# Line 2713  sub _construct_tree ($) { Line 3250  sub _construct_tree ($) {
3250        } else {        } else {
3251          ## Step 1          ## Step 1
3252          my $node_i = -1;          my $node_i = -1;
3253          my $node = $open_elements->[$node_i];          my $node = $self->{open_elements}->[$node_i];
3254    
3255          ## Step 2          ## Step 2
3256          S2: {          S2: {
# Line 2723  sub _construct_tree ($) { Line 3260  sub _construct_tree ($) {
3260              if ({              if ({
3261                   dd => 1, dt => 1, li => 1, p => 1,                   dd => 1, dt => 1, li => 1, p => 1,
3262                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3263                  }->{$open_elements->[-1]->[1]}) {                   tbody => 1, tfoot=> 1, thead => 1,
3264                    }->{$self->{open_elements}->[-1]->[1]}) {
3265                !!!back-token;                !!!back-token;
3266                $token = {type => 'end tag',                $token = {type => 'end tag',
3267                          tag_name => $open_elements->[-1]->[1]}; # MUST                          tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3268                return;                return;
3269              }              }
3270                    
3271              ## Step 2              ## Step 2
3272              if ($token->{tag_name} ne $open_elements->[-1]->[1]) {              if ($token->{tag_name} ne $self->{open_elements}->[-1]->[1]) {
3273                !!!parse-error;                !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3274              }              }
3275                            
3276              ## Step 3              ## Step 3
3277              splice @$open_elements, $node_i;              splice @{$self->{open_elements}}, $node_i;
3278    
3279                !!!next-token;
3280              last S2;              last S2;
3281            } else {            } else {
3282              ## Step 3              ## Step 3
# Line 2744  sub _construct_tree ($) { Line 3284  sub _construct_tree ($) {
3284                  #not $phrasing_category->{$node->[1]} and                  #not $phrasing_category->{$node->[1]} and
3285                  ($special_category->{$node->[1]} or                  ($special_category->{$node->[1]} or
3286                   $scoping_category->{$node->[1]})) {                   $scoping_category->{$node->[1]})) {
3287                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3288                ## Ignore the token                ## Ignore the token
3289                !!!next-token;                !!!next-token;
3290                last S2;                last S2;
# Line 2753  sub _construct_tree ($) { Line 3293  sub _construct_tree ($) {
3293                        
3294            ## Step 4            ## Step 4
3295            $node_i--;            $node_i--;
3296            $node = $open_elements->[$node_i];            $node = $self->{open_elements}->[$node_i];
3297                        
3298            ## Step 5;            ## Step 5;
3299            redo S2;            redo S2;
3300          } # S2          } # S2
3301            return;
3302        }        }
3303      }      }
3304    }; # $in_body    }; # $in_body
3305    
3306    B: {    B: {
3307      if ($phase eq 'initial') {      if ($phase eq 'main') {
       if ($token->{type} eq 'DOCTYPE') {  
         if ($token->{error}) {  
           ## 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') {  
3308        if ($token->{type} eq 'DOCTYPE') {        if ($token->{type} eq 'DOCTYPE') {
3309          !!!parse-error;          !!!parse-error (type => 'in html:#DOCTYPE');
3310          ## Ignore the token          ## Ignore the token
3311          ## Stay in the phase          ## Stay in the phase
3312          !!!next-token;          !!!next-token;
3313          redo B;          redo B;
3314        } elsif ($token->{type} eq 'start tag' and        } elsif ($token->{type} eq 'start tag' and
3315                 $token->{tag_name} eq 'html') {                 $token->{tag_name} eq 'html') {
3316          ## TODO: unless it is the first start tag token, parse-error  ## ISSUE: "aa<html>" is not a parse error.
3317          my $top_el = $open_elements->[0]->[0];  ## ISSUE: "<html>" in fragment is not a parse error.
3318            unless ($token->{first_start_tag}) {
3319              !!!parse-error (type => 'not first start tag');
3320            }
3321            my $top_el = $self->{open_elements}->[0]->[0];
3322          for my $attr_name (keys %{$token->{attributes}}) {          for my $attr_name (keys %{$token->{attributes}}) {
3323            unless ($top_el->has_attribute_ns (undef, $attr_name)) {            unless ($top_el->has_attribute_ns (undef, $attr_name)) {
3324              $top_el->set_attribute_ns              $top_el->set_attribute_ns
# Line 2868  sub _construct_tree ($) { Line 3332  sub _construct_tree ($) {
3332          ## Generate implied end tags          ## Generate implied end tags
3333          if ({          if ({
3334               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,
3335              }->{$open_elements->[-1]->[1]}) {               tbody => 1, tfoot=> 1, thead => 1,
3336                }->{$self->{open_elements}->[-1]->[1]}) {
3337            !!!back-token;            !!!back-token;
3338            $token = {type => 'end tag', tag_name => $open_elements->[-1]->[1]};            $token = {type => 'end tag', tag_name => $self->{open_elements}->[-1]->[1]};
3339            redo B;            redo B;
3340          }          }
3341                    
3342          if (@$open_elements > 2 or          if (@{$self->{open_elements}} > 2 or
3343              (@$open_elements == 2 and $open_elements->[1]->[1] ne 'body')) {              (@{$self->{open_elements}} == 2 and $self->{open_elements}->[1]->[1] ne 'body')) {
3344            !!!parse-error;            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3345          } else {          } elsif (defined $self->{inner_html_node} and
3346            ## TODO: inner_html parser and @$open_elements > 1 and $open_elements->[1] ne 'body', then parse-error                   @{$self->{open_elements}} > 1 and
3347                     $self->{open_elements}->[1]->[1] ne 'body') {
3348              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3349          }          }
3350    
3351          ## Stop parsing          ## Stop parsing
# Line 2886  sub _construct_tree ($) { Line 3353  sub _construct_tree ($) {
3353    
3354          ## ISSUE: There is an issue in the spec.          ## ISSUE: There is an issue in the spec.
3355        } else {        } else {
3356          if ($insertion_mode eq 'before head') {          if ($self->{insertion_mode} eq 'before head') {
3357            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3358              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3359                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3360                unless (length $token->{data}) {                unless (length $token->{data}) {
3361                  !!!next-token;                  !!!next-token;
3362                  redo B;                  redo B;
3363                }                }
3364              }              }
3365              ## As if <head>              ## As if <head>
3366              !!!create-element ($head_element, 'head');              !!!create-element ($self->{head_element}, 'head');
3367              $open_elements->[-1]->[0]->append_child ($head_element);              $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
3368              push @$open_elements, [$head_element, 'head'];              push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3369              $insertion_mode = 'in head';              $self->{insertion_mode} = 'in head';
3370              ## reprocess              ## reprocess
3371              redo B;              redo B;
3372            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3373              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3374              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3375              !!!next-token;              !!!next-token;
3376              redo B;              redo B;
3377            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3378              my $attr = $token->{tag_name} eq 'head' ? $token->{attributes} : {};              my $attr = $token->{tag_name} eq 'head' ? $token->{attributes} : {};
3379              !!!create-element ($head_element, 'head', $attr);              !!!create-element ($self->{head_element}, 'head', $attr);
3380              $open_elements->[-1]->[0]->append_child ($head_element);              $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
3381              push @$open_elements, [$head_element, 'head'];              push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3382              $insertion_mode = 'in head';              $self->{insertion_mode} = 'in head';
3383              if ($token->{tag_name} eq 'head') {              if ($token->{tag_name} eq 'head') {
3384                !!!next-token;                !!!next-token;
3385              #} elsif ({              #} elsif ({
# Line 2925  sub _construct_tree ($) { Line 3392  sub _construct_tree ($) {
3392              }              }
3393              redo B;              redo B;
3394            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3395              if ($token->{tag_name} eq 'html') {              if ({
3396                     head => 1, body => 1, html => 1,
3397                     p => 1, br => 1,
3398                    }->{$token->{tag_name}}) {
3399                ## As if <head>                ## As if <head>
3400                !!!create-element ($head_element, 'head');                !!!create-element ($self->{head_element}, 'head');
3401                $open_elements->[-1]->[0]->append_child ($head_element);                $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
3402                push @$open_elements, [$head_element, 'head'];                push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3403                $insertion_mode = 'in head';                $self->{insertion_mode} = 'in head';
3404                ## reprocess                ## reprocess
3405                redo B;                redo B;
3406              } else {              } else {
3407                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3408                ## Ignore the token                ## Ignore the token ## ISSUE: An issue in the spec.
3409                !!!next-token;                !!!next-token;
3410                redo B;                redo B;
3411              }              }
3412            } else {            } else {
3413              die "$0: $token->{type}: Unknown type";              die "$0: $token->{type}: Unknown type";
3414            }            }
3415          } elsif ($insertion_mode eq 'in head') {          } elsif ($self->{insertion_mode} eq 'in head' or
3416                     $self->{insertion_mode} eq 'in head noscript' or
3417                     $self->{insertion_mode} eq 'after head') {
3418            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3419              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3420                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3421                unless (length $token->{data}) {                unless (length $token->{data}) {
3422                  !!!next-token;                  !!!next-token;
3423                  redo B;                  redo B;
# Line 2955  sub _construct_tree ($) { Line 3427  sub _construct_tree ($) {
3427              #              #
3428            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3429              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3430              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3431              !!!next-token;              !!!next-token;
3432              redo B;              redo B;
3433            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3434              if ($token->{tag_name} eq 'title') {              if ({base => ($self->{insertion_mode} eq 'in head' or
3435                ## NOTE: There is an "as if in head" code clone                            $self->{insertion_mode} eq 'after head'),
3436                my $title_el;                   link => 1, meta => 1}->{$token->{tag_name}}) {
3437                !!!create-element ($title_el, 'title', $token->{attributes});                ## NOTE: There is a "as if in head" code clone.
3438                (defined $head_element ? $head_element : $open_elements->[-1]->[0])                if ($self->{insertion_mode} eq 'after head') {
3439                  ->append_child ($title_el);                  !!!parse-error (type => 'after head:'.$token->{tag_name});
3440                $self->{content_model_flag} = 'RCDATA';                  push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3441                  }
3442                my $text = '';                !!!insert-element ($token->{tag_name}, $token->{attributes});
3443                  pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
3444                  ## TODO: Extracting |charset| from |meta|.
3445                  pop @{$self->{open_elements}}
3446                      if $self->{insertion_mode} eq 'after head';
3447                !!!next-token;                !!!next-token;
3448                while ($token->{type} eq 'character') {                redo B;
3449                  $text .= $token->{data};              } elsif ($token->{tag_name} eq 'title' and
3450                         $self->{insertion_mode} eq 'in head') {
3451                  ## NOTE: There is a "as if in head" code clone.
3452                  if ($self->{insertion_mode} eq 'after head') {
3453                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3454                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3455                  }
3456                  my $parent = defined $self->{head_element} ? $self->{head_element}
3457                      : $self->{open_elements}->[-1]->[0];
3458                  $parse_rcdata->('RCDATA', sub { $parent->append_child ($_[0]) });
3459                  pop @{$self->{open_elements}}
3460                      if $self->{insertion_mode} eq 'after head';
3461                  redo B;
3462                } elsif ($token->{tag_name} eq 'style') {
3463                  ## NOTE: Or (scripting is enabled and tag_name eq 'noscript' and
3464                  ## insertion mode 'in head')
3465                  ## NOTE: There is a "as if in head" code clone.
3466                  if ($self->{insertion_mode} eq 'after head') {
3467                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3468                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3469                  }
3470                  $parse_rcdata->('CDATA', $insert_to_current);
3471                  pop @{$self->{open_elements}}
3472                      if $self->{insertion_mode} eq 'after head';
3473                  redo B;
3474                } elsif ($token->{tag_name} eq 'noscript') {
3475                  if ($self->{insertion_mode} eq 'in head') {
3476                    ## NOTE: and scripting is disalbed
3477                    !!!insert-element ($token->{tag_name}, $token->{attributes});
3478                    $self->{insertion_mode} = 'in head noscript';
3479                  !!!next-token;                  !!!next-token;
3480                }                  redo B;
3481                if (length $text) {                } elsif ($self->{insertion_mode} eq 'in head noscript') {
3482                  $title_el->manakai_append_text ($text);                  !!!parse-error (type => 'in noscript:noscript');
               }  
                 
               $self->{content_model_flag} = 'PCDATA';  
                 
               if ($token->{type} eq 'end tag' and  
                   $token->{tag_name} eq 'title') {  
3483                  ## Ignore the token                  ## Ignore the token
3484                    redo B;
3485                } else {                } else {
3486                  !!!parse-error;                  #
                 ## ISSUE: And ignore?  
3487                }                }
3488                } elsif ($token->{tag_name} eq 'head' and
3489                         $self->{insertion_mode} ne 'after head') {
3490                  !!!parse-error (type => 'in head:head'); # or in head noscript
3491                  ## Ignore the token
3492                !!!next-token;                !!!next-token;
3493                redo B;                redo B;
3494              } elsif ($token->{tag_name} eq 'style') {              } elsif ($self->{insertion_mode} ne 'in head noscript' and
3495                $style_start_tag->();                       $token->{tag_name} eq 'script') {
3496                redo B;                if ($self->{insertion_mode} eq 'after head') {
3497              } elsif ($token->{tag_name} eq 'script') {                  !!!parse-error (type => 'after head:'.$token->{tag_name});
3498                $script_start_tag->();                  push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3499                  }
3500                  ## NOTE: There is a "as if in head" code clone.
3501                  $script_start_tag->($insert_to_current);
3502                  pop @{$self->{open_elements}}
3503                      if $self->{insertion_mode} eq 'after head';
3504                redo B;                redo B;
3505              } elsif ({base => 1, link => 1, meta => 1}->{$token->{tag_name}}) {              } elsif ($self->{insertion_mode} eq 'after head' and
3506                ## NOTE: There are "as if in head" code clones                       $token->{tag_name} eq 'body') {
3507                my $el;                !!!insert-element ('body', $token->{attributes});
3508                !!!create-element ($el, $token->{tag_name}, $token->{attributes});                $self->{insertion_mode} = 'in body';
               (defined $head_element ? $head_element : $open_elements->[-1]->[0])  
                 ->append_child ($el);  
   
3509                !!!next-token;                !!!next-token;
3510                redo B;                redo B;
3511              } elsif ($token->{tag_name} eq 'head') {              } elsif ($self->{insertion_mode} eq 'after head' and
3512                !!!parse-error;                       $token->{tag_name} eq 'frameset') {
3513                ## Ignore the token                !!!insert-element ('frameset', $token->{attributes});
3514                  $self->{insertion_mode} = 'in frameset';
3515                !!!next-token;                !!!next-token;
3516                redo B;                redo B;
3517              } else {              } else {
3518                #                #
3519              }              }
3520            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3521              if ($token->{tag_name} eq 'head') {              if ($self->{insertion_mode} eq 'in head' and
3522                if ($open_elements->[-1]->[1] eq 'head') {                  $token->{tag_name} eq 'head') {
3523                  pop @$open_elements;                pop @{$self->{open_elements}};
3524                } else {                $self->{insertion_mode} = 'after head';
3525                  !!!parse-error;                !!!next-token;
3526                }                redo B;
3527                $insertion_mode = 'after head';              } elsif ($self->{insertion_mode} eq 'in head noscript' and
3528                    $token->{tag_name} eq 'noscript') {
3529                  pop @{$self->{open_elements}};
3530                  $self->{insertion_mode} = 'in head';
3531                !!!next-token;                !!!next-token;
3532                redo B;                redo B;
3533              } elsif ($token->{tag_name} eq 'html') {              } elsif ($self->{insertion_mode} eq 'in head' and
3534                         {
3535                          body => 1, html => 1,
3536                          p => 1, br => 1,
3537                         }->{$token->{tag_name}}) {
3538                #                #
3539              } else {              } elsif ($self->{insertion_mode} eq 'in head noscript' and
3540                !!!parse-error;                       {
3541                          p => 1, br => 1,
3542                         }->{$token->{tag_name}}) {
3543                  #
3544                } elsif ($self->{insertion_mode} ne 'after head') {
3545                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3546                ## Ignore the token                ## Ignore the token
3547                !!!next-token;                !!!next-token;
3548                redo B;                redo B;
3549                } else {
3550                  #
3551              }              }
3552            } else {            } else {
3553              #              #
3554            }            }
3555    
3556            if ($open_elements->[-1]->[1] eq 'head') {            ## As if </head> or </noscript> or <body>
3557              ## As if </head>            if ($self->{insertion_mode} eq 'in head') {
3558              pop @$open_elements;              pop @{$self->{open_elements}};
3559                $self->{insertion_mode} = 'after head';
3560              } elsif ($self->{insertion_mode} eq 'in head noscript') {
3561                pop @{$self->{open_elements}};
3562                !!!parse-error (type => 'in noscript:'.(defined $token->{tag_name} ? ($token->{type} eq 'end tag' ? '/' : '') . $token->{tag_name} : '#' . $token->{type}));
3563                $self->{insertion_mode} = 'in head';
3564              } else { # 'after head'
3565                !!!insert-element ('body');
3566                $self->{insertion_mode} = 'in body';
3567            }            }
           $insertion_mode = 'after head';  
3568            ## reprocess            ## reprocess
3569            redo B;            redo B;
3570    
3571            ## ISSUE: An issue in the spec.            ## ISSUE: An issue in the spec.
3572          } 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') {  
3573            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3574              ## NOTE: There is a code clone of "character in body".              ## NOTE: There is a code clone of "character in body".
3575              $reconstruct_active_formatting_elements->($insert_to_current);              $reconstruct_active_formatting_elements->($insert_to_current);
3576                            
3577              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
3578    
3579              !!!next-token;              !!!next-token;
3580              redo B;              redo B;
3581            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3582              ## NOTE: There is a code clone of "comment in body".              ## NOTE: There is a code clone of "comment in body".
3583              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3584              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3585              !!!next-token;              !!!next-token;
3586              redo B;              redo B;
3587            } else {            } else {
3588              $in_body->($insert_to_current);              $in_body->($insert_to_current);
3589              redo B;              redo B;
3590            }            }
3591          } elsif ($insertion_mode eq 'in table') {          } elsif ($self->{insertion_mode} eq 'in table') {
3592            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3593              ## NOTE: There are "character in table" code clones.              ## NOTE: There are "character in table" code clones.
3594              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3595                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3596                                
3597                unless (length $token->{data}) {                unless (length $token->{data}) {
3598                  !!!next-token;                  !!!next-token;
# Line 3120  sub _construct_tree ($) { Line 3600  sub _construct_tree ($) {
3600                }                }
3601              }              }
3602    
3603                !!!parse-error (type => 'in table:#character');
3604    
3605              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
3606              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
3607              ## into the current node" while characters might not be              ## into the current node" while characters might not be
# Line 3129  sub _construct_tree ($) { Line 3611  sub _construct_tree ($) {
3611              if ({              if ({
3612                   table => 1, tbody => 1, tfoot => 1,                   table => 1, tbody => 1, tfoot => 1,
3613                   thead => 1, tr => 1,                   thead => 1, tr => 1,
3614                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3615                # MUST                # MUST
3616                my $foster_parent_element;                my $foster_parent_element;
3617                my $next_sibling;                my $next_sibling;
3618                my $prev_sibling;                my $prev_sibling;
3619                OE: for (reverse 0..$#$open_elements) {                OE: for (reverse 0..$#{$self->{open_elements}}) {
3620                  if ($open_elements->[$_]->[1] eq 'table') {                  if ($self->{open_elements}->[$_]->[1] eq 'table') {
3621                    my $parent = $open_elements->[$_]->[0]->parent_node;                    my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
3622                    if (defined $parent and $parent->node_type == 1) {                    if (defined $parent and $parent->node_type == 1) {
3623                      $foster_parent_element = $parent;                      $foster_parent_element = $parent;
3624                      $next_sibling = $open_elements->[$_]->[0];                      $next_sibling = $self->{open_elements}->[$_]->[0];
3625                      $prev_sibling = $next_sibling->previous_sibling;                      $prev_sibling = $next_sibling->previous_sibling;
3626                    } else {                    } else {
3627                      $foster_parent_element = $open_elements->[$_ - 1]->[0];                      $foster_parent_element = $self->{open_elements}->[$_ - 1]->[0];
3628                      $prev_sibling = $foster_parent_element->last_child;                      $prev_sibling = $foster_parent_element->last_child;
3629                    }                    }
3630                    last OE;                    last OE;
3631                  }                  }
3632                } # OE                } # OE
3633                $foster_parent_element = $open_elements->[0]->[0] and                $foster_parent_element = $self->{open_elements}->[0]->[0] and
3634                $prev_sibling = $foster_parent_element->last_child                $prev_sibling = $foster_parent_element->last_child
3635                  unless defined $foster_parent_element;                  unless defined $foster_parent_element;
3636                if (defined $prev_sibling and                if (defined $prev_sibling and
# Line 3160  sub _construct_tree ($) { Line 3642  sub _construct_tree ($) {
3642                     $next_sibling);                     $next_sibling);
3643                }                }
3644              } else {              } else {
3645                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
3646              }              }
3647                            
3648              !!!next-token;              !!!next-token;
3649              redo B;              redo B;
3650            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3651              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3652              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3653              !!!next-token;              !!!next-token;
3654              redo B;              redo B;
3655            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 3177  sub _construct_tree ($) { Line 3659  sub _construct_tree ($) {
3659                   tbody => 1, tfoot => 1, thead => 1,                   tbody => 1, tfoot => 1, thead => 1,
3660                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
3661                ## Clear back to table context                ## Clear back to table context
3662                while ($open_elements->[-1]->[1] ne 'table' and                while ($self->{open_elements}->[-1]->[1] ne 'table' and
3663                       $open_elements->[-1]->[1] ne 'html') {                       $self->{open_elements}->[-1]->[1] ne 'html') {
3664                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3665                  pop @$open_elements;                  pop @{$self->{open_elements}};
3666                }                }
3667    
3668                push @$active_formatting_elements, ['#marker', '']                push @$active_formatting_elements, ['#marker', '']
3669                  if $token->{tag_name} eq 'caption';                  if $token->{tag_name} eq 'caption';
3670    
3671                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
3672                $insertion_mode = {                $self->{insertion_mode} = {
3673                                   caption => 'in caption',                                   caption => 'in caption',
3674                                   colgroup => 'in column group',                                   colgroup => 'in column group',
3675                                   tbody => 'in table body',                                   tbody => 'in table body',
# Line 3201  sub _construct_tree ($) { Line 3683  sub _construct_tree ($) {
3683                        td => 1, th => 1, tr => 1,                        td => 1, th => 1, tr => 1,
3684                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
3685                ## Clear back to table context                ## Clear back to table context
3686                while ($open_elements->[-1]->[1] ne 'table' and                while ($self->{open_elements}->[-1]->[1] ne 'table' and
3687                       $open_elements->[-1]->[1] ne 'html') {                       $self->{open_elements}->[-1]->[1] ne 'html') {
3688                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3689                  pop @$open_elements;                  pop @{$self->{open_elements}};
3690                }                }
3691    
3692                !!!insert-element ($token->{tag_name} eq 'col' ? 'colgroup' : 'tbody');                !!!insert-element ($token->{tag_name} eq 'col' ? 'colgroup' : 'tbody');
3693                $insertion_mode = $token->{tag_name} eq 'col'                $self->{insertion_mode} = $token->{tag_name} eq 'col'
3694                  ? 'in column group' : 'in table body';                  ? 'in column group' : 'in table body';
3695                ## reprocess                ## reprocess
3696                redo B;                redo B;
3697              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
3698                ## NOTE: There are code clones for this "table in table"                ## NOTE: There are code clones for this "table in table"
3699                !!!parse-error;                !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3700    
3701                ## As if </table>                ## As if </table>
3702                ## have a table element in table scope                ## have a table element in table scope
3703                my $i;                my $i;
3704                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3705                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3706                  if ($node->[1] eq 'table') {                  if ($node->[1] eq 'table') {
3707                    $i = $_;                    $i = $_;
3708                    last INSCOPE;                    last INSCOPE;
# Line 3231  sub _construct_tree ($) { Line 3713  sub _construct_tree ($) {
3713                  }                  }
3714                } # INSCOPE                } # INSCOPE
3715                unless (defined $i) {                unless (defined $i) {
3716                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:table');
3717                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
3718                  !!!next-token;                  !!!next-token;
3719                  redo B;                  redo B;
# Line 3241  sub _construct_tree ($) { Line 3723  sub _construct_tree ($) {
3723                if ({                if ({
3724                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3725                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3726                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
3727                      }->{$self->{open_elements}->[-1]->[1]}) {
3728                  !!!back-token; # <table>                  !!!back-token; # <table>
3729                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
3730                  !!!back-token;                  !!!back-token;
3731                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3732                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3733                  redo B;                  redo B;
3734                }                }
3735    
3736                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
3737                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3738                }                }
3739    
3740                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3741    
3742                $reset_insertion_mode->();                              $self->_reset_insertion_mode;
3743    
3744                ## reprocess                ## reprocess
3745                redo B;                redo B;
# Line 3267  sub _construct_tree ($) { Line 3750  sub _construct_tree ($) {
3750              if ($token->{tag_name} eq 'table') {              if ($token->{tag_name} eq 'table') {
3751                ## have a table element in table scope                ## have a table element in table scope
3752                my $i;                my $i;
3753                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3754                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3755                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
3756                    $i = $_;                    $i = $_;
3757                    last INSCOPE;                    last INSCOPE;
# Line 3279  sub _construct_tree ($) { Line 3762  sub _construct_tree ($) {
3762                  }                  }
3763                } # INSCOPE                } # INSCOPE
3764                unless (defined $i) {                unless (defined $i) {
3765                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3766                  ## Ignore the token                  ## Ignore the token
3767                  !!!next-token;                  !!!next-token;
3768                  redo B;                  redo B;
# Line 3289  sub _construct_tree ($) { Line 3772  sub _construct_tree ($) {
3772                if ({                if ({
3773                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3774                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3775                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
3776                      }->{$self->{open_elements}->[-1]->[1]}) {
3777                  !!!back-token;                  !!!back-token;
3778                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3779                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3780                  redo B;                  redo B;
3781                }                }
3782    
3783                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
3784                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3785                }                }
3786    
3787                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3788    
3789                $reset_insertion_mode->();                $self->_reset_insertion_mode;
3790    
3791                !!!next-token;                !!!next-token;
3792                redo B;                redo B;
# Line 3311  sub _construct_tree ($) { Line 3795  sub _construct_tree ($) {
3795                        html => 1, tbody => 1, td => 1, tfoot => 1, th => 1,                        html => 1, tbody => 1, td => 1, tfoot => 1, th => 1,
3796                        thead => 1, tr => 1,                        thead => 1, tr => 1,
3797                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
3798                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3799                ## Ignore the token                ## Ignore the token
3800                !!!next-token;                !!!next-token;
3801                redo B;                redo B;
# Line 3322  sub _construct_tree ($) { Line 3806  sub _construct_tree ($) {
3806              #              #
3807            }            }
3808    
3809            !!!parse-error;            !!!parse-error (type => 'in table:'.$token->{tag_name});
3810            $in_body->($insert_to_foster);            $in_body->($insert_to_foster);
3811            redo B;            redo B;
3812          } elsif ($insertion_mode eq 'in caption') {          } elsif ($self->{insertion_mode} eq 'in caption') {
3813            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3814              ## NOTE: This is a code clone of "character in body".              ## NOTE: This is a code clone of "character in body".
3815              $reconstruct_active_formatting_elements->($insert_to_current);              $reconstruct_active_formatting_elements->($insert_to_current);
3816                            
3817              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
3818    
3819              !!!next-token;              !!!next-token;
3820              redo B;              redo B;
3821            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
3822              ## NOTE: This is a code clone of "comment in body".              ## NOTE: This is a code clone of "comment in body".
3823              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
3824              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
3825              !!!next-token;              !!!next-token;
3826              redo B;              redo B;
3827            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 3345  sub _construct_tree ($) { Line 3829  sub _construct_tree ($) {
3829                   caption => 1, col => 1, colgroup => 1, tbody => 1,                   caption => 1, col => 1, colgroup => 1, tbody => 1,
3830                   td => 1, tfoot => 1, th => 1, thead => 1, tr => 1,                   td => 1, tfoot => 1, th => 1, thead => 1, tr => 1,
3831                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
3832                !!!parse-error;                !!!parse-error (type => 'not closed:caption');
3833    
3834                ## As if </caption>                ## As if </caption>
3835                ## have a table element in table scope                ## have a table element in table scope
3836                my $i;                my $i;
3837                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3838                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3839                  if ($node->[1] eq 'caption') {                  if ($node->[1] eq 'caption') {
3840                    $i = $_;                    $i = $_;
3841                    last INSCOPE;                    last INSCOPE;
# Line 3362  sub _construct_tree ($) { Line 3846  sub _construct_tree ($) {
3846                  }                  }
3847                } # INSCOPE                } # INSCOPE
3848                unless (defined $i) {                unless (defined $i) {
3849                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:caption');
3850                  ## Ignore the token                  ## Ignore the token
3851                  !!!next-token;                  !!!next-token;
3852                  redo B;                  redo B;
# Line 3372  sub _construct_tree ($) { Line 3856  sub _construct_tree ($) {
3856                if ({                if ({
3857                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3858                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3859                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
3860                      }->{$self->{open_elements}->[-1]->[1]}) {
3861                  !!!back-token; # <?>                  !!!back-token; # <?>
3862                  $token = {type => 'end tag', tag_name => 'caption'};                  $token = {type => 'end tag', tag_name => 'caption'};
3863                  !!!back-token;                  !!!back-token;
3864                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3865                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3866                  redo B;                  redo B;
3867                }                }
3868    
3869                if ($open_elements->[-1]->[1] ne 'caption') {                if ($self->{open_elements}->[-1]->[1] ne 'caption') {
3870                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3871                }                }
3872    
3873                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3874    
3875                $clear_up_to_marker->();                $clear_up_to_marker->();
3876    
3877                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
3878    
3879                ## reprocess                ## reprocess
3880                redo B;                redo B;
# Line 3400  sub _construct_tree ($) { Line 3885  sub _construct_tree ($) {
3885              if ($token->{tag_name} eq 'caption') {              if ($token->{tag_name} eq 'caption') {
3886                ## have a table element in table scope                ## have a table element in table scope
3887                my $i;                my $i;
3888                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3889                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3890                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
3891                    $i = $_;                    $i = $_;
3892                    last INSCOPE;                    last INSCOPE;
# Line 3412  sub _construct_tree ($) { Line 3897  sub _construct_tree ($) {
3897                  }                  }
3898                } # INSCOPE                } # INSCOPE
3899                unless (defined $i) {                unless (defined $i) {
3900                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3901                  ## Ignore the token                  ## Ignore the token
3902                  !!!next-token;                  !!!next-token;
3903                  redo B;                  redo B;
# Line 3422  sub _construct_tree ($) { Line 3907  sub _construct_tree ($) {
3907                if ({                if ({
3908                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3909                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3910                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
3911                      }->{$self->{open_elements}->[-1]->[1]}) {
3912                  !!!back-token;                  !!!back-token;
3913                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3914                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3915                  redo B;                  redo B;
3916                }                }
3917    
3918                if ($open_elements->[-1]->[1] ne 'caption') {                if ($self->{open_elements}->[-1]->[1] ne 'caption') {
3919                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3920                }                }
3921    
3922                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3923    
3924                $clear_up_to_marker->();                $clear_up_to_marker->();
3925    
3926                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
3927    
3928                !!!next-token;                !!!next-token;
3929                redo B;                redo B;
3930              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
3931                !!!parse-error;                !!!parse-error (type => 'not closed:caption');
3932    
3933                ## As if </caption>                ## As if </caption>
3934                ## have a table element in table scope                ## have a table element in table scope
3935                my $i;                my $i;
3936                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3937                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3938                  if ($node->[1] eq 'caption') {                  if ($node->[1] eq 'caption') {
3939                    $i = $_;                    $i = $_;
3940                    last INSCOPE;                    last INSCOPE;
# Line 3459  sub _construct_tree ($) { Line 3945  sub _construct_tree ($) {
3945                  }                  }
3946                } # INSCOPE                } # INSCOPE
3947                unless (defined $i) {                unless (defined $i) {
3948                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:caption');
3949                  ## Ignore the token                  ## Ignore the token
3950                  !!!next-token;                  !!!next-token;
3951                  redo B;                  redo B;
# Line 3469  sub _construct_tree ($) { Line 3955  sub _construct_tree ($) {
3955                if ({                if ({
3956                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3957                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3958                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
3959                      }->{$self->{open_elements}->[-1]->[1]}) {
3960                  !!!back-token; # </table>                  !!!back-token; # </table>
3961                  $token = {type => 'end tag', tag_name => 'caption'};                  $token = {type => 'end tag', tag_name => 'caption'};
3962                  !!!back-token;                  !!!back-token;
3963                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3964                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3965                  redo B;                  redo B;
3966                }                }
3967    
3968                if ($open_elements->[-1]->[1] ne 'caption') {                if ($self->{open_elements}->[-1]->[1] ne 'caption') {
3969                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3970                }                }
3971    
3972                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3973    
3974                $clear_up_to_marker->();                $clear_up_to_marker->();
3975    
3976                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
3977    
3978                ## reprocess                ## reprocess
3979                redo B;                redo B;
# Line 3495  sub _construct_tree ($) { Line 3982  sub _construct_tree ($) {
3982                        html => 1, tbody => 1, td => 1, tfoot => 1,                        html => 1, tbody => 1, td => 1, tfoot => 1,
3983                        th => 1, thead => 1, tr => 1,                        th => 1, thead => 1, tr => 1,
3984                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
3985                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3986                ## Ignore the token                ## Ignore the token
3987                redo B;                redo B;
3988              } else {              } else {
# Line 3507  sub _construct_tree ($) { Line 3994  sub _construct_tree ($) {
3994                                
3995            $in_body->($insert_to_current);            $in_body->($insert_to_current);
3996            redo B;            redo B;
3997          } elsif ($insertion_mode eq 'in column group') {          } elsif ($self->{insertion_mode} eq 'in column group') {
3998            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3999              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4000                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4001                unless (length $token->{data}) {                unless (length $token->{data}) {
4002                  !!!next-token;                  !!!next-token;
4003                  redo B;                  redo B;
# Line 3520  sub _construct_tree ($) { Line 4007  sub _construct_tree ($) {
4007              #              #
4008            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4009              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4010              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4011              !!!next-token;              !!!next-token;
4012              redo B;              redo B;
4013            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4014              if ($token->{tag_name} eq 'col') {              if ($token->{tag_name} eq 'col') {
4015                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4016                pop @$open_elements;                pop @{$self->{open_elements}};
4017                !!!next-token;                !!!next-token;
4018                redo B;                redo B;
4019              } else {              } else {
# Line 3534  sub _construct_tree ($) { Line 4021  sub _construct_tree ($) {
4021              }              }
4022            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
4023              if ($token->{tag_name} eq 'colgroup') {              if ($token->{tag_name} eq 'colgroup') {
4024                if ($open_elements->[-1]->[1] eq 'html') {                if ($self->{open_elements}->[-1]->[1] eq 'html') {
4025                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:colgroup');
4026                  ## Ignore the token                  ## Ignore the token
4027                  !!!next-token;                  !!!next-token;
4028                  redo B;                  redo B;
4029                } else {                } else {
4030                  pop @$open_elements; # colgroup                  pop @{$self->{open_elements}}; # colgroup
4031                  $insertion_mode = 'in table';                  $self->{insertion_mode} = 'in table';
4032                  !!!next-token;                  !!!next-token;
4033                  redo B;                              redo B;            
4034                }                }
4035              } elsif ($token->{tag_name} eq 'col') {              } elsif ($token->{tag_name} eq 'col') {
4036                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:col');
4037                ## Ignore the token                ## Ignore the token
4038                !!!next-token;                !!!next-token;
4039                redo B;                redo B;
# Line 3558  sub _construct_tree ($) { Line 4045  sub _construct_tree ($) {
4045            }            }
4046    
4047            ## As if </colgroup>            ## As if </colgroup>
4048            if ($open_elements->[-1]->[1] eq 'html') {            if ($self->{open_elements}->[-1]->[1] eq 'html') {
4049              !!!parse-error;              !!!parse-error (type => 'unmatched end tag:colgroup');
4050              ## Ignore the token              ## Ignore the token
4051              !!!next-token;              !!!next-token;
4052              redo B;              redo B;
4053            } else {            } else {
4054              pop @$open_elements; # colgroup              pop @{$self->{open_elements}}; # colgroup
4055              $insertion_mode = 'in table';              $self->{insertion_mode} = 'in table';
4056              ## reprocess              ## reprocess
4057              redo B;              redo B;
4058            }            }
4059          } elsif ($insertion_mode eq 'in table body') {          } elsif ($self->{insertion_mode} eq 'in table body') {
4060            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4061              ## NOTE: This is a "character in table" code clone.              ## NOTE: This is a "character in table" code clone.
4062              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4063                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4064                                
4065                unless (length $token->{data}) {                unless (length $token->{data}) {
4066                  !!!next-token;                  !!!next-token;
# Line 3581  sub _construct_tree ($) { Line 4068  sub _construct_tree ($) {
4068                }                }
4069              }              }
4070    
4071                !!!parse-error (type => 'in table:#character');
4072    
4073              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
4074              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
4075              ## into the current node" while characters might not be              ## into the current node" while characters might not be
# Line 3590  sub _construct_tree ($) { Line 4079  sub _construct_tree ($) {
4079              if ({              if ({
4080                   table => 1, tbody => 1, tfoot => 1,                   table => 1, tbody => 1, tfoot => 1,
4081                   thead => 1, tr => 1,                   thead => 1, tr => 1,
4082                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
4083                # MUST                # MUST
4084                my $foster_parent_element;                my $foster_parent_element;
4085                my $next_sibling;                my $next_sibling;
4086                my $prev_sibling;                my $prev_sibling;
4087                OE: for (reverse 0..$#$open_elements) {                OE: for (reverse 0..$#{$self->{open_elements}}) {
4088                  if ($open_elements->[$_]->[1] eq 'table') {                  if ($self->{open_elements}->[$_]->[1] eq 'table') {
4089                    my $parent = $open_elements->[$_]->[0]->parent_node;                    my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
4090                    if (defined $parent and $parent->node_type == 1) {                    if (defined $parent and $parent->node_type == 1) {
4091                      $foster_parent_element = $parent;                      $foster_parent_element = $parent;
4092                      $next_sibling = $open_elements->[$_]->[0];                      $next_sibling = $self->{open_elements}->[$_]->[0];
4093                      $prev_sibling = $next_sibling->previous_sibling;                      $prev_sibling = $next_sibling->previous_sibling;
4094                    } else {                    } else {
4095                      $foster_parent_element = $open_elements->[$_ - 1]->[0];                      $foster_parent_element = $self->{open_elements}->[$_ - 1]->[0];
4096                      $prev_sibling = $foster_parent_element->last_child;                      $prev_sibling = $foster_parent_element->last_child;
4097                    }                    }
4098                    last OE;                    last OE;
4099                  }                  }
4100                } # OE                } # OE
4101                $foster_parent_element = $open_elements->[0]->[0] and                $foster_parent_element = $self->{open_elements}->[0]->[0] and
4102                $prev_sibling = $foster_parent_element->last_child                $prev_sibling = $foster_parent_element->last_child
4103                  unless defined $foster_parent_element;                  unless defined $foster_parent_element;
4104                if (defined $prev_sibling and                if (defined $prev_sibling and
# Line 3621  sub _construct_tree ($) { Line 4110  sub _construct_tree ($) {
4110                     $next_sibling);                     $next_sibling);
4111                }                }
4112              } else {              } else {
4113                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4114              }              }
4115                            
4116              !!!next-token;              !!!next-token;
# Line 3629  sub _construct_tree ($) { Line 4118  sub _construct_tree ($) {
4118            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4119              ## Copied from 'in table'              ## Copied from 'in table'
4120              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4121              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4122              !!!next-token;              !!!next-token;
4123              redo B;              redo B;
4124            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 3637  sub _construct_tree ($) { Line 4126  sub _construct_tree ($) {
4126                   tr => 1,                   tr => 1,
4127                   th => 1, td => 1,                   th => 1, td => 1,
4128                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
4129                  unless ($token->{tag_name} eq 'tr') {
4130                    !!!parse-error (type => 'missing start tag:tr');
4131                  }
4132    
4133                ## Clear back to table body context                ## Clear back to table body context
4134                while (not {                while (not {
4135                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4136                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4137                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4138                  pop @$open_elements;                  pop @{$self->{open_elements}};
4139                }                }
4140                                
4141                $insertion_mode = 'in row';                $self->{insertion_mode} = 'in row';
4142                if ($token->{tag_name} eq 'tr') {                if ($token->{tag_name} eq 'tr') {
4143                  !!!insert-element ($token->{tag_name}, $token->{attributes});                  !!!insert-element ($token->{tag_name}, $token->{attributes});
4144                  !!!next-token;                  !!!next-token;
# Line 3660  sub _construct_tree ($) { Line 4153  sub _construct_tree ($) {
4153                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4154                ## have an element in table scope                ## have an element in table scope
4155                my $i;                my $i;
4156                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4157                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4158                  if ({                  if ({
4159                       tbody => 1, thead => 1, tfoot => 1,                       tbody => 1, thead => 1, tfoot => 1,
4160                      }->{$node->[1]}) {                      }->{$node->[1]}) {
# Line 3674  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 3683  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                ## As if <{current node}>                ## As if <{current node}>
# Line 3695  sub _construct_tree ($) { Line 4188  sub _construct_tree ($) {
4188                ## Clear back to table body context                ## Clear back to table body context
4189                ## nop by definition                ## nop by definition
4190    
4191                pop @$open_elements;                pop @{$self->{open_elements}};
4192                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4193                ## reprocess                ## reprocess
4194                redo B;                redo B;
4195              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4196                ## NOTE: This is a code clone of "table in table"                ## NOTE: This is a code clone of "table in table"
4197                !!!parse-error;                !!!parse-error (type => 'not closed:table');
4198    
4199                ## As if </table>                ## As if </table>
4200                ## have a table element in table scope                ## have a table element in table scope
4201                my $i;                my $i;
4202                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4203                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4204                  if ($node->[1] eq 'table') {                  if ($node->[1] eq 'table') {
4205                    $i = $_;                    $i = $_;
4206                    last INSCOPE;                    last INSCOPE;
# Line 3718  sub _construct_tree ($) { Line 4211  sub _construct_tree ($) {
4211                  }                  }
4212                } # INSCOPE                } # INSCOPE
4213                unless (defined $i) {                unless (defined $i) {
4214                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:table');
4215                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
4216                  !!!next-token;                  !!!next-token;
4217                  redo B;                  redo B;
# Line 3728  sub _construct_tree ($) { Line 4221  sub _construct_tree ($) {
4221                if ({                if ({
4222                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4223                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4224                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
4225                      }->{$self->{open_elements}->[-1]->[1]}) {
4226                  !!!back-token; # <table>                  !!!back-token; # <table>
4227                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
4228                  !!!back-token;                  !!!back-token;
4229                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4230                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4231                  redo B;                  redo B;
4232                }                }
4233    
4234                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
4235                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4236                }                }
4237    
4238                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4239    
4240                $reset_insertion_mode->();                              $self->_reset_insertion_mode;
4241    
4242                ## reprocess                ## reprocess
4243                redo B;                redo B;
# Line 3756  sub _construct_tree ($) { Line 4250  sub _construct_tree ($) {
4250                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
4251                ## have an element in table scope                ## have an element in table scope
4252                my $i;                my $i;
4253                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4254                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4255                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4256                    $i = $_;                    $i = $_;
4257                    last INSCOPE;                    last INSCOPE;
# Line 3768  sub _construct_tree ($) { Line 4262  sub _construct_tree ($) {
4262                  }                  }
4263                } # INSCOPE                } # INSCOPE
4264                unless (defined $i) {                unless (defined $i) {
4265                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4266                  ## Ignore the token                  ## Ignore the token
4267                  !!!next-token;                  !!!next-token;
4268                  redo B;                  redo B;
# Line 3777  sub _construct_tree ($) { Line 4271  sub _construct_tree ($) {
4271                ## Clear back to table body context                ## Clear back to table body context
4272                while (not {                while (not {
4273                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4274                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4275                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4276                  pop @$open_elements;                  pop @{$self->{open_elements}};
4277                }                }
4278    
4279                pop @$open_elements;                pop @{$self->{open_elements}};
4280                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4281                !!!next-token;                !!!next-token;
4282                redo B;                redo B;
4283              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4284                ## have an element in table scope                ## have an element in table scope
4285                my $i;                my $i;
4286                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4287                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4288                  if ({                  if ({
4289                       tbody => 1, thead => 1, tfoot => 1,                       tbody => 1, thead => 1, tfoot => 1,
4290                      }->{$node->[1]}) {                      }->{$node->[1]}) {
# Line 3803  sub _construct_tree ($) { Line 4297  sub _construct_tree ($) {
4297                  }                  }
4298                } # INSCOPE                } # INSCOPE
4299                unless (defined $i) {                unless (defined $i) {
4300                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4301                  ## Ignore the token                  ## Ignore the token
4302                  !!!next-token;                  !!!next-token;
4303                  redo B;                  redo B;
# Line 3812  sub _construct_tree ($) { Line 4306  sub _construct_tree ($) {
4306                ## Clear back to table body context                ## Clear back to table body context
4307                while (not {                while (not {
4308                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4309                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4310                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4311                  pop @$open_elements;                  pop @{$self->{open_elements}};
4312                }                }
4313    
4314                ## As if <{current node}>                ## As if <{current node}>
# Line 3824  sub _construct_tree ($) { Line 4318  sub _construct_tree ($) {
4318                ## Clear back to table body context                ## Clear back to table body context
4319                ## nop by definition                ## nop by definition
4320    
4321                pop @$open_elements;                pop @{$self->{open_elements}};
4322                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4323                ## reprocess                ## reprocess
4324                redo B;                redo B;
4325              } elsif ({              } elsif ({
4326                        body => 1, caption => 1, col => 1, colgroup => 1,                        body => 1, caption => 1, col => 1, colgroup => 1,
4327                        html => 1, td => 1, th => 1, tr => 1,                        html => 1, td => 1, th => 1, tr => 1,
4328                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4329                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4330                ## Ignore the token                ## Ignore the token
4331                !!!next-token;                !!!next-token;
4332                redo B;                redo B;
# Line 3844  sub _construct_tree ($) { Line 4338  sub _construct_tree ($) {
4338            }            }
4339                        
4340            ## As if in table            ## As if in table
4341            !!!parse-error;            !!!parse-error (type => 'in table:'.$token->{tag_name});
4342            $in_body->($insert_to_foster);            $in_body->($insert_to_foster);
4343            redo B;            redo B;
4344          } elsif ($insertion_mode eq 'in row') {          } elsif ($self->{insertion_mode} eq 'in row') {
4345            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4346              ## NOTE: This is a "character in table" code clone.              ## NOTE: This is a "character in table" code clone.
4347              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4348                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4349                                
4350                unless (length $token->{data}) {                unless (length $token->{data}) {
4351                  !!!next-token;                  !!!next-token;
# Line 3859  sub _construct_tree ($) { Line 4353  sub _construct_tree ($) {
4353                }                }
4354              }              }
4355    
4356                !!!parse-error (type => 'in table:#character');
4357    
4358              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
4359              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
4360              ## into the current node" while characters might not be              ## into the current node" while characters might not be
# Line 3868  sub _construct_tree ($) { Line 4364  sub _construct_tree ($) {
4364              if ({              if ({
4365                   table => 1, tbody => 1, tfoot => 1,                   table => 1, tbody => 1, tfoot => 1,
4366                   thead => 1, tr => 1,                   thead => 1, tr => 1,
4367                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
4368                # MUST                # MUST
4369                my $foster_parent_element;                my $foster_parent_element;
4370                my $next_sibling;                my $next_sibling;
4371                my $prev_sibling;                my $prev_sibling;
4372                OE: for (reverse 0..$#$open_elements) {                OE: for (reverse 0..$#{$self->{open_elements}}) {
4373                  if ($open_elements->[$_]->[1] eq 'table') {                  if ($self->{open_elements}->[$_]->[1] eq 'table') {
4374                    my $parent = $open_elements->[$_]->[0]->parent_node;                    my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
4375                    if (defined $parent and $parent->node_type == 1) {                    if (defined $parent and $parent->node_type == 1) {
4376                      $foster_parent_element = $parent;                      $foster_parent_element = $parent;
4377                      $next_sibling = $open_elements->[$_]->[0];                      $next_sibling = $self->{open_elements}->[$_]->[0];
4378                      $prev_sibling = $next_sibling->previous_sibling;                      $prev_sibling = $next_sibling->previous_sibling;
4379                    } else {                    } else {
4380                      $foster_parent_element = $open_elements->[$_ - 1]->[0];                      $foster_parent_element = $self->{open_elements}->[$_ - 1]->[0];
4381                      $prev_sibling = $foster_parent_element->last_child;                      $prev_sibling = $foster_parent_element->last_child;
4382                    }                    }
4383                    last OE;                    last OE;
4384                  }                  }
4385                } # OE                } # OE
4386                $foster_parent_element = $open_elements->[0]->[0] and                $foster_parent_element = $self->{open_elements}->[0]->[0] and
4387                $prev_sibling = $foster_parent_element->last_child                $prev_sibling = $foster_parent_element->last_child
4388                  unless defined $foster_parent_element;                  unless defined $foster_parent_element;
4389                if (defined $prev_sibling and                if (defined $prev_sibling and
# Line 3899  sub _construct_tree ($) { Line 4395  sub _construct_tree ($) {
4395                     $next_sibling);                     $next_sibling);
4396                }                }
4397              } else {              } else {
4398                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4399              }              }
4400                            
4401              !!!next-token;              !!!next-token;
# Line 3907  sub _construct_tree ($) { Line 4403  sub _construct_tree ($) {
4403            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4404              ## Copied from 'in table'              ## Copied from 'in table'
4405              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4406              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4407              !!!next-token;              !!!next-token;
4408              redo B;              redo B;
4409            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 3916  sub _construct_tree ($) { Line 4412  sub _construct_tree ($) {
4412                ## Clear back to table row context                ## Clear back to table row context
4413                while (not {                while (not {
4414                  tr => 1, html => 1,                  tr => 1, html => 1,
4415                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4416                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4417                  pop @$open_elements;                  pop @{$self->{open_elements}};
4418                }                }
4419                                
4420                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4421                $insertion_mode = 'in cell';                $self->{insertion_mode} = 'in cell';
4422    
4423                push @$active_formatting_elements, ['#marker', ''];                push @$active_formatting_elements, ['#marker', ''];
4424                                
# Line 3935  sub _construct_tree ($) { Line 4431  sub _construct_tree ($) {
4431                ## As if </tr>                ## As if </tr>
4432                ## have an element in table scope                ## have an element in table scope
4433                my $i;                my $i;
4434                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4435                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4436                  if ($node->[1] eq 'tr') {                  if ($node->[1] eq 'tr') {
4437                    $i = $_;                    $i = $_;
4438                    last INSCOPE;                    last INSCOPE;
# Line 3947  sub _construct_tree ($) { Line 4443  sub _construct_tree ($) {
4443                  }                  }
4444                } # INSCOPE                } # INSCOPE
4445                unless (defined $i) {                unless (defined $i) {
4446                  !!!parse-error;                  !!!parse-error (type => 'unmacthed end tag:'.$token->{tag_name});
4447                  ## Ignore the token                  ## Ignore the token
4448                  !!!next-token;                  !!!next-token;
4449                  redo B;                  redo B;
# Line 3956  sub _construct_tree ($) { Line 4452  sub _construct_tree ($) {
4452                ## Clear back to table row context                ## Clear back to table row context
4453                while (not {                while (not {
4454                  tr => 1, html => 1,                  tr => 1, html => 1,
4455                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4456                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4457                  pop @$open_elements;                  pop @{$self->{open_elements}};
4458                }                }
4459    
4460                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4461                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4462                ## reprocess                ## reprocess
4463                redo B;                redo B;
4464              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4465                ## NOTE: This is a code clone of "table in table"                ## NOTE: This is a code clone of "table in table"
4466                !!!parse-error;                !!!parse-error (type => 'not closed:table');
4467    
4468                ## As if </table>                ## As if </table>
4469                ## have a table element in table scope                ## have a table element in table scope
4470                my $i;                my $i;
4471                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4472                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4473                  if ($node->[1] eq 'table') {                  if ($node->[1] eq 'table') {
4474                    $i = $_;                    $i = $_;
4475                    last INSCOPE;                    last INSCOPE;
# Line 3984  sub _construct_tree ($) { Line 4480  sub _construct_tree ($) {
4480                  }                  }
4481                } # INSCOPE                } # INSCOPE
4482                unless (defined $i) {                unless (defined $i) {
4483                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:table');
4484                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
4485                  !!!next-token;                  !!!next-token;
4486                  redo B;                  redo B;
# Line 3994  sub _construct_tree ($) { Line 4490  sub _construct_tree ($) {
4490                if ({                if ({
4491                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4492                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4493                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
4494                      }->{$self->{open_elements}->[-1]->[1]}) {
4495                  !!!back-token; # <table>                  !!!back-token; # <table>
4496                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
4497                  !!!back-token;                  !!!back-token;
4498                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4499                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4500                  redo B;                  redo B;
4501                }                }
4502    
4503                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
4504                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4505                }                }
4506    
4507                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4508    
4509                $reset_insertion_mode->();                              $self->_reset_insertion_mode;
4510    
4511                ## reprocess                ## reprocess
4512                redo B;                redo B;
# Line 4020  sub _construct_tree ($) { Line 4517  sub _construct_tree ($) {
4517              if ($token->{tag_name} eq 'tr') {              if ($token->{tag_name} eq 'tr') {
4518                ## have an element in table scope                ## have an element in table scope
4519                my $i;                my $i;
4520                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4521                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4522                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4523                    $i = $_;                    $i = $_;
4524                    last INSCOPE;                    last INSCOPE;
# Line 4032  sub _construct_tree ($) { Line 4529  sub _construct_tree ($) {
4529                  }                  }
4530                } # INSCOPE                } # INSCOPE
4531                unless (defined $i) {                unless (defined $i) {
4532                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4533                  ## Ignore the token                  ## Ignore the token
4534                  !!!next-token;                  !!!next-token;
4535                  redo B;                  redo B;
# Line 4041  sub _construct_tree ($) { Line 4538  sub _construct_tree ($) {
4538                ## Clear back to table row context                ## Clear back to table row context
4539                while (not {                while (not {
4540                  tr => 1, html => 1,                  tr => 1, html => 1,
4541                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4542                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4543                  pop @$open_elements;                  pop @{$self->{open_elements}};
4544                }                }
4545    
4546                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4547                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4548                !!!next-token;                !!!next-token;
4549                redo B;                redo B;
4550              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4551                ## As if </tr>                ## As if </tr>
4552                ## have an element in table scope                ## have an element in table scope
4553                my $i;                my $i;
4554                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4555                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4556                  if ($node->[1] eq 'tr') {                  if ($node->[1] eq 'tr') {
4557                    $i = $_;                    $i = $_;
4558                    last INSCOPE;                    last INSCOPE;
# Line 4066  sub _construct_tree ($) { Line 4563  sub _construct_tree ($) {
4563                  }                  }
4564                } # INSCOPE                } # INSCOPE
4565                unless (defined $i) {                unless (defined $i) {
4566                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{type});
4567                  ## Ignore the token                  ## Ignore the token
4568                  !!!next-token;                  !!!next-token;
4569                  redo B;                  redo B;
# Line 4075  sub _construct_tree ($) { Line 4572  sub _construct_tree ($) {
4572                ## Clear back to table row context                ## Clear back to table row context
4573                while (not {                while (not {
4574                  tr => 1, html => 1,                  tr => 1, html => 1,
4575                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4576                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4577                  pop @$open_elements;                  pop @{$self->{open_elements}};
4578                }                }
4579    
4580                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4581                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4582                ## reprocess                ## reprocess
4583                redo B;                redo B;
4584              } elsif ({              } elsif ({
# Line 4089  sub _construct_tree ($) { Line 4586  sub _construct_tree ($) {
4586                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4587                ## have an element in table scope                ## have an element in table scope
4588                my $i;                my $i;
4589                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4590                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4591                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4592                    $i = $_;                    $i = $_;
4593                    last INSCOPE;                    last INSCOPE;
# Line 4101  sub _construct_tree ($) { Line 4598  sub _construct_tree ($) {
4598                  }                  }
4599                } # INSCOPE                } # INSCOPE
4600                unless (defined $i) {                unless (defined $i) {
4601                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4602                  ## Ignore the token                  ## Ignore the token
4603                  !!!next-token;                  !!!next-token;
4604                  redo B;                  redo B;
# Line 4110  sub _construct_tree ($) { Line 4607  sub _construct_tree ($) {
4607                ## As if </tr>                ## As if </tr>
4608                ## have an element in table scope                ## have an element in table scope
4609                my $i;                my $i;
4610                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4611                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4612                  if ($node->[1] eq 'tr') {                  if ($node->[1] eq 'tr') {
4613                    $i = $_;                    $i = $_;
4614                    last INSCOPE;                    last INSCOPE;
# Line 4122  sub _construct_tree ($) { Line 4619  sub _construct_tree ($) {
4619                  }                  }
4620                } # INSCOPE                } # INSCOPE
4621                unless (defined $i) {                unless (defined $i) {
4622                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:tr');
4623                  ## Ignore the token                  ## Ignore the token
4624                  !!!next-token;                  !!!next-token;
4625                  redo B;                  redo B;
# Line 4131  sub _construct_tree ($) { Line 4628  sub _construct_tree ($) {
4628                ## Clear back to table row context                ## Clear back to table row context
4629                while (not {                while (not {
4630                  tr => 1, html => 1,                  tr => 1, html => 1,
4631                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4632                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4633                  pop @$open_elements;                  pop @{$self->{open_elements}};
4634                }                }
4635    
4636                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4637                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4638                ## reprocess                ## reprocess
4639                redo B;                redo B;
4640              } elsif ({              } elsif ({
4641                        body => 1, caption => 1, col => 1,                        body => 1, caption => 1, col => 1,
4642                        colgroup => 1, html => 1, td => 1, th => 1,                        colgroup => 1, html => 1, td => 1, th => 1,
4643                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4644                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4645                ## Ignore the token                ## Ignore the token
4646                !!!next-token;                !!!next-token;
4647                redo B;                redo B;
# Line 4156  sub _construct_tree ($) { Line 4653  sub _construct_tree ($) {
4653            }            }
4654    
4655            ## As if in table            ## As if in table
4656            !!!parse-error;            !!!parse-error (type => 'in table:'.$token->{tag_name});
4657            $in_body->($insert_to_foster);            $in_body->($insert_to_foster);
4658            redo B;            redo B;
4659          } elsif ($insertion_mode eq 'in cell') {          } elsif ($self->{insertion_mode} eq 'in cell') {
4660            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4661              ## NOTE: This is a code clone of "character in body".              ## NOTE: This is a code clone of "character in body".
4662              $reconstruct_active_formatting_elements->($insert_to_current);              $reconstruct_active_formatting_elements->($insert_to_current);
4663                            
4664              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4665    
4666              !!!next-token;              !!!next-token;
4667              redo B;              redo B;
4668            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4669              ## NOTE: This is a code clone of "comment in body".              ## NOTE: This is a code clone of "comment in body".
4670              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4671              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4672              !!!next-token;              !!!next-token;
4673              redo B;              redo B;
4674            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 4182  sub _construct_tree ($) { Line 4679  sub _construct_tree ($) {
4679                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
4680                ## have an element in table scope                ## have an element in table scope
4681                my $tn;                my $tn;
4682                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4683                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4684                  if ($node->[1] eq 'td' or $node->[1] eq 'th') {                  if ($node->[1] eq 'td' or $node->[1] eq 'th') {
4685                    $tn = $node->[1];                    $tn = $node->[1];
4686                    last INSCOPE;                    last INSCOPE;
# Line 4194  sub _construct_tree ($) { Line 4691  sub _construct_tree ($) {
4691                  }                  }
4692                } # INSCOPE                } # INSCOPE
4693                unless (defined $tn) {                unless (defined $tn) {
4694                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4695                  ## Ignore the token                  ## Ignore the token
4696                  !!!next-token;                  !!!next-token;
4697                  redo B;                  redo B;
# Line 4211  sub _construct_tree ($) { Line 4708  sub _construct_tree ($) {
4708              if ($token->{tag_name} eq 'td' or $token->{tag_name} eq 'th') {              if ($token->{tag_name} eq 'td' or $token->{tag_name} eq 'th') {
4709                ## have an element in table scope                ## have an element in table scope
4710                my $i;                my $i;
4711                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4712                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4713                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4714                    $i = $_;                    $i = $_;
4715                    last INSCOPE;                    last INSCOPE;
# Line 4223  sub _construct_tree ($) { Line 4720  sub _construct_tree ($) {
4720                  }                  }
4721                } # INSCOPE                } # INSCOPE
4722                unless (defined $i) {                unless (defined $i) {
4723                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4724                  ## Ignore the token                  ## Ignore the token
4725                  !!!next-token;                  !!!next-token;
4726                  redo B;                  redo B;
# Line 4235  sub _construct_tree ($) { Line 4732  sub _construct_tree ($) {
4732                     td => ($token->{tag_name} eq 'th'),                     td => ($token->{tag_name} eq 'th'),
4733                     th => ($token->{tag_name} eq 'td'),                     th => ($token->{tag_name} eq 'td'),
4734                     tr => 1,                     tr => 1,
4735                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
4736                      }->{$self->{open_elements}->[-1]->[1]}) {
4737                  !!!back-token;                  !!!back-token;
4738                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4739                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4740                  redo B;                  redo B;
4741                }                }
4742    
4743                if ($open_elements->[-1]->[1] ne $token->{tag_name}) {                if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
4744                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4745                }                }
4746    
4747                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4748    
4749                $clear_up_to_marker->();                $clear_up_to_marker->();
4750    
4751                $insertion_mode = 'in row';                $self->{insertion_mode} = 'in row';
4752    
4753                !!!next-token;                !!!next-token;
4754                redo B;                redo B;
# Line 4258  sub _construct_tree ($) { Line 4756  sub _construct_tree ($) {
4756                        body => 1, caption => 1, col => 1,                        body => 1, caption => 1, col => 1,
4757                        colgroup => 1, html => 1,                        colgroup => 1, html => 1,
4758                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4759                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4760                ## Ignore the token                ## Ignore the token
4761                !!!next-token;                !!!next-token;
4762                redo B;                redo B;
# Line 4269  sub _construct_tree ($) { Line 4767  sub _construct_tree ($) {
4767                ## have an element in table scope                ## have an element in table scope
4768                my $i;                my $i;
4769                my $tn;                my $tn;
4770                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4771                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4772                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4773                    $i = $_;                    $i = $_;
4774                    last INSCOPE;                    last INSCOPE;
# Line 4285  sub _construct_tree ($) { Line 4783  sub _construct_tree ($) {
4783                  }                  }
4784                } # INSCOPE                } # INSCOPE
4785                unless (defined $i) {                unless (defined $i) {
4786                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4787                  ## Ignore the token                  ## Ignore the token
4788                  !!!next-token;                  !!!next-token;
4789                  redo B;                  redo B;
# Line 4304  sub _construct_tree ($) { Line 4802  sub _construct_tree ($) {
4802                        
4803            $in_body->($insert_to_current);            $in_body->($insert_to_current);
4804            redo B;            redo B;
4805          } elsif ($insertion_mode eq 'in select') {          } elsif ($self->{insertion_mode} eq 'in select') {
4806            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4807              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4808              !!!next-token;              !!!next-token;
4809              redo B;              redo B;
4810            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
4811              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
4812              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
4813              !!!next-token;              !!!next-token;
4814              redo B;              redo B;
4815            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4816              if ($token->{tag_name} eq 'option') {              if ($token->{tag_name} eq 'option') {
4817                if ($open_elements->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
4818                  ## As if </option>                  ## As if </option>
4819                  pop @$open_elements;                  pop @{$self->{open_elements}};
4820                }                }
4821    
4822                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4823                !!!next-token;                !!!next-token;
4824                redo B;                redo B;
4825              } elsif ($token->{tag_name} eq 'optgroup') {              } elsif ($token->{tag_name} eq 'optgroup') {
4826                if ($open_elements->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
4827                  ## As if </option>                  ## As if </option>
4828                  pop @$open_elements;                  pop @{$self->{open_elements}};
4829                }                }
4830    
4831                if ($open_elements->[-1]->[1] eq 'optgroup') {                if ($self->{open_elements}->[-1]->[1] eq 'optgroup') {
4832                  ## As if </optgroup>                  ## As if </optgroup>
4833                  pop @$open_elements;                  pop @{$self->{open_elements}};
4834                }                }
4835    
4836                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4837                !!!next-token;                !!!next-token;
4838                redo B;                redo B;
4839              } elsif ($token->{tag_name} eq 'select') {              } elsif ($token->{tag_name} eq 'select') {
4840                !!!parse-error;                !!!parse-error (type => 'not closed:select');
4841                ## As if </select> instead                ## As if </select> instead
4842                ## have an element in table scope                ## have an element in table scope
4843                my $i;                my $i;
4844                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4845                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4846                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4847                    $i = $_;                    $i = $_;
4848                    last INSCOPE;                    last INSCOPE;
# Line 4355  sub _construct_tree ($) { Line 4853  sub _construct_tree ($) {
4853                  }                  }
4854                } # INSCOPE                } # INSCOPE
4855                unless (defined $i) {                unless (defined $i) {
4856                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:select');
4857                  ## Ignore the token                  ## Ignore the token
4858                  !!!next-token;                  !!!next-token;
4859                  redo B;                  redo B;
4860                }                }
4861                                
4862                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4863    
4864                $reset_insertion_mode->();                $self->_reset_insertion_mode;
4865    
4866                !!!next-token;                !!!next-token;
4867                redo B;                redo B;
# Line 4372  sub _construct_tree ($) { Line 4870  sub _construct_tree ($) {
4870              }              }
4871            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
4872              if ($token->{tag_name} eq 'optgroup') {              if ($token->{tag_name} eq 'optgroup') {
4873                if ($open_elements->[-1]->[1] eq 'option' and                if ($self->{open_elements}->[-1]->[1] eq 'option' and
4874                    $open_elements->[-2]->[1] eq 'optgroup') {                    $self->{open_elements}->[-2]->[1] eq 'optgroup') {
4875                  ## As if </option>                  ## As if </option>
4876                  splice @$open_elements, -2;                  splice @{$self->{open_elements}}, -2;
4877                } elsif ($open_elements->[-1]->[1] eq 'optgroup') {                } elsif ($self->{open_elements}->[-1]->[1] eq 'optgroup') {
4878                  pop @$open_elements;                  pop @{$self->{open_elements}};
4879                } else {                } else {
4880                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4881                  ## Ignore the token                  ## Ignore the token
4882                }                }
4883                !!!next-token;                !!!next-token;
4884                redo B;                redo B;
4885              } elsif ($token->{tag_name} eq 'option') {              } elsif ($token->{tag_name} eq 'option') {
4886                if ($open_elements->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
4887                  pop @$open_elements;                  pop @{$self->{open_elements}};
4888                } else {                } else {
4889                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4890                  ## Ignore the token                  ## Ignore the token
4891                }                }
4892                !!!next-token;                !!!next-token;
# Line 4396  sub _construct_tree ($) { Line 4894  sub _construct_tree ($) {
4894              } elsif ($token->{tag_name} eq 'select') {              } elsif ($token->{tag_name} eq 'select') {
4895                ## have an element in table scope                ## have an element in table scope
4896                my $i;                my $i;
4897                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4898                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4899                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4900                    $i = $_;                    $i = $_;
4901                    last INSCOPE;                    last INSCOPE;
# Line 4408  sub _construct_tree ($) { Line 4906  sub _construct_tree ($) {
4906                  }                  }
4907                } # INSCOPE                } # INSCOPE
4908                unless (defined $i) {                unless (defined $i) {
4909                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4910                  ## Ignore the token                  ## Ignore the token
4911                  !!!next-token;                  !!!next-token;
4912                  redo B;                  redo B;
4913                }                }
4914                                
4915                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4916    
4917                $reset_insertion_mode->();                $self->_reset_insertion_mode;
4918    
4919                !!!next-token;                !!!next-token;
4920                redo B;                redo B;
# Line 4424  sub _construct_tree ($) { Line 4922  sub _construct_tree ($) {
4922                        caption => 1, table => 1, tbody => 1,                        caption => 1, table => 1, tbody => 1,
4923                        tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,                        tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,
4924                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4925                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4926                                
4927                ## have an element in table scope                ## have an element in table scope
4928                my $i;                my $i;
4929                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4930                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4931                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4932                    $i = $_;                    $i = $_;
4933                    last INSCOPE;                    last INSCOPE;
# Line 4448  sub _construct_tree ($) { Line 4946  sub _construct_tree ($) {
4946                ## As if </select>                ## As if </select>
4947                ## have an element in table scope                ## have an element in table scope
4948                undef $i;                undef $i;
4949                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4950                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4951                  if ($node->[1] eq 'select') {                  if ($node->[1] eq 'select') {
4952                    $i = $_;                    $i = $_;
4953                    last INSCOPE;                    last INSCOPE;
# Line 4460  sub _construct_tree ($) { Line 4958  sub _construct_tree ($) {
4958                  }                  }
4959                } # INSCOPE                } # INSCOPE
4960                unless (defined $i) {                unless (defined $i) {
4961                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:select');
4962                  ## Ignore the </select> token                  ## Ignore the </select> token
4963                  !!!next-token; ## TODO: ok?                  !!!next-token; ## TODO: ok?
4964                  redo B;                  redo B;
4965                }                }
4966                                
4967                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4968    
4969                $reset_insertion_mode->();                $self->_reset_insertion_mode;
4970    
4971                ## reprocess                ## reprocess
4972                redo B;                redo B;
# Line 4479  sub _construct_tree ($) { Line 4977  sub _construct_tree ($) {
4977              #              #
4978            }            }
4979    
4980            !!!parse-error;            !!!parse-error (type => 'in select:'.$token->{tag_name});
4981            ## Ignore the token            ## Ignore the token
4982            !!!next-token;            !!!next-token;
4983            redo B;            redo B;
4984          } elsif ($insertion_mode eq 'after body') {          } elsif ($self->{insertion_mode} eq 'after body') {
4985            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4986              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4987                ## As if in body                ## As if in body
4988                $reconstruct_active_formatting_elements->($insert_to_current);                $reconstruct_active_formatting_elements->($insert_to_current);
4989                                
4990                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4991    
4992                unless (length $token->{data}) {                unless (length $token->{data}) {
4993                  !!!next-token;                  !!!next-token;
# Line 4498  sub _construct_tree ($) { Line 4996  sub _construct_tree ($) {
4996              }              }
4997                            
4998              #              #
4999                !!!parse-error (type => 'after body:#'.$token->{type});
5000            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
5001              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
5002              $open_elements->[0]->[0]->append_child ($comment);              $self->{open_elements}->[0]->[0]->append_child ($comment);
5003              !!!next-token;              !!!next-token;
5004              redo B;              redo B;
5005              } elsif ($token->{type} eq 'start tag') {
5006                !!!parse-error (type => 'after body:'.$token->{tag_name});
5007                #
5008            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
5009              if ($token->{tag_name} eq 'html') {              if ($token->{tag_name} eq 'html') {
5010                ## TODO: if inner_html, parse-error, ignore the token; otherwise,                if (defined $self->{inner_html_node}) {
5011                    !!!parse-error (type => 'unmatched end tag:html');
5012                $phase = 'trailing end';                  ## Ignore the token
5013                !!!next-token;                  !!!next-token;
5014                redo B;                  redo B;
5015                  } else {
5016                    $phase = 'trailing end';
5017                    !!!next-token;
5018                    redo B;
5019                  }
5020              } else {              } else {
5021                #                !!!parse-error (type => 'after body:/'.$token->{tag_name});
5022              }              }
5023            } else {            } else {
5024              #              !!!parse-error (type => 'after body:#'.$token->{type});
5025            }            }
5026    
5027            !!!parse-error ('data after body');            $self->{insertion_mode} = 'in body';
           $insertion_mode = 'in body';  
5028            ## reprocess            ## reprocess
5029            redo B;            redo B;
5030          } elsif ($insertion_mode eq 'in frameset') {          } elsif ($self->{insertion_mode} eq 'in frameset') {
5031            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
5032              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5033                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
5034    
5035                unless (length $token->{data}) {                unless (length $token->{data}) {
5036                  !!!next-token;                  !!!next-token;
# Line 4535  sub _construct_tree ($) { Line 5041  sub _construct_tree ($) {
5041              #              #
5042            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
5043              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
5044              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
5045              !!!next-token;              !!!next-token;
5046              redo B;              redo B;
5047            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 4545  sub _construct_tree ($) { Line 5051  sub _construct_tree ($) {
5051                redo B;                redo B;
5052              } elsif ($token->{tag_name} eq 'frame') {              } elsif ($token->{tag_name} eq 'frame') {
5053                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
5054                pop @$open_elements;                pop @{$self->{open_elements}};
5055                !!!next-token;                !!!next-token;
5056                redo B;                redo B;
5057              } elsif ($token->{tag_name} eq 'noframes') {              } elsif ($token->{tag_name} eq 'noframes') {
# Line 4556  sub _construct_tree ($) { Line 5062  sub _construct_tree ($) {
5062              }              }
5063            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
5064              if ($token->{tag_name} eq 'frameset') {              if ($token->{tag_name} eq 'frameset') {
5065                if ($open_elements->[-1]->[1] eq 'html' and                if ($self->{open_elements}->[-1]->[1] eq 'html' and
5066                    @$open_elements == 1) {                    @{$self->{open_elements}} == 1) {
5067                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
5068                  ## Ignore the token                  ## Ignore the token
5069                  !!!next-token;                  !!!next-token;
5070                } else {                } else {
5071                  pop @$open_elements;                  pop @{$self->{open_elements}};
5072                  !!!next-token;                  !!!next-token;
5073                }                }
5074                                
5075                ## if not inner_html and                ## if not inner_html and
5076                if ($open_elements->[-1]->[1] ne 'frameset') {                if ($self->{open_elements}->[-1]->[1] ne 'frameset') {
5077                  $insertion_mode = 'after frameset';                  $self->{insertion_mode} = 'after frameset';
5078                }                }
5079                redo B;                redo B;
5080              } else {              } else {
# Line 4578  sub _construct_tree ($) { Line 5084  sub _construct_tree ($) {
5084              #              #
5085            }            }
5086                        
5087            !!!parse-error;            if (defined $token->{tag_name}) {
5088                !!!parse-error (type => 'in frameset:'.($token->{type} eq 'end tag' ? '/' : '').$token->{tag_name});
5089              } else {
5090                !!!parse-error (type => 'in frameset:#'.$token->{type});
5091              }
5092            ## Ignore the token            ## Ignore the token
5093            !!!next-token;            !!!next-token;
5094            redo B;            redo B;
5095          } elsif ($insertion_mode eq 'after frameset') {          } elsif ($self->{insertion_mode} eq 'after frameset') {
5096            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
5097              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5098                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
5099    
5100                unless (length $token->{data}) {                unless (length $token->{data}) {
5101                  !!!next-token;                  !!!next-token;
# Line 4596  sub _construct_tree ($) { Line 5106  sub _construct_tree ($) {
5106              #              #
5107            } elsif ($token->{type} eq 'comment') {            } elsif ($token->{type} eq 'comment') {
5108              my $comment = $self->{document}->create_comment ($token->{data});              my $comment = $self->{document}->create_comment ($token->{data});
5109              $open_elements->[-1]->[0]->append_child ($comment);              $self->{open_elements}->[-1]->[0]->append_child ($comment);
5110              !!!next-token;              !!!next-token;
5111              redo B;              redo B;
5112            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
# Line 4618  sub _construct_tree ($) { Line 5128  sub _construct_tree ($) {
5128              #              #
5129            }            }
5130                        
5131            !!!parse-error;            if (defined $token->{tag_name}) {
5132                !!!parse-error (type => 'after frameset:'.($token->{tag_name} eq 'end tag' ? '/' : '').$token->{tag_name});
5133              } else {
5134                !!!parse-error (type => 'after frameset:#'.$token->{type});
5135              }
5136            ## Ignore the token            ## Ignore the token
5137            !!!next-token;            !!!next-token;
5138            redo B;            redo B;
5139    
5140            ## ISSUE: An issue in spec there            ## ISSUE: An issue in spec there
5141          } else {          } else {
5142            die "$0: $insertion_mode: Unknown insertion mode";            die "$0: $self->{insertion_mode}: Unknown insertion mode";
5143          }          }
5144        }        }
5145      } elsif ($phase eq 'trailing end') {      } elsif ($phase eq 'trailing end') {
5146        ## states in the main stage is preserved yet # MUST        ## states in the main stage is preserved yet # MUST
5147                
5148        if ($token->{type} eq 'DOCTYPE') {        if ($token->{type} eq 'DOCTYPE') {
5149          !!!parse-error;          !!!parse-error (type => 'after html:#DOCTYPE');
5150          ## Ignore the token          ## Ignore the token
5151          !!!next-token;          !!!next-token;
5152          redo B;          redo B;
# Line 4651  sub _construct_tree ($) { Line 5165  sub _construct_tree ($) {
5165            $reconstruct_active_formatting_elements->($insert_to_current)            $reconstruct_active_formatting_elements->($insert_to_current)
5166              if $phase eq 'main';              if $phase eq 'main';
5167                        
5168            $open_elements->[-1]->[0]->manakai_append_text ($data);            $self->{open_elements}->[-1]->[0]->manakai_append_text ($data);
5169                        
5170            unless (length $token->{data}) {            unless (length $token->{data}) {
5171              !!!next-token;              !!!next-token;
# Line 4659  sub _construct_tree ($) { Line 5173  sub _construct_tree ($) {
5173            }            }
5174          }          }
5175    
5176          !!!parse-error;          !!!parse-error (type => 'after html:#character');
5177          $phase = 'main';          $phase = 'main';
5178          ## reprocess          ## reprocess
5179          redo B;          redo B;
5180        } elsif ($token->{type} eq 'start tag' or        } elsif ($token->{type} eq 'start tag' or
5181                 $token->{type} eq 'end tag') {                 $token->{type} eq 'end tag') {
5182          !!!parse-error;          !!!parse-error (type => 'after html:'.($token->{type} eq 'end tag' ? '/' : '').$token->{tag_name});
5183          $phase = 'main';          $phase = 'main';
5184          ## reprocess          ## reprocess
5185          redo B;          redo B;
# Line 4681  sub _construct_tree ($) { Line 5195  sub _construct_tree ($) {
5195    ## Stop parsing # MUST    ## Stop parsing # MUST
5196        
5197    ## TODO: script stuffs    ## TODO: script stuffs
5198  } # _construct_tree  } # _tree_construct_main
5199    
5200    sub set_inner_html ($$$) {
5201      my $class = shift;
5202      my $node = shift;
5203      my $s = \$_[0];
5204      my $onerror = $_[1];
5205    
5206      my $nt = $node->node_type;
5207      if ($nt == 9) {
5208        # MUST
5209        
5210        ## Step 1 # MUST
5211        ## TODO: If the document has an active parser, ...
5212        ## ISSUE: There is an issue in the spec.
5213        
5214        ## Step 2 # MUST
5215        my @cn = @{$node->child_nodes};
5216        for (@cn) {
5217          $node->remove_child ($_);
5218        }
5219    
5220        ## Step 3, 4, 5 # MUST
5221        $class->parse_string ($$s => $node, $onerror);
5222      } elsif ($nt == 1) {
5223        ## TODO: If non-html element
5224    
5225        ## NOTE: Most of this code is copied from |parse_string|
5226    
5227        ## Step 1 # MUST
5228        my $this_doc = $node->owner_document;
5229        my $doc = $this_doc->implementation->create_document;
5230        $doc->manakai_is_html (1);
5231        my $p = $class->new;
5232        $p->{document} = $doc;
5233    
5234        ## Step 9 # MUST
5235        my $i = 0;
5236        my $line = 1;
5237        my $column = 0;
5238        $p->{set_next_input_character} = sub {
5239          my $self = shift;
5240    
5241          pop @{$self->{prev_input_character}};
5242          unshift @{$self->{prev_input_character}}, $self->{next_input_character};
5243    
5244          $self->{next_input_character} = -1 and return if $i >= length $$s;
5245          $self->{next_input_character} = ord substr $$s, $i++, 1;
5246          $column++;
5247    
5248          if ($self->{next_input_character} == 0x000A) { # LF
5249            $line++;
5250            $column = 0;
5251          } elsif ($self->{next_input_character} == 0x000D) { # CR
5252            $i++ if substr ($$s, $i, 1) eq "\x0A";
5253            $self->{next_input_character} = 0x000A; # LF # MUST
5254            $line++;
5255            $column = 0;
5256          } elsif ($self->{next_input_character} > 0x10FFFF) {
5257            $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5258          } elsif ($self->{next_input_character} == 0x0000) { # NULL
5259            !!!parse-error (type => 'NULL');
5260            $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5261          }
5262        };
5263        $p->{prev_input_character} = [-1, -1, -1];
5264        $p->{next_input_character} = -1;
5265        
5266        my $ponerror = $onerror || sub {
5267          my (%opt) = @_;
5268          warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n";
5269        };
5270        $p->{parse_error} = sub {
5271          $ponerror->(@_, line => $line, column => $column);
5272        };
5273        
5274        $p->_initialize_tokenizer;
5275        $p->_initialize_tree_constructor;
5276    
5277        ## Step 2
5278        my $node_ln = $node->local_name;
5279        $p->{content_model_flag} = {
5280          title => 'RCDATA',
5281          textarea => 'RCDATA',
5282          style => 'CDATA',
5283          script => 'CDATA',
5284          xmp => 'CDATA',
5285          iframe => 'CDATA',
5286          noembed => 'CDATA',
5287          noframes => 'CDATA',
5288          noscript => 'CDATA',
5289          plaintext => 'PLAINTEXT',
5290        }->{$node_ln} || 'PCDATA';
5291           ## ISSUE: What is "the name of the element"? local name?
5292    
5293        $p->{inner_html_node} = [$node, $node_ln];
5294    
5295        ## Step 4
5296        my $root = $doc->create_element_ns
5297          ('http://www.w3.org/1999/xhtml', [undef, 'html']);
5298    
5299        ## Step 5 # MUST
5300        $doc->append_child ($root);
5301    
5302        ## Step 6 # MUST
5303        push @{$p->{open_elements}}, [$root, 'html'];
5304    
5305        undef $p->{head_element};
5306    
5307        ## Step 7 # MUST
5308        $p->_reset_insertion_mode;
5309    
5310        ## Step 8 # MUST
5311        my $anode = $node;
5312        AN: while (defined $anode) {
5313          if ($anode->node_type == 1) {
5314            my $nsuri = $anode->namespace_uri;
5315            if (defined $nsuri and $nsuri eq 'http://www.w3.org/1999/xhtml') {
5316              if ($anode->local_name eq 'form') { ## TODO: case?
5317                $p->{form_element} = $anode;
5318                last AN;
5319              }
5320            }
5321          }
5322          $anode = $anode->parent_node;
5323        } # AN
5324        
5325        ## Step 3 # MUST
5326        ## Step 10 # MUST
5327        {
5328          my $self = $p;
5329          !!!next-token;
5330        }
5331        $p->_tree_construction_main;
5332    
5333        ## Step 11 # MUST
5334        my @cn = @{$node->child_nodes};
5335        for (@cn) {
5336          $node->remove_child ($_);
5337        }
5338        ## ISSUE: mutation events? read-only?
5339    
5340        ## Step 12 # MUST
5341        @cn = @{$root->child_nodes};
5342        for (@cn) {
5343          $this_doc->adopt_node ($_);
5344          $node->append_child ($_);
5345        }
5346        ## ISSUE: mutation events?
5347    
5348        $p->_terminate_tree_constructor;
5349      } else {
5350        die "$0: |set_inner_html| is not defined for node of type $nt";
5351      }
5352    } # set_inner_html
5353    
5354    } # tree construction stage
5355    
5356  sub get_inner_html ($$$) {  sub get_inner_html ($$$) {
5357    my ($class, $node, $on_error) = @_;    my (undef, $node, $on_error) = @_;
5358    
5359    ## Step 1    ## Step 1
5360    my $s = '';    my $s = '';
# Line 4718  sub get_inner_html ($$$) { Line 5388  sub get_inner_html ($$$) {
5388            
5389      my $nt = $child->node_type;      my $nt = $child->node_type;
5390      if ($nt == 1) { # Element      if ($nt == 1) { # Element
5391        my $tag_name = lc $child->tag_name; ## ISSUE: Definition of "lowercase"        my $tag_name = $child->tag_name; ## TODO: manakai_tag_name
5392        $s .= '<' . $tag_name;        $s .= '<' . $tag_name;
5393          ## NOTE: Non-HTML case:
5394        ## ISSUE: Non-html elements        ## <http://permalink.gmane.org/gmane.org.w3c.whatwg.discuss/11191>
5395    
5396        my @attrs = @{$child->attributes}; # sort order MUST be stable        my @attrs = @{$child->attributes}; # sort order MUST be stable
5397        for my $attr (@attrs) { # order is implementation dependent        for my $attr (@attrs) { # order is implementation dependent
5398          my $attr_name = lc $attr->name; ## ISSUE: Definition of "lowercase"          my $attr_name = $attr->name; ## TODO: manakai_name
5399          $s .= ' ' . $attr_name . '="';          $s .= ' ' . $attr_name . '="';
5400          my $attr_value = $attr->value;          my $attr_value = $attr->value;
5401          ## escape          ## escape
# Line 4744  sub get_inner_html ($$$) { Line 5414  sub get_inner_html ($$$) {
5414          spacer => 1, wbr => 1,          spacer => 1, wbr => 1,
5415        }->{$tag_name};        }->{$tag_name};
5416    
5417          $s .= "\x0A" if $tag_name eq 'pre' or $tag_name eq 'textarea';
5418    
5419        if (not $in_cdata and {        if (not $in_cdata and {
5420          style => 1, script => 1, xmp => 1, iframe => 1,          style => 1, script => 1, xmp => 1, iframe => 1,
5421          noembed => 1, noframes => 1, noscript => 1,          noembed => 1, noframes => 1, noscript => 1,
5422            plaintext => 1,
5423        }->{$tag_name}) {        }->{$tag_name}) {
5424          unshift @node, 'cdata-out';          unshift @node, 'cdata-out';
5425          $in_cdata = 1;          $in_cdata = 1;

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

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24