/[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.13 by wakaba, Sat Jun 23 05:29:48 2007 UTC revision 1.38 by wakaba, Tue Jul 17 13:54:57 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    
 my $entity_char = {  
   AElig => "\x{00C6}",  
   Aacute => "\x{00C1}",  
   Acirc => "\x{00C2}",  
   Agrave => "\x{00C0}",  
   Alpha => "\x{0391}",  
   Aring => "\x{00C5}",  
   Atilde => "\x{00C3}",  
   Auml => "\x{00C4}",  
   Beta => "\x{0392}",  
   Ccedil => "\x{00C7}",  
   Chi => "\x{03A7}",  
   Dagger => "\x{2021}",  
   Delta => "\x{0394}",  
   ETH => "\x{00D0}",  
   Eacute => "\x{00C9}",  
   Ecirc => "\x{00CA}",  
   Egrave => "\x{00C8}",  
   Epsilon => "\x{0395}",  
   Eta => "\x{0397}",  
   Euml => "\x{00CB}",  
   Gamma => "\x{0393}",  
   Iacute => "\x{00CD}",  
   Icirc => "\x{00CE}",  
   Igrave => "\x{00CC}",  
   Iota => "\x{0399}",  
   Iuml => "\x{00CF}",  
   Kappa => "\x{039A}",  
   Lambda => "\x{039B}",  
   Mu => "\x{039C}",  
   Ntilde => "\x{00D1}",  
   Nu => "\x{039D}",  
   OElig => "\x{0152}",  
   Oacute => "\x{00D3}",  
   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}",  
 }; # $entity_char  
   
30  my $c1_entity_char = {  my $c1_entity_char = {
31    0x80 => 0x20AC,    0x80 => 0x20AC,
32    0x81 => 0xFFFD,    0x81 => 0xFFFD,
# Line 361  sub parse_string ($$$;$) { Line 108  sub parse_string ($$$;$) {
108        $line++;        $line++;
109        $column = 0;        $column = 0;
110      } elsif ($self->{next_input_character} == 0x000D) { # CR      } elsif ($self->{next_input_character} == 0x000D) { # CR
111        if ($i >= length $$s) {        $i++ if substr ($$s, $i, 1) eq "\x0A";
         #  
       } else {  
         my $next_char = ord substr $$s, $i++, 1;  
         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++;        $line++;
114        $column = 0;        $column = 0;
# Line 426  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 518  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 597  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 (type => 'unmatched end tag');                    $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 (type => 'unmatched end tag');  
           $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 686  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
# Line 699  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 709  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) {
                $self->{next_input_character} == -1) {  
453          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
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
# Line 726  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 760  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
# Line 773  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 796  sub _get_next_token ($) { Line 537  sub _get_next_token ($) {
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) {
                $self->{next_input_character} == -1) {  
541          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
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
# Line 813  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 827  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 (type => 'dupulicate attribute');            !!!parse-error (type => 'duplicate 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 852  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
# Line 865  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 888  sub _get_next_token ($) { Line 630  sub _get_next_token ($) {
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) {
                $self->{next_input_character} == -1) {  
634          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
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
# Line 906  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 930  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
# Line 943  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 962  sub _get_next_token ($) { Line 705  sub _get_next_token ($) {
705            #            #
706          } else {          } else {
707            !!!parse-error (type => 'nestc');            !!!parse-error (type => 'nestc');
708              ## TODO: Different error type for <aa / bb> than <aa/>
709          }          }
710          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
711          # next-input-character is already done          # next-input-character is already done
712          redo A;          redo A;
713        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
                $self->{next_input_character} == -1) {  
714          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
715          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
716              $self->{current_token}->{first_start_tag}
717                  = not defined $self->{last_emitted_start_tag_name};
718            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
719          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
720            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
# Line 983  sub _get_next_token ($) { Line 728  sub _get_next_token ($) {
728          # reconsume          # reconsume
729    
730          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
731    
732          redo A;          redo A;
733        } else {        } else {
# Line 1016  sub _get_next_token ($) { Line 760  sub _get_next_token ($) {
760          redo A;          redo A;
761        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
762          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
763              $self->{current_token}->{first_start_tag}
764                  = not defined $self->{last_emitted_start_tag_name};
765            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
766          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
767            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
# Line 1029  sub _get_next_token ($) { Line 775  sub _get_next_token ($) {
775          !!!next-input-character;          !!!next-input-character;
776    
777          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
778    
779          redo A;          redo A;
780        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
                $self->{next_input_character} == -1) {  
781          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
782          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
783              $self->{current_token}->{first_start_tag}
784                  = not defined $self->{last_emitted_start_tag_name};
785            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
786          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
787            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
# Line 1049  sub _get_next_token ($) { Line 795  sub _get_next_token ($) {
795          ## reconsume          ## reconsume
796    
797          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
798    
799          redo A;          redo A;
800        } else {        } else {
# Line 1071  sub _get_next_token ($) { Line 816  sub _get_next_token ($) {
816        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
817          !!!parse-error (type => 'unclosed attribute value');          !!!parse-error (type => 'unclosed attribute value');
818          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
819              $self->{current_token}->{first_start_tag}
820                  = not defined $self->{last_emitted_start_tag_name};
821            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
822          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
823            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
# Line 1084  sub _get_next_token ($) { Line 831  sub _get_next_token ($) {
831          ## reconsume          ## reconsume
832    
833          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
834    
835          redo A;          redo A;
836        } else {        } else {
# Line 1106  sub _get_next_token ($) { Line 852  sub _get_next_token ($) {
852        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
853          !!!parse-error (type => 'unclosed attribute value');          !!!parse-error (type => 'unclosed attribute value');
854          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
855              $self->{current_token}->{first_start_tag}
856                  = not defined $self->{last_emitted_start_tag_name};
857            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
858          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
859            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
# Line 1119  sub _get_next_token ($) { Line 867  sub _get_next_token ($) {
867          ## reconsume          ## reconsume
868    
869          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
870    
871          redo A;          redo A;
872        } else {        } else {
# Line 1144  sub _get_next_token ($) { Line 891  sub _get_next_token ($) {
891          redo A;          redo A;
892        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
893          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
894              $self->{current_token}->{first_start_tag}
895                  = not defined $self->{last_emitted_start_tag_name};
896            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
897          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
898            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
# Line 1157  sub _get_next_token ($) { Line 906  sub _get_next_token ($) {
906          !!!next-input-character;          !!!next-input-character;
907    
908          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
909    
910          redo A;          redo A;
911        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
                $self->{next_input_character} == -1) {  
912          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
913          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
914              $self->{current_token}->{first_start_tag}
915                  = not defined $self->{last_emitted_start_tag_name};
916            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
917          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
918            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
# Line 1177  sub _get_next_token ($) { Line 926  sub _get_next_token ($) {
926          ## reconsume          ## reconsume
927    
928          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
929    
930          redo A;          redo A;
931        } else {        } else {
# Line 1187  sub _get_next_token ($) { Line 935  sub _get_next_token ($) {
935          redo A;          redo A;
936        }        }
937      } elsif ($self->{state} eq 'entity in attribute value') {      } elsif ($self->{state} eq 'entity in attribute value') {
938        my $token = $self->_tokenize_attempt_to_consume_an_entity;        my $token = $self->_tokenize_attempt_to_consume_an_entity (1);
939    
940        unless (defined $token) {        unless (defined $token) {
941          $self->{current_attribute}->{value} .= '&';          $self->{current_attribute}->{value} .= '&';
# Line 1236  sub _get_next_token ($) { Line 984  sub _get_next_token ($) {
984          push @next_char, $self->{next_input_character};          push @next_char, $self->{next_input_character};
985          if ($self->{next_input_character} == 0x002D) { # -          if ($self->{next_input_character} == 0x002D) { # -
986            $self->{current_token} = {type => 'comment', data => ''};            $self->{current_token} = {type => 'comment', data => ''};
987            $self->{state} = 'comment';            $self->{state} = 'comment start';
988            !!!next-input-character;            !!!next-input-character;
989            redo A;            redo A;
990          }          }
# Line 1278  sub _get_next_token ($) { Line 1026  sub _get_next_token ($) {
1026          }          }
1027        }        }
1028    
1029        !!!parse-error (type => 'bogus comment open');        !!!parse-error (type => 'bogus comment');
1030        $self->{next_input_character} = shift @next_char;        $self->{next_input_character} = shift @next_char;
1031        !!!back-next-input-character (@next_char);        !!!back-next-input-character (@next_char);
1032        $self->{state} = 'bogus comment';        $self->{state} = 'bogus comment';
# Line 1286  sub _get_next_token ($) { Line 1034  sub _get_next_token ($) {
1034                
1035        ## ISSUE: typos in spec: chacacters, is is a parse error        ## ISSUE: typos in spec: chacacters, is is a parse error
1036        ## 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?
1037        } elsif ($self->{state} eq 'comment start') {
1038          if ($self->{next_input_character} == 0x002D) { # -
1039            $self->{state} = 'comment start dash';
1040            !!!next-input-character;
1041            redo A;
1042          } elsif ($self->{next_input_character} == 0x003E) { # >
1043            !!!parse-error (type => 'bogus comment');
1044            $self->{state} = 'data';
1045            !!!next-input-character;
1046    
1047            !!!emit ($self->{current_token}); # comment
1048    
1049            redo A;
1050          } elsif ($self->{next_input_character} == -1) {
1051            !!!parse-error (type => 'unclosed comment');
1052            $self->{state} = 'data';
1053            ## reconsume
1054    
1055            !!!emit ($self->{current_token}); # comment
1056    
1057            redo A;
1058          } else {
1059            $self->{current_token}->{data} # comment
1060                .= chr ($self->{next_input_character});
1061            $self->{state} = 'comment';
1062            !!!next-input-character;
1063            redo A;
1064          }
1065        } elsif ($self->{state} eq 'comment start dash') {
1066          if ($self->{next_input_character} == 0x002D) { # -
1067            $self->{state} = 'comment end';
1068            !!!next-input-character;
1069            redo A;
1070          } elsif ($self->{next_input_character} == 0x003E) { # >
1071            !!!parse-error (type => 'bogus comment');
1072            $self->{state} = 'data';
1073            !!!next-input-character;
1074    
1075            !!!emit ($self->{current_token}); # comment
1076    
1077            redo A;
1078          } elsif ($self->{next_input_character} == -1) {
1079            !!!parse-error (type => 'unclosed comment');
1080            $self->{state} = 'data';
1081            ## reconsume
1082    
1083            !!!emit ($self->{current_token}); # comment
1084    
1085            redo A;
1086          } else {
1087            $self->{current_token}->{data} # comment
1088                .= '-' . chr ($self->{next_input_character});
1089            $self->{state} = 'comment';
1090            !!!next-input-character;
1091            redo A;
1092          }
1093      } elsif ($self->{state} eq 'comment') {      } elsif ($self->{state} eq 'comment') {
1094        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1095          $self->{state} = 'comment dash';          $self->{state} = 'comment end dash';
1096          !!!next-input-character;          !!!next-input-character;
1097          redo A;          redo A;
1098        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
# Line 1297  sub _get_next_token ($) { Line 1101  sub _get_next_token ($) {
1101          ## reconsume          ## reconsume
1102    
1103          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1104    
1105          redo A;          redo A;
1106        } else {        } else {
# Line 1306  sub _get_next_token ($) { Line 1109  sub _get_next_token ($) {
1109          !!!next-input-character;          !!!next-input-character;
1110          redo A;          redo A;
1111        }        }
1112      } elsif ($self->{state} eq 'comment dash') {      } elsif ($self->{state} eq 'comment end dash') {
1113        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1114          $self->{state} = 'comment end';          $self->{state} = 'comment end';
1115          !!!next-input-character;          !!!next-input-character;
# Line 1317  sub _get_next_token ($) { Line 1120  sub _get_next_token ($) {
1120          ## reconsume          ## reconsume
1121    
1122          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1123    
1124          redo A;          redo A;
1125        } else {        } else {
# Line 1332  sub _get_next_token ($) { Line 1134  sub _get_next_token ($) {
1134          !!!next-input-character;          !!!next-input-character;
1135    
1136          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1137    
1138          redo A;          redo A;
1139        } elsif ($self->{next_input_character} == 0x002D) { # -        } elsif ($self->{next_input_character} == 0x002D) { # -
# Line 1347  sub _get_next_token ($) { Line 1148  sub _get_next_token ($) {
1148          ## reconsume          ## reconsume
1149    
1150          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1151    
1152          redo A;          redo A;
1153        } else {        } else {
# Line 1381  sub _get_next_token ($) { Line 1181  sub _get_next_token ($) {
1181          ## Stay in the state          ## Stay in the state
1182          !!!next-input-character;          !!!next-input-character;
1183          redo A;          redo A;
       } elsif (0x0061 <= $self->{next_input_character} and  
                $self->{next_input_character} <= 0x007A) { # a..z  
 ## ISSUE: "Set the token's name name to the" in the spec  
         $self->{current_token} = {type => 'DOCTYPE',  
                           name => chr ($self->{next_input_character} - 0x0020),  
                           error => 1};  
         $self->{state} = 'DOCTYPE name';  
         !!!next-input-character;  
         redo A;  
1184        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
1185          !!!parse-error (type => 'no DOCTYPE name');          !!!parse-error (type => 'no DOCTYPE name');
1186          $self->{state} = 'data';          $self->{state} = 'data';
1187          !!!next-input-character;          !!!next-input-character;
1188    
1189          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1190    
1191          redo A;          redo A;
1192        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
# Line 1403  sub _get_next_token ($) { Line 1194  sub _get_next_token ($) {
1194          $self->{state} = 'data';          $self->{state} = 'data';
1195          ## reconsume          ## reconsume
1196    
1197          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1198    
1199          redo A;          redo A;
1200        } else {        } else {
1201          $self->{current_token} = {type => 'DOCTYPE',          $self->{current_token}
1202                            name => chr ($self->{next_input_character}),              = {type => 'DOCTYPE',
1203                            error => 1};                 name => chr ($self->{next_input_character}),
1204                   correct => 1};
1205  ## ISSUE: "Set the token's name name to the" in the spec  ## ISSUE: "Set the token's name name to the" in the spec
1206          $self->{state} = 'DOCTYPE name';          $self->{state} = 'DOCTYPE name';
1207          !!!next-input-character;          !!!next-input-character;
1208          redo A;          redo A;
1209        }        }
1210      } elsif ($self->{state} eq 'DOCTYPE name') {      } elsif ($self->{state} eq 'DOCTYPE name') {
1211    ## ISSUE: Redundant "First," in the spec.
1212        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1213            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1214            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
1215            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
1216            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1217          $self->{state} = 'after DOCTYPE name';          $self->{state} = 'after DOCTYPE name';
1218          !!!next-input-character;          !!!next-input-character;
1219          redo A;          redo A;
1220        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1221          $self->{state} = 'data';          $self->{state} = 'data';
1222          !!!next-input-character;          !!!next-input-character;
1223    
1224          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1225    
1226          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;  
1227        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1228          !!!parse-error (type => 'unclosed DOCTYPE');          !!!parse-error (type => 'unclosed DOCTYPE');
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1229          $self->{state} = 'data';          $self->{state} = 'data';
1230          ## reconsume          ## reconsume
1231    
1232          !!!emit ($self->{current_token});          delete $self->{current_token}->{correct};
1233          undef $self->{current_token};          !!!emit ($self->{current_token}); # DOCTYPE
1234    
1235          redo A;          redo A;
1236        } else {        } else {
1237          $self->{current_token}->{name}          $self->{current_token}->{name}
1238            .= chr ($self->{next_input_character}); # DOCTYPE            .= chr ($self->{next_input_character}); # DOCTYPE
         #$self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML');  
1239          ## Stay in the state          ## Stay in the state
1240          !!!next-input-character;          !!!next-input-character;
1241          redo A;          redo A;
# Line 1473  sub _get_next_token ($) { Line 1254  sub _get_next_token ($) {
1254          !!!next-input-character;          !!!next-input-character;
1255    
1256          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1257    
1258          redo A;          redo A;
1259        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
# Line 1481  sub _get_next_token ($) { Line 1261  sub _get_next_token ($) {
1261          $self->{state} = 'data';          $self->{state} = 'data';
1262          ## reconsume          ## reconsume
1263    
1264            delete $self->{current_token}->{correct};
1265            !!!emit ($self->{current_token}); # DOCTYPE
1266    
1267            redo A;
1268          } elsif ($self->{next_input_character} == 0x0050 or # P
1269                   $self->{next_input_character} == 0x0070) { # p
1270            !!!next-input-character;
1271            if ($self->{next_input_character} == 0x0055 or # U
1272                $self->{next_input_character} == 0x0075) { # u
1273              !!!next-input-character;
1274              if ($self->{next_input_character} == 0x0042 or # B
1275                  $self->{next_input_character} == 0x0062) { # b
1276                !!!next-input-character;
1277                if ($self->{next_input_character} == 0x004C or # L
1278                    $self->{next_input_character} == 0x006C) { # l
1279                  !!!next-input-character;
1280                  if ($self->{next_input_character} == 0x0049 or # I
1281                      $self->{next_input_character} == 0x0069) { # i
1282                    !!!next-input-character;
1283                    if ($self->{next_input_character} == 0x0043 or # C
1284                        $self->{next_input_character} == 0x0063) { # c
1285                      $self->{state} = 'before DOCTYPE public identifier';
1286                      !!!next-input-character;
1287                      redo A;
1288                    }
1289                  }
1290                }
1291              }
1292            }
1293    
1294            #
1295          } elsif ($self->{next_input_character} == 0x0053 or # S
1296                   $self->{next_input_character} == 0x0073) { # s
1297            !!!next-input-character;
1298            if ($self->{next_input_character} == 0x0059 or # Y
1299                $self->{next_input_character} == 0x0079) { # y
1300              !!!next-input-character;
1301              if ($self->{next_input_character} == 0x0053 or # S
1302                  $self->{next_input_character} == 0x0073) { # s
1303                !!!next-input-character;
1304                if ($self->{next_input_character} == 0x0054 or # T
1305                    $self->{next_input_character} == 0x0074) { # t
1306                  !!!next-input-character;
1307                  if ($self->{next_input_character} == 0x0045 or # E
1308                      $self->{next_input_character} == 0x0065) { # e
1309                    !!!next-input-character;
1310                    if ($self->{next_input_character} == 0x004D or # M
1311                        $self->{next_input_character} == 0x006D) { # m
1312                      $self->{state} = 'before DOCTYPE system identifier';
1313                      !!!next-input-character;
1314                      redo A;
1315                    }
1316                  }
1317                }
1318              }
1319            }
1320    
1321            #
1322          } else {
1323            !!!next-input-character;
1324            #
1325          }
1326    
1327          !!!parse-error (type => 'string after DOCTYPE name');
1328          $self->{state} = 'bogus DOCTYPE';
1329          # next-input-character is already done
1330          redo A;
1331        } elsif ($self->{state} eq 'before DOCTYPE public identifier') {
1332          if ({
1333                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1334                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1335              }->{$self->{next_input_character}}) {
1336            ## Stay in the state
1337            !!!next-input-character;
1338            redo A;
1339          } elsif ($self->{next_input_character} eq 0x0022) { # "
1340            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1341            $self->{state} = 'DOCTYPE public identifier (double-quoted)';
1342            !!!next-input-character;
1343            redo A;
1344          } elsif ($self->{next_input_character} eq 0x0027) { # '
1345            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1346            $self->{state} = 'DOCTYPE public identifier (single-quoted)';
1347            !!!next-input-character;
1348            redo A;
1349          } elsif ($self->{next_input_character} eq 0x003E) { # >
1350            !!!parse-error (type => 'no PUBLIC literal');
1351    
1352            $self->{state} = 'data';
1353            !!!next-input-character;
1354    
1355            delete $self->{current_token}->{correct};
1356            !!!emit ($self->{current_token}); # DOCTYPE
1357    
1358            redo A;
1359          } elsif ($self->{next_input_character} == -1) {
1360            !!!parse-error (type => 'unclosed DOCTYPE');
1361    
1362            $self->{state} = 'data';
1363            ## reconsume
1364    
1365            delete $self->{current_token}->{correct};
1366            !!!emit ($self->{current_token}); # DOCTYPE
1367    
1368            redo A;
1369          } else {
1370            !!!parse-error (type => 'string after PUBLIC');
1371            $self->{state} = 'bogus DOCTYPE';
1372            !!!next-input-character;
1373            redo A;
1374          }
1375        } elsif ($self->{state} eq 'DOCTYPE public identifier (double-quoted)') {
1376          if ($self->{next_input_character} == 0x0022) { # "
1377            $self->{state} = 'after DOCTYPE public identifier';
1378            !!!next-input-character;
1379            redo A;
1380          } elsif ($self->{next_input_character} == -1) {
1381            !!!parse-error (type => 'unclosed PUBLIC literal');
1382    
1383            $self->{state} = 'data';
1384            ## reconsume
1385    
1386            delete $self->{current_token}->{correct};
1387            !!!emit ($self->{current_token}); # DOCTYPE
1388    
1389            redo A;
1390          } else {
1391            $self->{current_token}->{public_identifier} # DOCTYPE
1392                .= chr $self->{next_input_character};
1393            ## Stay in the state
1394            !!!next-input-character;
1395            redo A;
1396          }
1397        } elsif ($self->{state} eq 'DOCTYPE public identifier (single-quoted)') {
1398          if ($self->{next_input_character} == 0x0027) { # '
1399            $self->{state} = 'after DOCTYPE public identifier';
1400            !!!next-input-character;
1401            redo A;
1402          } elsif ($self->{next_input_character} == -1) {
1403            !!!parse-error (type => 'unclosed PUBLIC literal');
1404    
1405            $self->{state} = 'data';
1406            ## reconsume
1407    
1408            delete $self->{current_token}->{correct};
1409            !!!emit ($self->{current_token}); # DOCTYPE
1410    
1411            redo A;
1412          } else {
1413            $self->{current_token}->{public_identifier} # DOCTYPE
1414                .= chr $self->{next_input_character};
1415            ## Stay in the state
1416            !!!next-input-character;
1417            redo A;
1418          }
1419        } elsif ($self->{state} eq 'after DOCTYPE public identifier') {
1420          if ({
1421                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1422                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1423              }->{$self->{next_input_character}}) {
1424            ## Stay in the state
1425            !!!next-input-character;
1426            redo A;
1427          } elsif ($self->{next_input_character} == 0x0022) { # "
1428            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1429            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1430            !!!next-input-character;
1431            redo A;
1432          } elsif ($self->{next_input_character} == 0x0027) { # '
1433            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1434            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1435            !!!next-input-character;
1436            redo A;
1437          } elsif ($self->{next_input_character} == 0x003E) { # >
1438            $self->{state} = 'data';
1439            !!!next-input-character;
1440    
1441            !!!emit ($self->{current_token}); # DOCTYPE
1442    
1443            redo A;
1444          } elsif ($self->{next_input_character} == -1) {
1445            !!!parse-error (type => 'unclosed DOCTYPE');
1446    
1447            $self->{state} = 'data';
1448            ## reconsume
1449    
1450            delete $self->{current_token}->{correct};
1451            !!!emit ($self->{current_token}); # DOCTYPE
1452    
1453            redo A;
1454          } else {
1455            !!!parse-error (type => 'string after PUBLIC literal');
1456            $self->{state} = 'bogus DOCTYPE';
1457            !!!next-input-character;
1458            redo A;
1459          }
1460        } elsif ($self->{state} eq 'before DOCTYPE system identifier') {
1461          if ({
1462                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1463                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1464              }->{$self->{next_input_character}}) {
1465            ## Stay in the state
1466            !!!next-input-character;
1467            redo A;
1468          } elsif ($self->{next_input_character} == 0x0022) { # "
1469            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1470            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1471            !!!next-input-character;
1472            redo A;
1473          } elsif ($self->{next_input_character} == 0x0027) { # '
1474            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1475            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1476            !!!next-input-character;
1477            redo A;
1478          } elsif ($self->{next_input_character} == 0x003E) { # >
1479            !!!parse-error (type => 'no SYSTEM literal');
1480            $self->{state} = 'data';
1481            !!!next-input-character;
1482    
1483            delete $self->{current_token}->{correct};
1484            !!!emit ($self->{current_token}); # DOCTYPE
1485    
1486            redo A;
1487          } elsif ($self->{next_input_character} == -1) {
1488            !!!parse-error (type => 'unclosed DOCTYPE');
1489    
1490            $self->{state} = 'data';
1491            ## reconsume
1492    
1493            delete $self->{current_token}->{correct};
1494            !!!emit ($self->{current_token}); # DOCTYPE
1495    
1496            redo A;
1497          } else {
1498            !!!parse-error (type => 'string after SYSTEM');
1499            $self->{state} = 'bogus DOCTYPE';
1500            !!!next-input-character;
1501            redo A;
1502          }
1503        } elsif ($self->{state} eq 'DOCTYPE system identifier (double-quoted)') {
1504          if ($self->{next_input_character} == 0x0022) { # "
1505            $self->{state} = 'after DOCTYPE system identifier';
1506            !!!next-input-character;
1507            redo A;
1508          } elsif ($self->{next_input_character} == -1) {
1509            !!!parse-error (type => 'unclosed SYSTEM literal');
1510    
1511            $self->{state} = 'data';
1512            ## reconsume
1513    
1514            delete $self->{current_token}->{correct};
1515            !!!emit ($self->{current_token}); # DOCTYPE
1516    
1517            redo A;
1518          } else {
1519            $self->{current_token}->{system_identifier} # DOCTYPE
1520                .= chr $self->{next_input_character};
1521            ## Stay in the state
1522            !!!next-input-character;
1523            redo A;
1524          }
1525        } elsif ($self->{state} eq 'DOCTYPE system identifier (single-quoted)') {
1526          if ($self->{next_input_character} == 0x0027) { # '
1527            $self->{state} = 'after DOCTYPE system identifier';
1528            !!!next-input-character;
1529            redo A;
1530          } elsif ($self->{next_input_character} == -1) {
1531            !!!parse-error (type => 'unclosed SYSTEM literal');
1532    
1533            $self->{state} = 'data';
1534            ## reconsume
1535    
1536            delete $self->{current_token}->{correct};
1537            !!!emit ($self->{current_token}); # DOCTYPE
1538    
1539            redo A;
1540          } else {
1541            $self->{current_token}->{system_identifier} # DOCTYPE
1542                .= chr $self->{next_input_character};
1543            ## Stay in the state
1544            !!!next-input-character;
1545            redo A;
1546          }
1547        } elsif ($self->{state} eq 'after DOCTYPE system identifier') {
1548          if ({
1549                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1550                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1551              }->{$self->{next_input_character}}) {
1552            ## Stay in the state
1553            !!!next-input-character;
1554            redo A;
1555          } elsif ($self->{next_input_character} == 0x003E) { # >
1556            $self->{state} = 'data';
1557            !!!next-input-character;
1558    
1559            !!!emit ($self->{current_token}); # DOCTYPE
1560    
1561            redo A;
1562          } elsif ($self->{next_input_character} == -1) {
1563            !!!parse-error (type => 'unclosed DOCTYPE');
1564    
1565            $self->{state} = 'data';
1566            ## reconsume
1567    
1568            delete $self->{current_token}->{correct};
1569          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1570    
1571          redo A;          redo A;
1572        } else {        } else {
1573          !!!parse-error (type => 'string after DOCTYPE name');          !!!parse-error (type => 'string after SYSTEM literal');
         $self->{current_token}->{error} = 1; # DOCTYPE  
1574          $self->{state} = 'bogus DOCTYPE';          $self->{state} = 'bogus DOCTYPE';
1575          !!!next-input-character;          !!!next-input-character;
1576          redo A;          redo A;
# Line 1497  sub _get_next_token ($) { Line 1580  sub _get_next_token ($) {
1580          $self->{state} = 'data';          $self->{state} = 'data';
1581          !!!next-input-character;          !!!next-input-character;
1582    
1583            delete $self->{current_token}->{correct};
1584          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1585    
1586          redo A;          redo A;
1587        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
# Line 1506  sub _get_next_token ($) { Line 1589  sub _get_next_token ($) {
1589          $self->{state} = 'data';          $self->{state} = 'data';
1590          ## reconsume          ## reconsume
1591    
1592            delete $self->{current_token}->{correct};
1593          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1594    
1595          redo A;          redo A;
1596        } else {        } else {
# Line 1523  sub _get_next_token ($) { Line 1606  sub _get_next_token ($) {
1606    die "$0: _get_next_token: unexpected case";    die "$0: _get_next_token: unexpected case";
1607  } # _get_next_token  } # _get_next_token
1608    
1609  sub _tokenize_attempt_to_consume_an_entity ($) {  sub _tokenize_attempt_to_consume_an_entity ($$) {
1610    my $self = shift;    my ($self, $in_attr) = @_;
1611      
1612    if ($self->{next_input_character} == 0x0023) { # #    if ({
1613           0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
1614           0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR
1615          }->{$self->{next_input_character}}) {
1616        ## Don't consume
1617        ## No error
1618        return undef;
1619      } elsif ($self->{next_input_character} == 0x0023) { # #
1620      !!!next-input-character;      !!!next-input-character;
1621      if ($self->{next_input_character} == 0x0078 or # x      if ($self->{next_input_character} == 0x0078 or # x
1622          $self->{next_input_character} == 0x0058) { # X          $self->{next_input_character} == 0x0058) { # X
1623        my $num;        my $code;
1624        X: {        X: {
1625          my $x_char = $self->{next_input_character};          my $x_char = $self->{next_input_character};
1626          !!!next-input-character;          !!!next-input-character;
1627          if (0x0030 <= $self->{next_input_character} and          if (0x0030 <= $self->{next_input_character} and
1628              $self->{next_input_character} <= 0x0039) { # 0..9              $self->{next_input_character} <= 0x0039) { # 0..9
1629            $num ||= 0;            $code ||= 0;
1630            $num *= 0x10;            $code *= 0x10;
1631            $num += $self->{next_input_character} - 0x0030;            $code += $self->{next_input_character} - 0x0030;
1632            redo X;            redo X;
1633          } elsif (0x0061 <= $self->{next_input_character} and          } elsif (0x0061 <= $self->{next_input_character} and
1634                   $self->{next_input_character} <= 0x0066) { # a..f                   $self->{next_input_character} <= 0x0066) { # a..f
1635            ## ISSUE: the spec says U+0078, which is apparently incorrect            $code ||= 0;
1636            $num ||= 0;            $code *= 0x10;
1637            $num *= 0x10;            $code += $self->{next_input_character} - 0x0060 + 9;
           $num += $self->{next_input_character} - 0x0060 + 9;  
1638            redo X;            redo X;
1639          } elsif (0x0041 <= $self->{next_input_character} and          } elsif (0x0041 <= $self->{next_input_character} and
1640                   $self->{next_input_character} <= 0x0046) { # A..F                   $self->{next_input_character} <= 0x0046) { # A..F
1641            ## ISSUE: the spec says U+0058, which is apparently incorrect            $code ||= 0;
1642            $num ||= 0;            $code *= 0x10;
1643            $num *= 0x10;            $code += $self->{next_input_character} - 0x0040 + 9;
           $num += $self->{next_input_character} - 0x0040 + 9;  
1644            redo X;            redo X;
1645          } elsif (not defined $num) { # no hexadecimal digit          } elsif (not defined $code) { # no hexadecimal digit
1646            !!!parse-error (type => 'bare hcro');            !!!parse-error (type => 'bare hcro');
1647              !!!back-next-input-character ($x_char, $self->{next_input_character});
1648            $self->{next_input_character} = 0x0023; # #            $self->{next_input_character} = 0x0023; # #
           !!!back-next-input-character ($x_char);  
1649            return undef;            return undef;
1650          } elsif ($self->{next_input_character} == 0x003B) { # ;          } elsif ($self->{next_input_character} == 0x003B) { # ;
1651            !!!next-input-character;            !!!next-input-character;
# Line 1565  sub _tokenize_attempt_to_consume_an_enti Line 1653  sub _tokenize_attempt_to_consume_an_enti
1653            !!!parse-error (type => 'no refc');            !!!parse-error (type => 'no refc');
1654          }          }
1655    
1656          ## TODO: check the definition for |a valid Unicode character|.          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
1657          ## <http://lists.whatwg.org/pipermail/whatwg-whatwg.org/2006-December/thread.html#8189>            !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1658          if ($num > 1114111 or $num == 0) {            $code = 0xFFFD;
1659            $num = 0xFFFD; # REPLACEMENT CHARACTER          } elsif ($code > 0x10FFFF) {
1660            ## ISSUE: Why this is not an error?            !!!parse-error (type => sprintf 'invalid character reference:U-%08X', $code);
1661          } elsif (0x80 <= $num and $num <= 0x9F) {            $code = 0xFFFD;
1662            !!!parse-error (type => sprintf 'c1 entity:U+%04X', $num);          } elsif ($code == 0x000D) {
1663            $num = $c1_entity_char->{$num};            !!!parse-error (type => 'CR character reference');
1664              $code = 0x000A;
1665            } elsif (0x80 <= $code and $code <= 0x9F) {
1666              !!!parse-error (type => sprintf 'C1 character reference:U+%04X', $code);
1667              $code = $c1_entity_char->{$code};
1668          }          }
1669    
1670          return {type => 'character', data => chr $num};          return {type => 'character', data => chr $code};
1671        } # X        } # X
1672      } elsif (0x0030 <= $self->{next_input_character} and      } elsif (0x0030 <= $self->{next_input_character} and
1673               $self->{next_input_character} <= 0x0039) { # 0..9               $self->{next_input_character} <= 0x0039) { # 0..9
# Line 1596  sub _tokenize_attempt_to_consume_an_enti Line 1688  sub _tokenize_attempt_to_consume_an_enti
1688          !!!parse-error (type => 'no refc');          !!!parse-error (type => 'no refc');
1689        }        }
1690    
1691        ## TODO: check the definition for |a valid Unicode character|.        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
1692        if ($code > 1114111 or $code == 0) {          !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1693          $code = 0xFFFD; # REPLACEMENT CHARACTER          $code = 0xFFFD;
1694          ## ISSUE: Why this is not an error?        } elsif ($code > 0x10FFFF) {
1695            !!!parse-error (type => sprintf 'invalid character reference:U-%08X', $code);
1696            $code = 0xFFFD;
1697          } elsif ($code == 0x000D) {
1698            !!!parse-error (type => 'CR character reference');
1699            $code = 0x000A;
1700        } elsif (0x80 <= $code and $code <= 0x9F) {        } elsif (0x80 <= $code and $code <= 0x9F) {
1701          !!!parse-error (type => sprintf 'c1 entity:U+%04X', $code);          !!!parse-error (type => sprintf 'C1 character reference:U+%04X', $code);
1702          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
1703        }        }
1704                
# Line 1620  sub _tokenize_attempt_to_consume_an_enti Line 1717  sub _tokenize_attempt_to_consume_an_enti
1717      !!!next-input-character;      !!!next-input-character;
1718    
1719      my $value = $entity_name;      my $value = $entity_name;
1720      my $match;      my $match = 0;
1721        require Whatpm::_NamedEntityList;
1722        our $EntityChar;
1723    
1724      while (length $entity_name < 10 and      while (length $entity_name < 10 and
1725             ## NOTE: Some number greater than the maximum length of entity name             ## NOTE: Some number greater than the maximum length of entity name
1726             ((0x0041 <= $self->{next_input_character} and             ((0x0041 <= $self->{next_input_character} and # a
1727               $self->{next_input_character} <= 0x005A) or               $self->{next_input_character} <= 0x005A) or # x
1728              (0x0061 <= $self->{next_input_character} and              (0x0061 <= $self->{next_input_character} and # a
1729               $self->{next_input_character} <= 0x007A) or               $self->{next_input_character} <= 0x007A) or # z
1730              (0x0030 <= $self->{next_input_character} and              (0x0030 <= $self->{next_input_character} and # 0
1731               $self->{next_input_character} <= 0x0039))) {               $self->{next_input_character} <= 0x0039) or # 9
1732                $self->{next_input_character} == 0x003B)) { # ;
1733        $entity_name .= chr $self->{next_input_character};        $entity_name .= chr $self->{next_input_character};
1734        if (defined $entity_char->{$entity_name}) {        if (defined $EntityChar->{$entity_name}) {
1735          $value = $entity_char->{$entity_name};          if ($self->{next_input_character} == 0x003B) { # ;
1736          $match = 1;            $value = $EntityChar->{$entity_name};
1737              $match = 1;
1738              !!!next-input-character;
1739              last;
1740            } else {
1741              $value = $EntityChar->{$entity_name};
1742              $match = -1;
1743              !!!next-input-character;
1744            }
1745        } else {        } else {
1746          $value .= chr $self->{next_input_character};          $value .= chr $self->{next_input_character};
1747            $match *= 2;
1748            !!!next-input-character;
1749        }        }
       !!!next-input-character;  
1750      }      }
1751            
1752      if ($match) {      if ($match > 0) {
1753        if ($self->{next_input_character} == 0x003B) { # ;        return {type => 'character', data => $value};
1754          !!!next-input-character;      } elsif ($match < 0) {
1755          !!!parse-error (type => 'no refc');
1756          if ($in_attr and $match < -1) {
1757            return {type => 'character', data => '&'.$entity_name};
1758        } else {        } else {
1759          !!!parse-error (type => 'refc');          return {type => 'character', data => $value};
1760        }        }
   
       return {type => 'character', data => $value};  
1761      } else {      } else {
1762        !!!parse-error (type => 'bare ero');        !!!parse-error (type => 'bare ero');
1763        ## NOTE: No characters are consumed in the spec.        ## NOTE: No characters are consumed in the spec.
1764        !!!back-token ({type => 'character', data => $value});        return {type => 'character', data => '&'.$value};
       return undef;  
1765      }      }
1766    } else {    } else {
1767      ## no characters are consumed      ## no characters are consumed
# Line 1667  sub _initialize_tree_constructor ($) { Line 1776  sub _initialize_tree_constructor ($) {
1776    $self->{document}->strict_error_checking (0);    $self->{document}->strict_error_checking (0);
1777    ## TODO: Turn mutation events off # MUST    ## TODO: Turn mutation events off # MUST
1778    ## TODO: Turn loose Document option (manakai extension) on    ## TODO: Turn loose Document option (manakai extension) on
1779    ## TODO: Mark the Document as an HTML document # MUST    $self->{document}->manakai_is_html (1); # MUST
1780  } # _initialize_tree_constructor  } # _initialize_tree_constructor
1781    
1782  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 1707  sub _construct_tree ($) { Line 1816  sub _construct_tree ($) {
1816    
1817  sub _tree_construction_initial ($) {  sub _tree_construction_initial ($) {
1818    my $self = shift;    my $self = shift;
1819    B: {    INITIAL: {
1820        if ($token->{type} eq 'DOCTYPE') {      if ($token->{type} eq 'DOCTYPE') {
1821          if ($token->{error}) {        ## NOTE: Conformance checkers MAY, instead of reporting "not HTML5"
1822            ## ISSUE: Spec currently left this case undefined.        ## error, switch to a conformance checking mode for another
1823            !!!parse-error (type => 'bogus DOCTYPE');        ## language.
1824          }        my $doctype_name = $token->{name};
1825          my $doctype = $self->{document}->create_document_type_definition        $doctype_name = '' unless defined $doctype_name;
1826            ($token->{name});        $doctype_name =~ tr/a-z/A-Z/;
1827          $self->{document}->append_child ($doctype);        if (not defined $token->{name} or # <!DOCTYPE>
1828          #$phase = 'root element';            defined $token->{public_identifier} or
1829          !!!next-token;            defined $token->{system_identifier}) {
1830          #redo B;          !!!parse-error (type => 'not HTML5');
1831          return;        } elsif ($doctype_name ne 'HTML') {
1832        } elsif ({          ## ISSUE: ASCII case-insensitive? (in fact it does not matter)
1833                  comment => 1,          !!!parse-error (type => 'not HTML5');
1834                  'start tag' => 1,        }
1835                  'end tag' => 1,        
1836                  'end-of-file' => 1,        my $doctype = $self->{document}->create_document_type_definition
1837                 }->{$token->{type}}) {          ($token->{name}); ## ISSUE: If name is missing (e.g. <!DOCTYPE>)?
1838          ## ISSUE: Spec currently left this case undefined.        $doctype->public_id ($token->{public_identifier})
1839          !!!parse-error (type => 'missing DOCTYPE');            if defined $token->{public_identifier};
1840          #$phase = 'root element';        $doctype->system_id ($token->{system_identifier})
1841          ## reprocess            if defined $token->{system_identifier};
1842          #redo B;        ## NOTE: Other DocumentType attributes are null or empty lists.
1843          return;        ## ISSUE: internalSubset = null??
1844        } elsif ($token->{type} eq 'character') {        $self->{document}->append_child ($doctype);
1845          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {        
1846            $self->{document}->manakai_append_text ($1);        if (not $token->{correct} or $doctype_name ne 'HTML') {
1847            ## ISSUE: DOM3 Core does not allow Document > Text          $self->{document}->manakai_compat_mode ('quirks');
1848            unless (length $token->{data}) {        } elsif (defined $token->{public_identifier}) {
1849              ## Stay in the phase          my $pubid = $token->{public_identifier};
1850              !!!next-token;          $pubid =~ tr/a-z/A-z/;
1851              redo B;          if ({
1852              "+//SILMARIL//DTD HTML PRO V0R11 19970101//EN" => 1,
1853              "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1854              "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1855              "-//IETF//DTD HTML 2.0 LEVEL 1//EN" => 1,
1856              "-//IETF//DTD HTML 2.0 LEVEL 2//EN" => 1,
1857              "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//EN" => 1,
1858              "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//EN" => 1,
1859              "-//IETF//DTD HTML 2.0 STRICT//EN" => 1,
1860              "-//IETF//DTD HTML 2.0//EN" => 1,
1861              "-//IETF//DTD HTML 2.1E//EN" => 1,
1862              "-//IETF//DTD HTML 3.0//EN" => 1,
1863              "-//IETF//DTD HTML 3.0//EN//" => 1,
1864              "-//IETF//DTD HTML 3.2 FINAL//EN" => 1,
1865              "-//IETF//DTD HTML 3.2//EN" => 1,
1866              "-//IETF//DTD HTML 3//EN" => 1,
1867              "-//IETF//DTD HTML LEVEL 0//EN" => 1,
1868              "-//IETF//DTD HTML LEVEL 0//EN//2.0" => 1,
1869              "-//IETF//DTD HTML LEVEL 1//EN" => 1,
1870              "-//IETF//DTD HTML LEVEL 1//EN//2.0" => 1,
1871              "-//IETF//DTD HTML LEVEL 2//EN" => 1,
1872              "-//IETF//DTD HTML LEVEL 2//EN//2.0" => 1,
1873              "-//IETF//DTD HTML LEVEL 3//EN" => 1,
1874              "-//IETF//DTD HTML LEVEL 3//EN//3.0" => 1,
1875              "-//IETF//DTD HTML STRICT LEVEL 0//EN" => 1,
1876              "-//IETF//DTD HTML STRICT LEVEL 0//EN//2.0" => 1,
1877              "-//IETF//DTD HTML STRICT LEVEL 1//EN" => 1,
1878              "-//IETF//DTD HTML STRICT LEVEL 1//EN//2.0" => 1,
1879              "-//IETF//DTD HTML STRICT LEVEL 2//EN" => 1,
1880              "-//IETF//DTD HTML STRICT LEVEL 2//EN//2.0" => 1,
1881              "-//IETF//DTD HTML STRICT LEVEL 3//EN" => 1,
1882              "-//IETF//DTD HTML STRICT LEVEL 3//EN//3.0" => 1,
1883              "-//IETF//DTD HTML STRICT//EN" => 1,
1884              "-//IETF//DTD HTML STRICT//EN//2.0" => 1,
1885              "-//IETF//DTD HTML STRICT//EN//3.0" => 1,
1886              "-//IETF//DTD HTML//EN" => 1,
1887              "-//IETF//DTD HTML//EN//2.0" => 1,
1888              "-//IETF//DTD HTML//EN//3.0" => 1,
1889              "-//METRIUS//DTD METRIUS PRESENTATIONAL//EN" => 1,
1890              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//EN" => 1,
1891              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//EN" => 1,
1892              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//EN" => 1,
1893              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//EN" => 1,
1894              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//EN" => 1,
1895              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//EN" => 1,
1896              "-//NETSCAPE COMM. CORP.//DTD HTML//EN" => 1,
1897              "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//EN" => 1,
1898              "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//EN" => 1,
1899              "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//EN" => 1,
1900              "-//SPYGLASS//DTD HTML 2.0 EXTENDED//EN" => 1,
1901              "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//EN" => 1,
1902              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//EN" => 1,
1903              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//EN" => 1,
1904              "-//W3C//DTD HTML 3 1995-03-24//EN" => 1,
1905              "-//W3C//DTD HTML 3.2 DRAFT//EN" => 1,
1906              "-//W3C//DTD HTML 3.2 FINAL//EN" => 1,
1907              "-//W3C//DTD HTML 3.2//EN" => 1,
1908              "-//W3C//DTD HTML 3.2S DRAFT//EN" => 1,
1909              "-//W3C//DTD HTML 4.0 FRAMESET//EN" => 1,
1910              "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN" => 1,
1911              "-//W3C//DTD HTML EXPERIMETNAL 19960712//EN" => 1,
1912              "-//W3C//DTD HTML EXPERIMENTAL 970421//EN" => 1,
1913              "-//W3C//DTD W3 HTML//EN" => 1,
1914              "-//W3O//DTD W3 HTML 3.0//EN" => 1,
1915              "-//W3O//DTD W3 HTML 3.0//EN//" => 1,
1916              "-//W3O//DTD W3 HTML STRICT 3.0//EN//" => 1,
1917              "-//WEBTECHS//DTD MOZILLA HTML 2.0//EN" => 1,
1918              "-//WEBTECHS//DTD MOZILLA HTML//EN" => 1,
1919              "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" => 1,
1920              "HTML" => 1,
1921            }->{$pubid}) {
1922              $self->{document}->manakai_compat_mode ('quirks');
1923            } elsif ($pubid eq "-//W3C//DTD HTML 4.01 FRAMESET//EN" or
1924                     $pubid eq "-//W3C//DTD HTML 4.01 TRANSITIONAL//EN") {
1925              if (defined $token->{system_identifier}) {
1926                $self->{document}->manakai_compat_mode ('quirks');
1927              } else {
1928                $self->{document}->manakai_compat_mode ('limited quirks');
1929            }            }
1930            } elsif ($pubid eq "-//W3C//DTD XHTML 1.0 Frameset//EN" or
1931                     $pubid eq "-//W3C//DTD XHTML 1.0 Transitional//EN") {
1932              $self->{document}->manakai_compat_mode ('limited quirks');
1933            }
1934          }
1935          if (defined $token->{system_identifier}) {
1936            my $sysid = $token->{system_identifier};
1937            $sysid =~ tr/A-Z/a-z/;
1938            if ($sysid eq "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd") {
1939              $self->{document}->manakai_compat_mode ('quirks');
1940            }
1941          }
1942          
1943          ## Go to the root element phase.
1944          !!!next-token;
1945          return;
1946        } elsif ({
1947                  'start tag' => 1,
1948                  'end tag' => 1,
1949                  'end-of-file' => 1,
1950                 }->{$token->{type}}) {
1951          !!!parse-error (type => 'no DOCTYPE');
1952          $self->{document}->manakai_compat_mode ('quirks');
1953          ## Go to the root element phase
1954          ## reprocess
1955          return;
1956        } elsif ($token->{type} eq 'character') {
1957          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
1958            ## Ignore the token
1959    
1960            unless (length $token->{data}) {
1961              ## Stay in the phase
1962              !!!next-token;
1963              redo INITIAL;
1964          }          }
         ## ISSUE: Spec currently left this case undefined.  
         !!!parse-error (type => 'missing DOCTYPE');  
         #$phase = 'root element';  
         ## reprocess  
         #redo B;  
         return;  
       } else {  
         die "$0: $token->{type}: Unknown token";  
1965        }        }
1966      } # B  
1967          !!!parse-error (type => 'no DOCTYPE');
1968          $self->{document}->manakai_compat_mode ('quirks');
1969          ## Go to the root element phase
1970          ## reprocess
1971          return;
1972        } elsif ($token->{type} eq 'comment') {
1973          my $comment = $self->{document}->create_comment ($token->{data});
1974          $self->{document}->append_child ($comment);
1975          
1976          ## Stay in the phase.
1977          !!!next-token;
1978          redo INITIAL;
1979        } else {
1980          die "$0: $token->{type}: Unknown token";
1981        }
1982      } # INITIAL
1983  } # _tree_construction_initial  } # _tree_construction_initial
1984    
1985  sub _tree_construction_root_element ($) {  sub _tree_construction_root_element ($) {
# Line 1771  sub _tree_construction_root_element ($) Line 1999  sub _tree_construction_root_element ($)
1999          !!!next-token;          !!!next-token;
2000          redo B;          redo B;
2001        } elsif ($token->{type} eq 'character') {        } elsif ($token->{type} eq 'character') {
2002          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
2003            $self->{document}->manakai_append_text ($1);            ## Ignore the token.
2004            ## ISSUE: DOM3 Core does not allow Document > Text  
2005            unless (length $token->{data}) {            unless (length $token->{data}) {
2006              ## Stay in the phase              ## Stay in the phase
2007              !!!next-token;              !!!next-token;
# Line 1794  sub _tree_construction_root_element ($) Line 2022  sub _tree_construction_root_element ($)
2022        my $root_element; !!!create-element ($root_element, 'html');        my $root_element; !!!create-element ($root_element, 'html');
2023        $self->{document}->append_child ($root_element);        $self->{document}->append_child ($root_element);
2024        push @{$self->{open_elements}}, [$root_element, 'html'];        push @{$self->{open_elements}}, [$root_element, 'html'];
       #$phase = 'main';  
2025        ## reprocess        ## reprocess
2026        #redo B;        #redo B;
2027        return;        return; ## Go to the main phase.
2028    } # B    } # B
2029  } # _tree_construction_root_element  } # _tree_construction_root_element
2030    
# Line 1813  sub _reset_insertion_mode ($) { Line 2040  sub _reset_insertion_mode ($) {
2040            
2041      ## Step 3      ## Step 3
2042      S3: {      S3: {
2043        $last = 1 if $self->{open_elements}->[0]->[0] eq $node->[0];        ## ISSUE: Oops! "If node is the first node in the stack of open
2044        if (defined $self->{inner_html_node}) {        ## elements, then set last to true. If the context element of the
2045          if ($self->{inner_html_node}->[1] eq 'td' or        ## HTML fragment parsing algorithm is neither a td element nor a
2046              $self->{inner_html_node}->[1] eq 'th') {        ## th element, then set node to the context element. (fragment case)":
2047            #        ## The second "if" is in the scope of the first "if"!?
2048          } else {        if ($self->{open_elements}->[0]->[0] eq $node->[0]) {
2049            $node = $self->{inner_html_node};          $last = 1;
2050            if (defined $self->{inner_html_node}) {
2051              if ($self->{inner_html_node}->[1] eq 'td' or
2052                  $self->{inner_html_node}->[1] eq 'th') {
2053                #
2054              } else {
2055                $node = $self->{inner_html_node};
2056              }
2057          }          }
2058        }        }
2059            
# Line 1866  sub _reset_insertion_mode ($) { Line 2100  sub _reset_insertion_mode ($) {
2100  sub _tree_construction_main ($) {  sub _tree_construction_main ($) {
2101    my $self = shift;    my $self = shift;
2102    
2103    my $phase = 'main';    my $previous_insertion_mode;
2104    
2105    my $active_formatting_elements = [];    my $active_formatting_elements = [];
2106    
# Line 1950  sub _tree_construction_main ($) { Line 2184  sub _tree_construction_main ($) {
2184      }      }
2185    }; # $clear_up_to_marker    }; # $clear_up_to_marker
2186    
2187    my $style_start_tag = sub {    my $parse_rcdata = sub ($$) {
2188      my $style_el; !!!create-element ($style_el, 'style', $token->{attributes});      my ($content_model_flag, $insert) = @_;
2189      ## $self->{insertion_mode} eq 'in head' and ... (always true)  
2190      (($self->{insertion_mode} eq 'in head' and defined $self->{head_element})      ## Step 1
2191       ? $self->{head_element} : $self->{open_elements}->[-1]->[0])      my $start_tag_name = $token->{tag_name};
2192        ->append_child ($style_el);      my $el;
2193      $self->{content_model_flag} = 'CDATA';      !!!create-element ($el, $start_tag_name, $token->{attributes});
2194    
2195        ## Step 2
2196        $insert->($el); # /context node/->append_child ($el)
2197    
2198        ## Step 3
2199        $self->{content_model_flag} = $content_model_flag; # CDATA or RCDATA
2200      delete $self->{escape}; # MUST      delete $self->{escape}; # MUST
2201                  
2202        ## Step 4
2203      my $text = '';      my $text = '';
2204      !!!next-token;      !!!next-token;
2205      while ($token->{type} eq 'character') {      while ($token->{type} eq 'character') { # or until stop tokenizing
2206        $text .= $token->{data};        $text .= $token->{data};
2207        !!!next-token;        !!!next-token;
2208      } # stop if non-character token or tokenizer stops tokenising      }
2209    
2210        ## Step 5
2211      if (length $text) {      if (length $text) {
2212        $style_el->manakai_append_text ($text);        my $text = $self->{document}->create_text_node ($text);
2213          $el->append_child ($text);
2214      }      }
2215        
2216        ## Step 6
2217      $self->{content_model_flag} = 'PCDATA';      $self->{content_model_flag} = 'PCDATA';
2218                  
2219      if ($token->{type} eq 'end tag' and $token->{tag_name} eq 'style') {      ## Step 7
2220        if ($token->{type} eq 'end tag' and $token->{tag_name} eq $start_tag_name) {
2221        ## Ignore the token        ## Ignore the token
2222      } else {      } else {
2223        !!!parse-error (type => 'in CDATA:#'.$token->{type});        !!!parse-error (type => 'in '.$content_model_flag.':#'.$token->{type});
       ## ISSUE: And ignore?  
2224      }      }
2225      !!!next-token;      !!!next-token;
2226    }; # $style_start_tag    }; # $parse_rcdata
2227    
2228    my $script_start_tag = sub {    my $script_start_tag = sub ($) {
2229        my $insert = $_[0];
2230      my $script_el;      my $script_el;
2231      !!!create-element ($script_el, 'script', $token->{attributes});      !!!create-element ($script_el, 'script', $token->{attributes});
2232      ## TODO: mark as "parser-inserted"      ## TODO: mark as "parser-inserted"
# Line 2014  sub _tree_construction_main ($) { Line 2260  sub _tree_construction_main ($) {
2260      } else {      } else {
2261        ## TODO: $old_insertion_point = current insertion point        ## TODO: $old_insertion_point = current insertion point
2262        ## TODO: insertion point = just before the next input character        ## TODO: insertion point = just before the next input character
2263          
2264        (($self->{insertion_mode} eq 'in head' and defined $self->{head_element})        $insert->($script_el);
        ? $self->{head_element} : $self->{open_elements}->[-1]->[0])->append_child ($script_el);  
2265                
2266        ## TODO: insertion point = $old_insertion_point (might be "undefined")        ## TODO: insertion point = $old_insertion_point (might be "undefined")
2267                
# Line 2210  sub _tree_construction_main ($) { Line 2455  sub _tree_construction_main ($) {
2455    }; # $formatting_end_tag    }; # $formatting_end_tag
2456    
2457    my $insert_to_current = sub {    my $insert_to_current = sub {
2458      $self->{open_elements}->[-1]->[0]->append_child (shift);      $self->{open_elements}->[-1]->[0]->append_child ($_[0]);
2459    }; # $insert_to_current    }; # $insert_to_current
2460    
2461    my $insert_to_foster = sub {    my $insert_to_foster = sub {
# Line 2248  sub _tree_construction_main ($) { Line 2493  sub _tree_construction_main ($) {
2493      my $insert = shift;      my $insert = shift;
2494      if ($token->{type} eq 'start tag') {      if ($token->{type} eq 'start tag') {
2495        if ($token->{tag_name} eq 'script') {        if ($token->{tag_name} eq 'script') {
2496          $script_start_tag->();          ## NOTE: This is an "as if in head" code clone
2497            $script_start_tag->($insert);
2498          return;          return;
2499        } elsif ($token->{tag_name} eq 'style') {        } elsif ($token->{tag_name} eq 'style') {
2500          $style_start_tag->();          ## NOTE: This is an "as if in head" code clone
2501            $parse_rcdata->('CDATA', $insert);
2502          return;          return;
2503        } elsif ({        } elsif ({
2504                  base => 1, link => 1, meta => 1,                  base => 1, link => 1,
2505                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2506          !!!parse-error (type => 'in body:'.$token->{tag_name});          ## NOTE: This is an "as if in head" code clone, only "-t" differs
2507          ## NOTE: This is an "as if in head" code clone          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2508          my $el;          pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
2509          !!!create-element ($el, $token->{tag_name}, $token->{attributes});          !!!next-token;
2510          if (defined $self->{head_element}) {          return;
2511            $self->{head_element}->append_child ($el);        } elsif ($token->{tag_name} eq 'meta') {
2512          } else {          ## NOTE: This is an "as if in head" code clone, only "-t" differs
2513            $insert->($el);          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2514            pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
2515    
2516            unless ($self->{confident}) {
2517              my $charset;
2518              if ($token->{attributes}->{charset}) { ## TODO: And if supported
2519                $charset = $token->{attributes}->{charset}->{value};
2520              }
2521              if ($token->{attributes}->{'http-equiv'}) {
2522                ## ISSUE: Algorithm name in the spec was incorrect so that not linked to the definition.
2523                if ($token->{attributes}->{'http-equiv'}->{value}
2524                    =~ /\A[^;]*;[\x09-\x0D\x20]*charset[\x09-\x0D\x20]*=
2525                        [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|
2526                        ([^"'\x09-\x0D\x20][^\x09-\x0D\x20]*))/x) {
2527                  $charset = defined $1 ? $1 : defined $2 ? $2 : $3;
2528                } ## TODO: And if supported
2529              }
2530              ## TODO: Change the encoding
2531          }          }
2532            
2533          !!!next-token;          !!!next-token;
2534          return;          return;
2535        } elsif ($token->{tag_name} eq 'title') {        } elsif ($token->{tag_name} eq 'title') {
2536          !!!parse-error (type => 'in body:title');          !!!parse-error (type => 'in body:title');
2537          ## NOTE: There is an "as if in head" code clone          ## NOTE: This is an "as if in head" code clone
2538          my $title_el;          $parse_rcdata->('RCDATA', sub {
2539          !!!create-element ($title_el, 'title', $token->{attributes});            if (defined $self->{head_element}) {
2540          (defined $self->{head_element} ? $self->{head_element} : $self->{open_elements}->[-1]->[0])              $self->{head_element}->append_child ($_[0]);
2541            ->append_child ($title_el);            } else {
2542          $self->{content_model_flag} = 'RCDATA';              $insert->($_[0]);
2543          delete $self->{escape}; # MUST            }
2544                    });
         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 (type => 'in RCDATA:#'.$token->{type});  
           ## ISSUE: And ignore?  
         }  
         !!!next-token;  
2545          return;          return;
2546        } elsif ($token->{tag_name} eq 'body') {        } elsif ($token->{tag_name} eq 'body') {
2547          !!!parse-error (type => 'in body:body');          !!!parse-error (type => 'in body:body');
# Line 2400  sub _tree_construction_main ($) { Line 2644  sub _tree_construction_main ($) {
2644              if ($i != -1) {              if ($i != -1) {
2645                !!!parse-error (type => 'end tag missing:'.                !!!parse-error (type => 'end tag missing:'.
2646                                $self->{open_elements}->[-1]->[1]);                                $self->{open_elements}->[-1]->[1]);
               ## TODO: test  
2647              }              }
2648              splice @{$self->{open_elements}}, $i;              splice @{$self->{open_elements}}, $i;
2649              last LI;              last LI;
# Line 2448  sub _tree_construction_main ($) { Line 2691  sub _tree_construction_main ($) {
2691              if ($i != -1) {              if ($i != -1) {
2692                !!!parse-error (type => 'end tag missing:'.                !!!parse-error (type => 'end tag missing:'.
2693                                $self->{open_elements}->[-1]->[1]);                                $self->{open_elements}->[-1]->[1]);
               ## TODO: test  
2694              }              }
2695              splice @{$self->{open_elements}}, $i;              splice @{$self->{open_elements}}, $i;
2696              last LI;              last LI;
# Line 2511  sub _tree_construction_main ($) { Line 2753  sub _tree_construction_main ($) {
2753            }            }
2754          } # INSCOPE          } # INSCOPE
2755                        
2756            ## NOTE: See <http://html5.org/tools/web-apps-tracker?from=925&to=926>
2757          ## has an element in scope          ## has an element in scope
2758          my $i;          #my $i;
2759          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {          #INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2760            my $node = $self->{open_elements}->[$_];          #  my $node = $self->{open_elements}->[$_];
2761            if ({          #  if ({
2762                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,          #       h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
2763                }->{$node->[1]}) {          #      }->{$node->[1]}) {
2764              $i = $_;          #    $i = $_;
2765              last INSCOPE;          #    last INSCOPE;
2766            } elsif ({          #  } elsif ({
2767                      table => 1, caption => 1, td => 1, th => 1,          #            table => 1, caption => 1, td => 1, th => 1,
2768                      button => 1, marquee => 1, object => 1, html => 1,          #            button => 1, marquee => 1, object => 1, html => 1,
2769                     }->{$node->[1]}) {          #           }->{$node->[1]}) {
2770              last INSCOPE;          #    last INSCOPE;
2771            }          #  }
2772          } # INSCOPE          #} # INSCOPE
2773                      #  
2774          if (defined $i) {          #if (defined $i) {
2775            !!!parse-error (type => 'in hn:hn');          #  !!! parse-error (type => 'in hn:hn');
2776            splice @{$self->{open_elements}}, $i;          #  splice @{$self->{open_elements}}, $i;
2777          }          #}
2778                        
2779          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2780                        
# Line 2574  sub _tree_construction_main ($) { Line 2817  sub _tree_construction_main ($) {
2817          return;          return;
2818        } elsif ({        } elsif ({
2819                  b => 1, big => 1, em => 1, font => 1, i => 1,                  b => 1, big => 1, em => 1, font => 1, i => 1,
2820                  nobr => 1, s => 1, small => 1, strile => 1,                  s => 1, small => 1, strile => 1,
2821                  strong => 1, tt => 1, u => 1,                  strong => 1, tt => 1, u => 1,
2822                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2823          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
# Line 2584  sub _tree_construction_main ($) { Line 2827  sub _tree_construction_main ($) {
2827                    
2828          !!!next-token;          !!!next-token;
2829          return;          return;
2830          } elsif ($token->{tag_name} eq 'nobr') {
2831            $reconstruct_active_formatting_elements->($insert_to_current);
2832    
2833            ## has a |nobr| element in scope
2834            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2835              my $node = $self->{open_elements}->[$_];
2836              if ($node->[1] eq 'nobr') {
2837                !!!parse-error (type => 'not closed:nobr');
2838                !!!back-token;
2839                $token = {type => 'end tag', tag_name => 'nobr'};
2840                return;
2841              } elsif ({
2842                        table => 1, caption => 1, td => 1, th => 1,
2843                        button => 1, marquee => 1, object => 1, html => 1,
2844                       }->{$node->[1]}) {
2845                last INSCOPE;
2846              }
2847            } # INSCOPE
2848            
2849            !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2850            push @$active_formatting_elements, $self->{open_elements}->[-1];
2851            
2852            !!!next-token;
2853            return;
2854        } elsif ($token->{tag_name} eq 'button') {        } elsif ($token->{tag_name} eq 'button') {
2855          ## has a button element in scope          ## has a button element in scope
2856          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
# Line 2619  sub _tree_construction_main ($) { Line 2886  sub _tree_construction_main ($) {
2886          return;          return;
2887        } elsif ($token->{tag_name} eq 'xmp') {        } elsif ($token->{tag_name} eq 'xmp') {
2888          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2889                    $parse_rcdata->('CDATA', $insert);
         !!!insert-element-t ($token->{tag_name}, $token->{attributes});  
           
         $self->{content_model_flag} = 'CDATA';  
         delete $self->{escape}; # MUST  
           
         !!!next-token;  
2890          return;          return;
2891        } elsif ($token->{tag_name} eq 'table') {        } elsif ($token->{tag_name} eq 'table') {
2892          ## has a p element in scope          ## has a p element in scope
# Line 2657  sub _tree_construction_main ($) { Line 2918  sub _tree_construction_main ($) {
2918            !!!parse-error (type => 'image');            !!!parse-error (type => 'image');
2919            $token->{tag_name} = 'img';            $token->{tag_name} = 'img';
2920          }          }
2921            
2922            ## NOTE: There is an "as if <br>" code clone.
2923          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2924                    
2925          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
# Line 2703  sub _tree_construction_main ($) { Line 2965  sub _tree_construction_main ($) {
2965            return;            return;
2966          } else {          } else {
2967            my $at = $token->{attributes};            my $at = $token->{attributes};
2968              my $form_attrs;
2969              $form_attrs->{action} = $at->{action} if $at->{action};
2970              my $prompt_attr = $at->{prompt};
2971            $at->{name} = {name => 'name', value => 'isindex'};            $at->{name} = {name => 'name', value => 'isindex'};
2972              delete $at->{action};
2973              delete $at->{prompt};
2974            my @tokens = (            my @tokens = (
2975                          {type => 'start tag', tag_name => 'form'},                          {type => 'start tag', tag_name => 'form',
2976                             attributes => $form_attrs},
2977                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2978                          {type => 'start tag', tag_name => 'p'},                          {type => 'start tag', tag_name => 'p'},
2979                          {type => 'start tag', tag_name => 'label'},                          {type => 'start tag', tag_name => 'label'},
2980                          {type => 'character',                         );
2981                           data => 'This is a searchable index. Insert your search keywords here: '}, # SHOULD            if ($prompt_attr) {
2982                          ## TODO: make this configurable              push @tokens, {type => 'character', data => $prompt_attr->{value}};
2983              } else {
2984                push @tokens, {type => 'character',
2985                               data => 'This is a searchable index. Insert your search keywords here: '}; # SHOULD
2986                ## TODO: make this configurable
2987              }
2988              push @tokens,
2989                          {type => 'start tag', tag_name => 'input', attributes => $at},                          {type => 'start tag', tag_name => 'input', attributes => $at},
2990                          #{type => 'character', data => ''}, # SHOULD                          #{type => 'character', data => ''}, # SHOULD
2991                          {type => 'end tag', tag_name => 'label'},                          {type => 'end tag', tag_name => 'label'},
2992                          {type => 'end tag', tag_name => 'p'},                          {type => 'end tag', tag_name => 'p'},
2993                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2994                          {type => 'end tag', tag_name => 'form'},                          {type => 'end tag', tag_name => 'form'};
                        );  
2995            $token = shift @tokens;            $token = shift @tokens;
2996            !!!back-token (@tokens);            !!!back-token (@tokens);
2997            return;            return;
2998          }          }
2999        } elsif ({        } elsif ($token->{tag_name} eq 'textarea') {
                 textarea => 1,  
                 iframe => 1,  
                 noembed => 1,  
                 noframes => 1,  
                 noscript => 0, ## TODO: 1 if scripting is enabled  
                }->{$token->{tag_name}}) {  
3000          my $tag_name = $token->{tag_name};          my $tag_name = $token->{tag_name};
3001          my $el;          my $el;
3002          !!!create-element ($el, $token->{tag_name}, $token->{attributes});          !!!create-element ($el, $token->{tag_name}, $token->{attributes});
3003                    
3004          if ($token->{tag_name} eq 'textarea') {          ## TODO: $self->{form_element} if defined
3005            ## TODO: $self->{form_element} if defined          $self->{content_model_flag} = 'RCDATA';
           $self->{content_model_flag} = 'RCDATA';  
         } else {  
           $self->{content_model_flag} = 'CDATA';  
         }  
3006          delete $self->{escape}; # MUST          delete $self->{escape}; # MUST
3007                    
3008          $insert->($el);          $insert->($el);
3009                    
3010          my $text = '';          my $text = '';
3011          if ($token->{tag_name} eq 'textarea') {          !!!next-token;
3012            !!!next-token;          if ($token->{type} eq 'character') {
3013            if ($token->{type} eq 'character') {            $token->{data} =~ s/^\x0A//;
3014              $token->{data} =~ s/^\x0A//;            unless (length $token->{data}) {
3015              unless (length $token->{data}) {              !!!next-token;
               !!!next-token;  
             }  
3016            }            }
         } else {  
           !!!next-token;  
3017          }          }
3018          while ($token->{type} eq 'character') {          while ($token->{type} eq 'character') {
3019            $text .= $token->{data};            $text .= $token->{data};
# Line 2770  sub _tree_construction_main ($) { Line 3029  sub _tree_construction_main ($) {
3029              $token->{tag_name} eq $tag_name) {              $token->{tag_name} eq $tag_name) {
3030            ## Ignore the token            ## Ignore the token
3031          } else {          } else {
3032            if ($token->{tag_name} eq 'textarea') {            !!!parse-error (type => 'in RCDATA:#'.$token->{type});
             !!!parse-error (type => 'in RCDATA:#'.$token->{type});  
           } else {  
             !!!parse-error (type => 'in CDATA:#'.$token->{type});  
           }  
           ## ISSUE: And ignore?  
3033          }          }
3034          !!!next-token;          !!!next-token;
3035          return;          return;
3036          } elsif ({
3037                    iframe => 1,
3038                    noembed => 1,
3039                    noframes => 1,
3040                    noscript => 0, ## TODO: 1 if scripting is enabled
3041                   }->{$token->{tag_name}}) {
3042            $parse_rcdata->('CDATA', $insert);
3043            return;
3044        } elsif ($token->{tag_name} eq 'select') {        } elsif ($token->{tag_name} eq 'select') {
3045          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
3046                    
# Line 2809  sub _tree_construction_main ($) { Line 3071  sub _tree_construction_main ($) {
3071        }        }
3072      } elsif ($token->{type} eq 'end tag') {      } elsif ($token->{type} eq 'end tag') {
3073        if ($token->{tag_name} eq 'body') {        if ($token->{tag_name} eq 'body') {
3074          if (@{$self->{open_elements}} > 1 and $self->{open_elements}->[1]->[1] eq 'body') {          if (@{$self->{open_elements}} > 1 and
3075            ## ISSUE: There is an issue in the spec.              $self->{open_elements}->[1]->[1] eq 'body') {
3076            if ($self->{open_elements}->[-1]->[1] ne 'body') {            for (@{$self->{open_elements}}) {
3077              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);              unless ({
3078                           dd => 1, dt => 1, li => 1, p => 1, td => 1,
3079                           th => 1, tr => 1, body => 1, html => 1,
3080                         tbody => 1, tfoot => 1, thead => 1,
3081                        }->{$_->[1]}) {
3082                  !!!parse-error (type => 'not closed:'.$_->[1]);
3083                }
3084            }            }
3085    
3086            $self->{insertion_mode} = 'after body';            $self->{insertion_mode} = 'after body';
3087            !!!next-token;            !!!next-token;
3088            return;            return;
# Line 2858  sub _tree_construction_main ($) { Line 3127  sub _tree_construction_main ($) {
3127                   li => ($token->{tag_name} ne 'li'),                   li => ($token->{tag_name} ne 'li'),
3128                   p => ($token->{tag_name} ne 'p'),                   p => ($token->{tag_name} ne 'p'),
3129                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3130                     tbody => 1, tfoot=> 1, thead => 1,
3131                  }->{$self->{open_elements}->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3132                !!!back-token;                !!!back-token;
3133                $token = {type => 'end tag',                $token = {type => 'end tag',
# Line 2875  sub _tree_construction_main ($) { Line 3145  sub _tree_construction_main ($) {
3145          } # INSCOPE          } # INSCOPE
3146                    
3147          if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {          if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
3148            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);            if (defined $i) {
3149                !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3150              } else {
3151                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3152              }
3153          }          }
3154                    
3155          splice @{$self->{open_elements}}, $i if defined $i;          if (defined $i) {
3156              splice @{$self->{open_elements}}, $i;
3157            } elsif ($token->{tag_name} eq 'p') {
3158              ## As if <p>, then reprocess the current token
3159              my $el;
3160              !!!create-element ($el, 'p');
3161              $insert->($el);
3162            }
3163          $clear_up_to_marker->()          $clear_up_to_marker->()
3164            if {            if {
3165              button => 1, marquee => 1, object => 1,              button => 1, marquee => 1, object => 1,
# Line 2894  sub _tree_construction_main ($) { Line 3175  sub _tree_construction_main ($) {
3175              if ({              if ({
3176                   dd => 1, dt => 1, li => 1, p => 1,                   dd => 1, dt => 1, li => 1, p => 1,
3177                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3178                     tbody => 1, tfoot=> 1, thead => 1,
3179                  }->{$self->{open_elements}->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3180                !!!back-token;                !!!back-token;
3181                $token = {type => 'end tag',                $token = {type => 'end tag',
# Line 2932  sub _tree_construction_main ($) { Line 3214  sub _tree_construction_main ($) {
3214              if ({              if ({
3215                   dd => 1, dt => 1, li => 1, p => 1,                   dd => 1, dt => 1, li => 1, p => 1,
3216                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3217                     tbody => 1, tfoot=> 1, thead => 1,
3218                  }->{$self->{open_elements}->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3219                !!!back-token;                !!!back-token;
3220                $token = {type => 'end tag',                $token = {type => 'end tag',
# Line 2962  sub _tree_construction_main ($) { Line 3245  sub _tree_construction_main ($) {
3245                  strong => 1, tt => 1, u => 1,                  strong => 1, tt => 1, u => 1,
3246                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3247          $formatting_end_tag->($token->{tag_name});          $formatting_end_tag->($token->{tag_name});
3248  ## TODO: <http://html5.org/tools/web-apps-tracker?from=883&to=884>          return;
3249          } elsif ($token->{tag_name} eq 'br') {
3250            !!!parse-error (type => 'unmatched end tag:br');
3251    
3252            ## As if <br>
3253            $reconstruct_active_formatting_elements->($insert_to_current);
3254            
3255            my $el;
3256            !!!create-element ($el, 'br');
3257            $insert->($el);
3258            
3259            ## Ignore the token.
3260            !!!next-token;
3261          return;          return;
3262        } elsif ({        } elsif ({
3263                  caption => 1, col => 1, colgroup => 1, frame => 1,                  caption => 1, col => 1, colgroup => 1, frame => 1,
3264                  frameset => 1, head => 1, option => 1, optgroup => 1,                  frameset => 1, head => 1, option => 1, optgroup => 1,
3265                  tbody => 1, td => 1, tfoot => 1, th => 1,                  tbody => 1, td => 1, tfoot => 1, th => 1,
3266                  thead => 1, tr => 1,                  thead => 1, tr => 1,
3267                  area => 1, basefont => 1, bgsound => 1, br => 1,                  area => 1, basefont => 1, bgsound => 1,
3268                  embed => 1, hr => 1, iframe => 1, image => 1,                  embed => 1, hr => 1, iframe => 1, image => 1,
3269                  img => 1, input => 1, isindex => 1, noembed => 1,                  img => 1, input => 1, isindex => 1, noembed => 1,
3270                  noframes => 1, param => 1, select => 1, spacer => 1,                  noframes => 1, param => 1, select => 1, spacer => 1,
# Line 2996  sub _tree_construction_main ($) { Line 3291  sub _tree_construction_main ($) {
3291              if ({              if ({
3292                   dd => 1, dt => 1, li => 1, p => 1,                   dd => 1, dt => 1, li => 1, p => 1,
3293                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3294                     tbody => 1, tfoot=> 1, thead => 1,
3295                  }->{$self->{open_elements}->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3296                !!!back-token;                !!!back-token;
3297                $token = {type => 'end tag',                $token = {type => 'end tag',
# Line 3019  sub _tree_construction_main ($) { Line 3315  sub _tree_construction_main ($) {
3315                  #not $phrasing_category->{$node->[1]} and                  #not $phrasing_category->{$node->[1]} and
3316                  ($special_category->{$node->[1]} or                  ($special_category->{$node->[1]} or
3317                   $scoping_category->{$node->[1]})) {                   $scoping_category->{$node->[1]})) {
3318                !!!parse-error (type => 'not closed:'.$node->[1]);                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3319                ## Ignore the token                ## Ignore the token
3320                !!!next-token;                !!!next-token;
3321                last S2;                last S2;
# Line 3039  sub _tree_construction_main ($) { Line 3335  sub _tree_construction_main ($) {
3335    }; # $in_body    }; # $in_body
3336    
3337    B: {    B: {
3338      if ($phase eq 'main') {      if ($token->{type} eq 'DOCTYPE') {
3339        if ($token->{type} eq 'DOCTYPE') {        !!!parse-error (type => 'DOCTYPE in the middle');
3340          !!!parse-error (type => 'in html:#DOCTYPE');        ## Ignore the token
3341          ## Ignore the token        ## Stay in the phase
3342          ## Stay in the phase        !!!next-token;
3343          !!!next-token;        redo B;
3344          redo B;      } elsif ($token->{type} eq 'end-of-file') {
3345        } elsif ($token->{type} eq 'start tag' and        if ($token->{insertion_mode} ne 'trailing end') {
                $token->{tag_name} eq 'html') {  
         ## TODO: unless it is the first start tag token, parse-error  
         my $top_el = $self->{open_elements}->[0]->[0];  
         for my $attr_name (keys %{$token->{attributes}}) {  
           unless ($top_el->has_attribute_ns (undef, $attr_name)) {  
             $top_el->set_attribute_ns  
               (undef, [undef, $attr_name],  
                $token->{attributes}->{$attr_name}->{value});  
           }  
         }  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'end-of-file') {  
3346          ## Generate implied end tags          ## Generate implied end tags
3347          if ({          if ({
3348               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,
3349                 tbody => 1, tfoot=> 1, thead => 1,
3350              }->{$self->{open_elements}->[-1]->[1]}) {              }->{$self->{open_elements}->[-1]->[1]}) {
3351            !!!back-token;            !!!back-token;
3352            $token = {type => 'end tag', tag_name => $self->{open_elements}->[-1]->[1]};            $token = {type => 'end tag', tag_name => $self->{open_elements}->[-1]->[1]};
# Line 3078  sub _tree_construction_main ($) { Line 3362  sub _tree_construction_main ($) {
3362            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3363          }          }
3364    
         ## Stop parsing  
         last B;  
   
3365          ## ISSUE: There is an issue in the spec.          ## ISSUE: There is an issue in the spec.
3366          }
3367    
3368          ## Stop parsing
3369          last B;
3370        } elsif ($token->{type} eq 'start tag' and
3371                 $token->{tag_name} eq 'html') {
3372          if ($self->{insertion_mode} eq 'trailing end') {
3373            ## Turn into the main phase
3374            !!!parse-error (type => 'after html:html');
3375            $self->{insertion_mode} = $previous_insertion_mode;
3376          }
3377    
3378    ## ISSUE: "aa<html>" is not a parse error.
3379    ## ISSUE: "<html>" in fragment is not a parse error.
3380          unless ($token->{first_start_tag}) {
3381            !!!parse-error (type => 'not first start tag');
3382          }
3383          my $top_el = $self->{open_elements}->[0]->[0];
3384          for my $attr_name (keys %{$token->{attributes}}) {
3385            unless ($top_el->has_attribute_ns (undef, $attr_name)) {
3386              $top_el->set_attribute_ns
3387                (undef, [undef, $attr_name],
3388                 $token->{attributes}->{$attr_name}->{value});
3389            }
3390          }
3391          !!!next-token;
3392          redo B;
3393        } elsif ($token->{type} eq 'comment') {
3394          my $comment = $self->{document}->create_comment ($token->{data});
3395          if ($self->{insertion_mode} eq 'trailing end') {
3396            $self->{document}->append_child ($comment);
3397          } elsif ($self->{insertion_mode} eq 'after body') {
3398            $self->{open_elements}->[0]->[0]->append_child ($comment);
3399        } else {        } else {
3400          if ($self->{insertion_mode} eq 'before head') {          $self->{open_elements}->[-1]->[0]->append_child ($comment);
3401          }
3402          !!!next-token;
3403          redo B;
3404        } elsif ($self->{insertion_mode} eq 'before head') {
3405            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3406              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3407                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
# Line 3099  sub _tree_construction_main ($) { Line 3417  sub _tree_construction_main ($) {
3417              $self->{insertion_mode} = 'in head';              $self->{insertion_mode} = 'in head';
3418              ## reprocess              ## reprocess
3419              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3420            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3421              my $attr = $token->{tag_name} eq 'head' ? $token->{attributes} : {};              my $attr = $token->{tag_name} eq 'head' ? $token->{attributes} : {};
3422              !!!create-element ($self->{head_element}, 'head', $attr);              !!!create-element ($self->{head_element}, 'head', $attr);
# Line 3122  sub _tree_construction_main ($) { Line 3435  sub _tree_construction_main ($) {
3435              }              }
3436              redo B;              redo B;
3437            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3438              if ($token->{tag_name} eq 'html') {              if ({
3439                     head => 1, body => 1, html => 1,
3440                     p => 1, br => 1,
3441                    }->{$token->{tag_name}}) {
3442                ## As if <head>                ## As if <head>
3443                !!!create-element ($self->{head_element}, 'head');                !!!create-element ($self->{head_element}, 'head');
3444                $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});                $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
# Line 3132  sub _tree_construction_main ($) { Line 3448  sub _tree_construction_main ($) {
3448                redo B;                redo B;
3449              } else {              } else {
3450                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3451                ## Ignore the token                ## Ignore the token ## ISSUE: An issue in the spec.
3452                !!!next-token;                !!!next-token;
3453                redo B;                redo B;
3454              }              }
3455            } else {            } else {
3456              die "$0: $token->{type}: Unknown type";              die "$0: $token->{type}: Unknown type";
3457            }            }
3458          } elsif ($self->{insertion_mode} eq 'in head') {          } elsif ($self->{insertion_mode} eq 'in head' or
3459                     $self->{insertion_mode} eq 'in head noscript' or
3460                     $self->{insertion_mode} eq 'after head') {
3461            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3462              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3463                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
# Line 3150  sub _tree_construction_main ($) { Line 3468  sub _tree_construction_main ($) {
3468              }              }
3469                            
3470              #              #
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3471            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3472              if ($token->{tag_name} eq 'title') {              if ({base => ($self->{insertion_mode} eq 'in head' or
3473                ## NOTE: There is an "as if in head" code clone                            $self->{insertion_mode} eq 'after head'),
3474                my $title_el;                   link => 1}->{$token->{tag_name}}) {
3475                !!!create-element ($title_el, 'title', $token->{attributes});                ## NOTE: There is a "as if in head" code clone.
3476                (defined $self->{head_element} ? $self->{head_element} : $self->{open_elements}->[-1]->[0])                if ($self->{insertion_mode} eq 'after head') {
3477                  ->append_child ($title_el);                  !!!parse-error (type => 'after head:'.$token->{tag_name});
3478                $self->{content_model_flag} = 'RCDATA';                  push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3479                delete $self->{escape}; # MUST                }
3480                  !!!insert-element ($token->{tag_name}, $token->{attributes});
3481                my $text = '';                pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
3482                  pop @{$self->{open_elements}}
3483                      if $self->{insertion_mode} eq 'after head';
3484                !!!next-token;                !!!next-token;
3485                while ($token->{type} eq 'character') {                redo B;
3486                  $text .= $token->{data};              } elsif ($token->{tag_name} eq 'meta') {
3487                  !!!next-token;                ## NOTE: There is a "as if in head" code clone.
3488                  if ($self->{insertion_mode} eq 'after head') {
3489                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3490                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3491                }                }
3492                if (length $text) {                !!!insert-element ($token->{tag_name}, $token->{attributes});
3493                  $title_el->manakai_append_text ($text);                pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
3494    
3495                  unless ($self->{confident}) {
3496                    my $charset;
3497                    if ($token->{attributes}->{charset}) { ## TODO: And if supported
3498                      $charset = $token->{attributes}->{charset}->{value};
3499                    }
3500                    if ($token->{attributes}->{'http-equiv'}) {
3501                      ## ISSUE: Algorithm name in the spec was incorrect so that not linked to the definition.
3502                      if ($token->{attributes}->{'http-equiv'}->{value}
3503                          =~ /\A[^;]*;[\x09-\x0D\x20]*charset[\x09-\x0D\x20]*=
3504                              [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|
3505                              ([^"'\x09-\x0D\x20][^\x09-\x0D\x20]*))/x) {
3506                        $charset = defined $1 ? $1 : defined $2 ? $2 : $3;
3507                      } ## TODO: And if supported
3508                    }
3509                    ## TODO: Change the encoding
3510                }                }
3511                  
3512                $self->{content_model_flag} = 'PCDATA';                ## TODO: Extracting |charset| from |meta|.
3513                                pop @{$self->{open_elements}}
3514                if ($token->{type} eq 'end tag' and                    if $self->{insertion_mode} eq 'after head';
3515                    $token->{tag_name} eq 'title') {                !!!next-token;
3516                  redo B;
3517                } elsif ($token->{tag_name} eq 'title' and
3518                         $self->{insertion_mode} eq 'in head') {
3519                  ## NOTE: There is a "as if in head" code clone.
3520                  if ($self->{insertion_mode} eq 'after head') {
3521                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3522                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3523                  }
3524                  my $parent = defined $self->{head_element} ? $self->{head_element}
3525                      : $self->{open_elements}->[-1]->[0];
3526                  $parse_rcdata->('RCDATA', sub { $parent->append_child ($_[0]) });
3527                  pop @{$self->{open_elements}}
3528                      if $self->{insertion_mode} eq 'after head';
3529                  redo B;
3530                } elsif ($token->{tag_name} eq 'style') {
3531                  ## NOTE: Or (scripting is enabled and tag_name eq 'noscript' and
3532                  ## insertion mode 'in head')
3533                  ## NOTE: There is a "as if in head" code clone.
3534                  if ($self->{insertion_mode} eq 'after head') {
3535                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3536                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3537                  }
3538                  $parse_rcdata->('CDATA', $insert_to_current);
3539                  pop @{$self->{open_elements}}
3540                      if $self->{insertion_mode} eq 'after head';
3541                  redo B;
3542                } elsif ($token->{tag_name} eq 'noscript') {
3543                  if ($self->{insertion_mode} eq 'in head') {
3544                    ## NOTE: and scripting is disalbed
3545                    !!!insert-element ($token->{tag_name}, $token->{attributes});
3546                    $self->{insertion_mode} = 'in head noscript';
3547                    !!!next-token;
3548                    redo B;
3549                  } elsif ($self->{insertion_mode} eq 'in head noscript') {
3550                    !!!parse-error (type => 'in noscript:noscript');
3551                  ## Ignore the token                  ## Ignore the token
3552                    redo B;
3553                } else {                } else {
3554                  !!!parse-error (type => 'in RCDATA:#'.$token->{type});                  #
                 ## ISSUE: And ignore?  
3555                }                }
3556                } elsif ($token->{tag_name} eq 'head' and
3557                         $self->{insertion_mode} ne 'after head') {
3558                  !!!parse-error (type => 'in head:head'); # or in head noscript
3559                  ## Ignore the token
3560                !!!next-token;                !!!next-token;
3561                redo B;                redo B;
3562              } elsif ($token->{tag_name} eq 'style') {              } elsif ($self->{insertion_mode} ne 'in head noscript' and
3563                $style_start_tag->();                       $token->{tag_name} eq 'script') {
3564                redo B;                if ($self->{insertion_mode} eq 'after head') {
3565              } elsif ($token->{tag_name} eq 'script') {                  !!!parse-error (type => 'after head:'.$token->{tag_name});
3566                $script_start_tag->();                  push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3567                  }
3568                  ## NOTE: There is a "as if in head" code clone.
3569                  $script_start_tag->($insert_to_current);
3570                  pop @{$self->{open_elements}}
3571                      if $self->{insertion_mode} eq 'after head';
3572                redo B;                redo B;
3573              } elsif ({base => 1, link => 1, meta => 1}->{$token->{tag_name}}) {              } elsif ($self->{insertion_mode} eq 'after head' and
3574                ## NOTE: There are "as if in head" code clones                       $token->{tag_name} eq 'body') {
3575                my $el;                !!!insert-element ('body', $token->{attributes});
3576                !!!create-element ($el, $token->{tag_name}, $token->{attributes});                $self->{insertion_mode} = 'in body';
               (defined $self->{head_element} ? $self->{head_element} : $self->{open_elements}->[-1]->[0])  
                 ->append_child ($el);  
   
3577                !!!next-token;                !!!next-token;
3578                redo B;                redo B;
3579              } elsif ($token->{tag_name} eq 'head') {              } elsif ($self->{insertion_mode} eq 'after head' and
3580                !!!parse-error (type => 'in head:head');                       $token->{tag_name} eq 'frameset') {
3581                ## Ignore the token                !!!insert-element ('frameset', $token->{attributes});
3582                  $self->{insertion_mode} = 'in frameset';
3583                !!!next-token;                !!!next-token;
3584                redo B;                redo B;
3585              } else {              } else {
3586                #                #
3587              }              }
3588            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3589              if ($token->{tag_name} eq 'head') {              if ($self->{insertion_mode} eq 'in head' and
3590                if ($self->{open_elements}->[-1]->[1] eq 'head') {                  $token->{tag_name} eq 'head') {
3591                  pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
               } else {  
                 !!!parse-error (type => 'unmatched end tag:head');  
               }  
3592                $self->{insertion_mode} = 'after head';                $self->{insertion_mode} = 'after head';
3593                !!!next-token;                !!!next-token;
3594                redo B;                redo B;
3595              } elsif ($token->{tag_name} eq 'html') {              } elsif ($self->{insertion_mode} eq 'in head noscript' and
3596                    $token->{tag_name} eq 'noscript') {
3597                  pop @{$self->{open_elements}};
3598                  $self->{insertion_mode} = 'in head';
3599                  !!!next-token;
3600                  redo B;
3601                } elsif ($self->{insertion_mode} eq 'in head' and
3602                         {
3603                          body => 1, html => 1,
3604                          p => 1, br => 1,
3605                         }->{$token->{tag_name}}) {
3606                #                #
3607              } else {              } elsif ($self->{insertion_mode} eq 'in head noscript' and
3608                         {
3609                          p => 1, br => 1,
3610                         }->{$token->{tag_name}}) {
3611                  #
3612                } elsif ($self->{insertion_mode} ne 'after head') {
3613                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3614                ## Ignore the token                ## Ignore the token
3615                !!!next-token;                !!!next-token;
3616                redo B;                redo B;
3617                } else {
3618                  #
3619              }              }
3620            } else {            } else {
3621              #              #
3622            }            }
3623    
3624            if ($self->{open_elements}->[-1]->[1] eq 'head') {            ## As if </head> or </noscript> or <body>
3625              ## As if </head>            if ($self->{insertion_mode} eq 'in head') {
3626                pop @{$self->{open_elements}};
3627                $self->{insertion_mode} = 'after head';
3628              } elsif ($self->{insertion_mode} eq 'in head noscript') {
3629              pop @{$self->{open_elements}};              pop @{$self->{open_elements}};
3630                !!!parse-error (type => 'in noscript:'.(defined $token->{tag_name} ? ($token->{type} eq 'end tag' ? '/' : '') . $token->{tag_name} : '#' . $token->{type}));
3631                $self->{insertion_mode} = 'in head';
3632              } else { # 'after head'
3633                !!!insert-element ('body');
3634                $self->{insertion_mode} = 'in body';
3635            }            }
           $self->{insertion_mode} = 'after head';  
3636            ## reprocess            ## reprocess
3637            redo B;            redo B;
3638    
3639            ## ISSUE: An issue in the spec.            ## ISSUE: An issue in the spec.
         } elsif ($self->{insertion_mode} eq 'after head') {  
           if ($token->{type} eq 'character') {  
             if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {  
               $self->{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});  
             $self->{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});  
               $self->{insertion_mode} = 'in body';  
               !!!next-token;  
               redo B;  
             } elsif ($token->{tag_name} eq 'frameset') {  
               !!!insert-element ('frameset', $token->{attributes});  
               $self->{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 (type => 'after head:'.$token->{tag_name});  
               $self->{insertion_mode} = 'in head';  
               ## reprocess  
               redo B;  
             } else {  
               #  
             }  
           } else {  
             #  
           }  
             
           ## As if <body>  
           !!!insert-element ('body');  
           $self->{insertion_mode} = 'in body';  
           ## reprocess  
           redo B;  
3640          } elsif ($self->{insertion_mode} eq 'in body') {          } elsif ($self->{insertion_mode} eq 'in body') {
3641            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3642              ## NOTE: There is a code clone of "character in body".              ## NOTE: There is a code clone of "character in body".
# Line 3296  sub _tree_construction_main ($) { Line 3646  sub _tree_construction_main ($) {
3646    
3647              !!!next-token;              !!!next-token;
3648              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## NOTE: There is a code clone of "comment in body".  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3649            } else {            } else {
3650              $in_body->($insert_to_current);              $in_body->($insert_to_current);
3651              redo B;              redo B;
# Line 3365  sub _tree_construction_main ($) { Line 3709  sub _tree_construction_main ($) {
3709                            
3710              !!!next-token;              !!!next-token;
3711              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3712            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3713              if ({              if ({
3714                   caption => 1,                   caption => 1,
# Line 3441  sub _tree_construction_main ($) { Line 3780  sub _tree_construction_main ($) {
3780                if ({                if ({
3781                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3782                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3783                       tbody => 1, tfoot=> 1, thead => 1,
3784                    }->{$self->{open_elements}->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
3785                  !!!back-token; # <table>                  !!!back-token; # <table>
3786                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
# Line 3489  sub _tree_construction_main ($) { Line 3829  sub _tree_construction_main ($) {
3829                if ({                if ({
3830                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3831                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3832                       tbody => 1, tfoot=> 1, thead => 1,
3833                    }->{$self->{open_elements}->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
3834                  !!!back-token;                  !!!back-token;
3835                  $token = {type => 'end tag',                  $token = {type => 'end tag',
# Line 3534  sub _tree_construction_main ($) { Line 3875  sub _tree_construction_main ($) {
3875    
3876              !!!next-token;              !!!next-token;
3877              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## NOTE: This is a code clone of "comment in body".  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3878            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3879              if ({              if ({
3880                   caption => 1, col => 1, colgroup => 1, tbody => 1,                   caption => 1, col => 1, colgroup => 1, tbody => 1,
# Line 3572  sub _tree_construction_main ($) { Line 3907  sub _tree_construction_main ($) {
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                       tbody => 1, tfoot=> 1, thead => 1,
3911                    }->{$self->{open_elements}->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
3912                  !!!back-token; # <?>                  !!!back-token; # <?>
3913                  $token = {type => 'end tag', tag_name => 'caption'};                  $token = {type => 'end tag', tag_name => 'caption'};
# Line 3622  sub _tree_construction_main ($) { Line 3958  sub _tree_construction_main ($) {
3958                if ({                if ({
3959                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3960                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3961                       tbody => 1, tfoot=> 1, thead => 1,
3962                    }->{$self->{open_elements}->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
3963                  !!!back-token;                  !!!back-token;
3964                  $token = {type => 'end tag',                  $token = {type => 'end tag',
# Line 3669  sub _tree_construction_main ($) { Line 4006  sub _tree_construction_main ($) {
4006                if ({                if ({
4007                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4008                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4009                       tbody => 1, tfoot=> 1, thead => 1,
4010                    }->{$self->{open_elements}->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
4011                  !!!back-token; # </table>                  !!!back-token; # </table>
4012                  $token = {type => 'end tag', tag_name => 'caption'};                  $token = {type => 'end tag', tag_name => 'caption'};
# Line 3718  sub _tree_construction_main ($) { Line 4056  sub _tree_construction_main ($) {
4056              }              }
4057                            
4058              #              #
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
4059            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4060              if ($token->{tag_name} eq 'col') {              if ($token->{tag_name} eq 'col') {
4061                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
# Line 3828  sub _tree_construction_main ($) { Line 4161  sub _tree_construction_main ($) {
4161                            
4162              !!!next-token;              !!!next-token;
4163              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## Copied from 'in table'  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
4164            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4165              if ({              if ({
4166                   tr => 1,                   tr => 1,
# Line 3934  sub _tree_construction_main ($) { Line 4261  sub _tree_construction_main ($) {
4261                if ({                if ({
4262                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4263                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4264                       tbody => 1, tfoot=> 1, thead => 1,
4265                    }->{$self->{open_elements}->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
4266                  !!!back-token; # <table>                  !!!back-token; # <table>
4267                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
# Line 4112  sub _tree_construction_main ($) { Line 4440  sub _tree_construction_main ($) {
4440                            
4441              !!!next-token;              !!!next-token;
4442              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## Copied from 'in table'  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
4443            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4444              if ($token->{tag_name} eq 'th' or              if ($token->{tag_name} eq 'th' or
4445                  $token->{tag_name} eq 'td') {                  $token->{tag_name} eq 'td') {
# Line 4202  sub _tree_construction_main ($) { Line 4524  sub _tree_construction_main ($) {
4524                if ({                if ({
4525                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4526                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4527                       tbody => 1, tfoot=> 1, thead => 1,
4528                    }->{$self->{open_elements}->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
4529                  !!!back-token; # <table>                  !!!back-token; # <table>
4530                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
# Line 4376  sub _tree_construction_main ($) { Line 4699  sub _tree_construction_main ($) {
4699    
4700              !!!next-token;              !!!next-token;
4701              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## NOTE: This is a code clone of "comment in body".  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
4702            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4703              if ({              if ({
4704                   caption => 1, col => 1, colgroup => 1,                   caption => 1, col => 1, colgroup => 1,
# Line 4443  sub _tree_construction_main ($) { Line 4760  sub _tree_construction_main ($) {
4760                     td => ($token->{tag_name} eq 'th'),                     td => ($token->{tag_name} eq 'th'),
4761                     th => ($token->{tag_name} eq 'td'),                     th => ($token->{tag_name} eq 'td'),
4762                     tr => 1,                     tr => 1,
4763                       tbody => 1, tfoot=> 1, thead => 1,
4764                    }->{$self->{open_elements}->[-1]->[1]}) {                    }->{$self->{open_elements}->[-1]->[1]}) {
4765                  !!!back-token;                  !!!back-token;
4766                  $token = {type => 'end tag',                  $token = {type => 'end tag',
# Line 4517  sub _tree_construction_main ($) { Line 4835  sub _tree_construction_main ($) {
4835              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4836              !!!next-token;              !!!next-token;
4837              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
4838            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4839              if ($token->{tag_name} eq 'option') {              if ($token->{tag_name} eq 'option') {
4840                if ($self->{open_elements}->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
# Line 4694  sub _tree_construction_main ($) { Line 5007  sub _tree_construction_main ($) {
5007          } elsif ($self->{insertion_mode} eq 'after body') {          } elsif ($self->{insertion_mode} eq 'after body') {
5008            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
5009              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5010                  my $data = $1;
5011                ## As if in body                ## As if in body
5012                $reconstruct_active_formatting_elements->($insert_to_current);                $reconstruct_active_formatting_elements->($insert_to_current);
5013                                
5014                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
5015    
5016                unless (length $token->{data}) {                unless (length $token->{data}) {
5017                  !!!next-token;                  !!!next-token;
# Line 4706  sub _tree_construction_main ($) { Line 5020  sub _tree_construction_main ($) {
5020              }              }
5021                            
5022              #              #
5023              !!!parse-error (type => 'after body:#'.$token->{type});              !!!parse-error (type => 'after body:#character');
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[0]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
5024            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
5025              !!!parse-error (type => 'after body:'.$token->{tag_name});              !!!parse-error (type => 'after body:'.$token->{tag_name});
5026              #              #
# Line 4723  sub _tree_construction_main ($) { Line 5032  sub _tree_construction_main ($) {
5032                  !!!next-token;                  !!!next-token;
5033                  redo B;                  redo B;
5034                } else {                } else {
5035                  $phase = 'trailing end';                  $previous_insertion_mode = $self->{insertion_mode};
5036                    $self->{insertion_mode} = 'trailing end';
5037                  !!!next-token;                  !!!next-token;
5038                  redo B;                  redo B;
5039                }                }
# Line 4731  sub _tree_construction_main ($) { Line 5041  sub _tree_construction_main ($) {
5041                !!!parse-error (type => 'after body:/'.$token->{tag_name});                !!!parse-error (type => 'after body:/'.$token->{tag_name});
5042              }              }
5043            } else {            } else {
5044              !!!parse-error (type => 'after body:#'.$token->{type});              die "$0: $token->{type}: Unknown token type";
5045            }            }
5046    
5047            $self->{insertion_mode} = 'in body';            $self->{insertion_mode} = 'in body';
5048            ## reprocess            ## reprocess
5049            redo B;            redo B;
5050          } elsif ($self->{insertion_mode} eq 'in frameset') {      } elsif ($self->{insertion_mode} eq 'in frameset') {
5051            if ($token->{type} eq 'character') {        if ($token->{type} eq 'character') {
5052              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5053                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});            $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
   
               unless (length $token->{data}) {  
                 !!!next-token;  
                 redo B;  
               }  
             }  
5054    
5055              #            unless (length $token->{data}) {
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $self->{open_elements}->[-1]->[0]->append_child ($comment);  
5056              !!!next-token;              !!!next-token;
5057              redo B;              redo B;
           } elsif ($token->{type} eq 'start tag') {  
             if ($token->{tag_name} eq 'frameset') {  
               !!!insert-element ($token->{tag_name}, $token->{attributes});  
               !!!next-token;  
               redo B;  
             } elsif ($token->{tag_name} eq 'frame') {  
               !!!insert-element ($token->{tag_name}, $token->{attributes});  
               pop @{$self->{open_elements}};  
               !!!next-token;  
               redo B;  
             } elsif ($token->{tag_name} eq 'noframes') {  
               $in_body->($insert_to_current);  
               redo B;  
             } else {  
               #  
             }  
           } elsif ($token->{type} eq 'end tag') {  
             if ($token->{tag_name} eq 'frameset') {  
               if ($self->{open_elements}->[-1]->[1] eq 'html' and  
                   @{$self->{open_elements}} == 1) {  
                 !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});  
                 ## Ignore the token  
                 !!!next-token;  
               } else {  
                 pop @{$self->{open_elements}};  
                 !!!next-token;  
               }  
                 
               ## if not inner_html and  
               if ($self->{open_elements}->[-1]->[1] ne 'frameset') {  
                 $self->{insertion_mode} = 'after frameset';  
               }  
               redo B;  
             } else {  
               #  
             }  
           } else {  
             #  
5058            }            }
5059                      }
5060            if (defined $token->{tag_name}) {  
5061              !!!parse-error (type => 'in frameset:'.$token->{tag_name});          !!!parse-error (type => 'in frameset:#character');
5062            ## Ignore the token
5063            !!!next-token;
5064            redo B;
5065          } elsif ($token->{type} eq 'start tag') {
5066            if ($token->{tag_name} eq 'frameset') {
5067              !!!insert-element ($token->{tag_name}, $token->{attributes});
5068              !!!next-token;
5069              redo B;
5070            } elsif ($token->{tag_name} eq 'frame') {
5071              !!!insert-element ($token->{tag_name}, $token->{attributes});
5072              pop @{$self->{open_elements}};
5073              !!!next-token;
5074              redo B;
5075            } elsif ($token->{tag_name} eq 'noframes') {
5076              $in_body->($insert_to_current);
5077              redo B;
5078            } else {
5079              !!!parse-error (type => 'in frameset:'.$token->{tag_name});
5080              ## Ignore the token
5081              !!!next-token;
5082              redo B;
5083            }
5084          } elsif ($token->{type} eq 'end tag') {
5085            if ($token->{tag_name} eq 'frameset') {
5086              if ($self->{open_elements}->[-1]->[1] eq 'html' and
5087                  @{$self->{open_elements}} == 1) {
5088                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
5089                ## Ignore the token
5090                !!!next-token;
5091            } else {            } else {
5092              !!!parse-error (type => 'in frameset:#'.$token->{type});              pop @{$self->{open_elements}};
5093                !!!next-token;
5094              }
5095    
5096              if (not defined $self->{inner_html_node} and
5097                  $self->{open_elements}->[-1]->[1] ne 'frameset') {
5098                $self->{insertion_mode} = 'after frameset';
5099            }            }
5100              redo B;
5101            } else {
5102              !!!parse-error (type => 'in frameset:/'.$token->{tag_name});
5103            ## Ignore the token            ## Ignore the token
5104            !!!next-token;            !!!next-token;
5105            redo B;            redo B;
5106          } elsif ($self->{insertion_mode} eq 'after frameset') {          }
5107            if ($token->{type} eq 'character') {        } else {
5108            die "$0: $token->{type}: Unknown token type";
5109          }
5110        } elsif ($self->{insertion_mode} eq 'after frameset') {
5111          if ($token->{type} eq 'character') {
5112              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5113                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
5114    
5115                unless (length $token->{data}) {                unless (length $token->{data}) {
5116                  !!!next-token;                  !!!next-token;
# Line 4813  sub _tree_construction_main ($) { Line 5118  sub _tree_construction_main ($) {
5118                }                }
5119              }              }
5120    
5121              #              if ($token->{data} =~ s/^[^\x09\x0A\x0B\x0C\x20]+//) {
5122            } elsif ($token->{type} eq 'comment') {                !!!parse-error (type => 'after frameset:#character');
5123              my $comment = $self->{document}->create_comment ($token->{data});  
5124              $self->{open_elements}->[-1]->[0]->append_child ($comment);                ## Ignore the token.
5125              !!!next-token;                if (length $token->{data}) {
5126              redo B;                  ## reprocess the rest of characters
5127            } elsif ($token->{type} eq 'start tag') {                } else {
5128              if ($token->{tag_name} eq 'noframes') {                  !!!next-token;
5129                $in_body->($insert_to_current);                }
               redo B;  
             } else {  
               #  
             }  
           } elsif ($token->{type} eq 'end tag') {  
             if ($token->{tag_name} eq 'html') {  
               $phase = 'trailing end';  
               !!!next-token;  
5130                redo B;                redo B;
             } else {  
               #  
5131              }              }
5132            } else {  
5133              #          die qq[$0: Character "$token->{data}"];
5134            }        } elsif ($token->{type} eq 'start tag') {
5135                      if ($token->{tag_name} eq 'noframes') {
5136            if (defined $token->{tag_name}) {            $in_body->($insert_to_current);
5137              !!!parse-error (type => 'after frameset:'.$token->{tag_name});            redo B;
5138            } else {          } else {
5139              !!!parse-error (type => 'after frameset:#'.$token->{type});            !!!parse-error (type => 'after frameset:'.$token->{tag_name});
           }  
5140            ## Ignore the token            ## Ignore the token
5141            !!!next-token;            !!!next-token;
5142            redo B;            redo B;
5143            }
5144            ## ISSUE: An issue in spec there        } elsif ($token->{type} eq 'end tag') {
5145            if ($token->{tag_name} eq 'html') {
5146              $previous_insertion_mode = $self->{insertion_mode};
5147              $self->{insertion_mode} = 'trailing end';
5148              !!!next-token;
5149              redo B;
5150          } else {          } else {
5151            die "$0: $self->{insertion_mode}: Unknown insertion mode";            !!!parse-error (type => 'after frameset:/'.$token->{tag_name});
5152              ## Ignore the token
5153              !!!next-token;
5154              redo B;
5155          }          }
5156          } else {
5157            die "$0: $token->{type}: Unknown token type";
5158        }        }
5159      } elsif ($phase eq 'trailing end') {  
5160          ## ISSUE: An issue in spec here
5161        } elsif ($self->{insertion_mode} eq 'trailing end') {
5162        ## states in the main stage is preserved yet # MUST        ## states in the main stage is preserved yet # MUST
5163                
5164        if ($token->{type} eq 'DOCTYPE') {        if ($token->{type} eq 'character') {
         !!!parse-error (type => 'after html:#DOCTYPE');  
         ## Ignore the token  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'comment') {  
         my $comment = $self->{document}->create_comment ($token->{data});  
         $self->{document}->append_child ($comment);  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'character') {  
5165          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5166            my $data = $1;            my $data = $1;
5167            ## As if in the main phase.            ## As if in the main phase.
5168            ## NOTE: The insertion mode in the main phase            ## NOTE: The insertion mode in the main phase
5169            ## just before the phase has been changed to the trailing            ## just before the phase has been changed to the trailing
5170            ## end phase is either "after body" or "after frameset".            ## end phase is either "after body" or "after frameset".
5171            $reconstruct_active_formatting_elements->($insert_to_current)            $reconstruct_active_formatting_elements->($insert_to_current);
             if $phase eq 'main';  
5172                        
5173            $self->{open_elements}->[-1]->[0]->manakai_append_text ($data);            $self->{open_elements}->[-1]->[0]->manakai_append_text ($data);
5174                        
# Line 4884  sub _tree_construction_main ($) { Line 5179  sub _tree_construction_main ($) {
5179          }          }
5180    
5181          !!!parse-error (type => 'after html:#character');          !!!parse-error (type => 'after html:#character');
5182          $phase = 'main';          $self->{insertion_mode} = $previous_insertion_mode;
5183          ## reprocess          ## reprocess
5184          redo B;          redo B;
5185        } elsif ($token->{type} eq 'start tag' or        } elsif ($token->{type} eq 'start tag') {
                $token->{type} eq 'end tag') {  
5186          !!!parse-error (type => 'after html:'.$token->{tag_name});          !!!parse-error (type => 'after html:'.$token->{tag_name});
5187          $phase = 'main';          $self->{insertion_mode} = $previous_insertion_mode;
5188            ## reprocess
5189            redo B;
5190          } elsif ($token->{type} eq 'end tag') {
5191            !!!parse-error (type => 'after html:/'.$token->{tag_name});
5192            $self->{insertion_mode} = $previous_insertion_mode;
5193          ## reprocess          ## reprocess
5194          redo B;          redo B;
       } elsif ($token->{type} eq 'end-of-file') {  
         ## Stop parsing  
         last B;  
5195        } else {        } else {
5196          die "$0: $token->{type}: Unknown token";          die "$0: $token->{type}: Unknown token";
5197        }        }
5198        } else {
5199          die "$0: $self->{insertion_mode}: Unknown insertion mode";
5200      }      }
5201    } # B    } # B
5202    
# Line 4935  sub set_inner_html ($$$) { Line 5233  sub set_inner_html ($$$) {
5233      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
5234    
5235      ## Step 1 # MUST      ## Step 1 # MUST
5236      my $doc = $node->owner_document->implementation->create_document;      my $this_doc = $node->owner_document;
5237      ## TODO: Mark as HTML document      my $doc = $this_doc->implementation->create_document;
5238        $doc->manakai_is_html (1);
5239      my $p = $class->new;      my $p = $class->new;
5240      $p->{document} = $doc;      $p->{document} = $doc;
5241    
# Line 4946  sub set_inner_html ($$$) { Line 5245  sub set_inner_html ($$$) {
5245      my $column = 0;      my $column = 0;
5246      $p->{set_next_input_character} = sub {      $p->{set_next_input_character} = sub {
5247        my $self = shift;        my $self = shift;
5248    
5249          pop @{$self->{prev_input_character}};
5250          unshift @{$self->{prev_input_character}}, $self->{next_input_character};
5251    
5252        $self->{next_input_character} = -1 and return if $i >= length $$s;        $self->{next_input_character} = -1 and return if $i >= length $$s;
5253        $self->{next_input_character} = ord substr $$s, $i++, 1;        $self->{next_input_character} = ord substr $$s, $i++, 1;
5254        $column++;        $column++;
# Line 4954  sub set_inner_html ($$$) { Line 5257  sub set_inner_html ($$$) {
5257          $line++;          $line++;
5258          $column = 0;          $column = 0;
5259        } elsif ($self->{next_input_character} == 0x000D) { # CR        } elsif ($self->{next_input_character} == 0x000D) { # CR
5260          if ($i >= length $$s) {          $i++ if substr ($$s, $i, 1) eq "\x0A";
           #  
         } else {  
           my $next_char = ord substr $$s, $i++, 1;  
           if ($next_char == 0x000A) { # LF  
             #  
           } else {  
             push @{$self->{char}}, $next_char;  
           }  
         }  
5261          $self->{next_input_character} = 0x000A; # LF # MUST          $self->{next_input_character} = 0x000A; # LF # MUST
5262          $line++;          $line++;
5263          $column = 0;          $column = 0;
5264        } elsif ($self->{next_input_character} > 0x10FFFF) {        } elsif ($self->{next_input_character} > 0x10FFFF) {
5265          $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST          $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5266        } elsif ($self->{next_input_character} == 0x0000) { # NULL        } elsif ($self->{next_input_character} == 0x0000) { # NULL
5267            !!!parse-error (type => 'NULL');
5268          $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST          $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5269        }        }
5270      };      };
5271        $p->{prev_input_character} = [-1, -1, -1];
5272        $p->{next_input_character} = -1;
5273            
5274      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
5275        my (%opt) = @_;        my (%opt) = @_;
# Line 5051  sub set_inner_html ($$$) { Line 5348  sub set_inner_html ($$$) {
5348      ## Step 12 # MUST      ## Step 12 # MUST
5349      @cn = @{$root->child_nodes};      @cn = @{$root->child_nodes};
5350      for (@cn) {      for (@cn) {
5351          $this_doc->adopt_node ($_);
5352        $node->append_child ($_);        $node->append_child ($_);
5353      }      }
5354      ## ISSUE: adopt_node? mutation events?      ## ISSUE: mutation events?
5355    
5356      $p->_terminate_tree_constructor;      $p->_terminate_tree_constructor;
5357    } else {    } else {
# Line 5098  sub get_inner_html ($$$) { Line 5396  sub get_inner_html ($$$) {
5396            
5397      my $nt = $child->node_type;      my $nt = $child->node_type;
5398      if ($nt == 1) { # Element      if ($nt == 1) { # Element
5399        my $tag_name = lc $child->tag_name; ## ISSUE: Definition of "lowercase"        my $tag_name = $child->tag_name; ## TODO: manakai_tag_name
5400        $s .= '<' . $tag_name;        $s .= '<' . $tag_name;
5401          ## NOTE: Non-HTML case:
5402        ## ISSUE: Non-html elements        ## <http://permalink.gmane.org/gmane.org.w3c.whatwg.discuss/11191>
5403    
5404        my @attrs = @{$child->attributes}; # sort order MUST be stable        my @attrs = @{$child->attributes}; # sort order MUST be stable
5405        for my $attr (@attrs) { # order is implementation dependent        for my $attr (@attrs) { # order is implementation dependent
5406          my $attr_name = lc $attr->name; ## ISSUE: Definition of "lowercase"          my $attr_name = $attr->name; ## TODO: manakai_name
5407          $s .= ' ' . $attr_name . '="';          $s .= ' ' . $attr_name . '="';
5408          my $attr_value = $attr->value;          my $attr_value = $attr->value;
5409          ## escape          ## escape
# Line 5124  sub get_inner_html ($$$) { Line 5422  sub get_inner_html ($$$) {
5422          spacer => 1, wbr => 1,          spacer => 1, wbr => 1,
5423        }->{$tag_name};        }->{$tag_name};
5424    
5425          $s .= "\x0A" if $tag_name eq 'pre' or $tag_name eq 'textarea';
5426    
5427        if (not $in_cdata and {        if (not $in_cdata and {
5428          style => 1, script => 1, xmp => 1, iframe => 1,          style => 1, script => 1, xmp => 1, iframe => 1,
5429          noembed => 1, noframes => 1, noscript => 1,          noembed => 1, noframes => 1, noscript => 1,
5430            plaintext => 1,
5431        }->{$tag_name}) {        }->{$tag_name}) {
5432          unshift @node, 'cdata-out';          unshift @node, 'cdata-out';
5433          $in_cdata = 1;          $in_cdata = 1;

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.38

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24