/[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.25 by wakaba, Sun Jun 24 05:12:11 2007 UTC
# Line 2  package Whatpm::HTML; Line 2  package Whatpm::HTML;
2  use strict;  use strict;
3  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4    
5  ## This is an early version of an HTML parser.  ## ISSUE:
6    ## var doc = implementation.createDocument (null, null, null);
7    ## doc.write ('');
8    ## alert (doc.compatMode);
9    
10  my $permitted_slash_tag_name = {  my $permitted_slash_tag_name = {
11    base => 1,    base => 1,
# Line 18  my $permitted_slash_tag_name = { Line 21  my $permitted_slash_tag_name = {
21    input => 1,    input => 1,
22  };  };
23    
 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  
   
24  my $c1_entity_char = {  my $c1_entity_char = {
25    0x80 => 0x20AC,    0x80 => 0x20AC,
26    0x81 => 0xFFFD,    0x81 => 0xFFFD,
# Line 361  sub parse_string ($$$;$) { Line 102  sub parse_string ($$$;$) {
102        $line++;        $line++;
103        $column = 0;        $column = 0;
104      } elsif ($self->{next_input_character} == 0x000D) { # CR      } elsif ($self->{next_input_character} == 0x000D) { # CR
105        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;  
         }  
       }  
106        $self->{next_input_character} = 0x000A; # LF # MUST        $self->{next_input_character} = 0x000A; # LF # MUST
107        $line++;        $line++;
108        $column = 0;        $column = 0;
# Line 426  sub _initialize_tokenizer ($) { Line 158  sub _initialize_tokenizer ($) {
158    # $self->{next_input_character}    # $self->{next_input_character}
159    !!!next-input-character;    !!!next-input-character;
160    $self->{token} = [];    $self->{token} = [];
161      # $self->{escape}
162  } # _initialize_tokenizer  } # _initialize_tokenizer
163    
164  ## A token has:  ## A token has:
165  ##   ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',  ##   ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',
166  ##       'character', or 'end-of-file'  ##       'character', or 'end-of-file'
167  ##   ->{name} (DOCTYPE, start tag (tagname), end tag (tagname))  ##   ->{name} (DOCTYPE, start tag (tag name), end tag (tag name))
168      ## ISSUE: the spec need s/tagname/tag name/  ##   ->{public_identifier} (DOCTYPE)
169  ##   ->{error} == 1 or 0 (DOCTYPE)  ##   ->{system_identifier} (DOCTYPE)
170    ##   ->{correct} == 1 or 0 (DOCTYPE)
171  ##   ->{attributes} isa HASH (start tag, end tag)  ##   ->{attributes} isa HASH (start tag, end tag)
172  ##   ->{data} (comment, character)  ##   ->{data} (comment, character)
173    
 ## Macros  
 ##   Macros MUST be preceded by three EXCLAMATION MARKs.  
 ##   emit ($token)  
 ##     Emits the specified token.  
   
174  ## Emitted token MUST immediately be handled by the tree construction state.  ## Emitted token MUST immediately be handled by the tree construction state.
175    
176  ## Before each step, UA MAY check to see if either one of the scripts in  ## Before each step, UA MAY check to see if either one of the scripts in
# Line 597  sub _get_next_token ($) { Line 326  sub _get_next_token ($) {
326      } elsif ($self->{state} eq 'close tag open') {      } elsif ($self->{state} eq 'close tag open') {
327        if ($self->{content_model_flag} eq 'RCDATA' or        if ($self->{content_model_flag} eq 'RCDATA' or
328            $self->{content_model_flag} eq 'CDATA') {            $self->{content_model_flag} eq 'CDATA') {
329          my @next_char;          if (defined $self->{last_emitted_start_tag_name}) {
330          TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {            my @next_char;
331              TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {
332                push @next_char, $self->{next_input_character};
333                my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);
334                my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;
335                if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {
336                  !!!next-input-character;
337                  next TAGNAME;
338                } else {
339                  $self->{next_input_character} = shift @next_char; # reconsume
340                  !!!back-next-input-character (@next_char);
341                  $self->{state} = 'data';
342    
343                  !!!emit ({type => 'character', data => '</'});
344      
345                  redo A;
346                }
347              }
348            push @next_char, $self->{next_input_character};            push @next_char, $self->{next_input_character};
349            my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);        
350            my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;            unless ($self->{next_input_character} == 0x0009 or # HT
351            if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {                    $self->{next_input_character} == 0x000A or # LF
352              !!!next-input-character;                    $self->{next_input_character} == 0x000B or # VT
353              next TAGNAME;                    $self->{next_input_character} == 0x000C or # FF
354            } else {                    $self->{next_input_character} == 0x0020 or # SP
355              !!!parse-error (type => 'unmatched end tag');                    $self->{next_input_character} == 0x003E or # >
356                      $self->{next_input_character} == 0x002F or # /
357                      $self->{next_input_character} == -1) {
358              $self->{next_input_character} = shift @next_char; # reconsume              $self->{next_input_character} = shift @next_char; # reconsume
359              !!!back-next-input-character (@next_char);              !!!back-next-input-character (@next_char);
360              $self->{state} = 'data';              $self->{state} = 'data';
   
361              !!!emit ({type => 'character', data => '</'});              !!!emit ({type => 'character', data => '</'});
   
362              redo A;              redo A;
363              } else {
364                $self->{next_input_character} = shift @next_char;
365                !!!back-next-input-character (@next_char);
366                # and consume...
367            }            }
368          }          } else {
369          push @next_char, $self->{next_input_character};            ## No start tag token has ever been emitted
370                  # next-input-character is already done
         unless ($self->{next_input_character} == 0x0009 or # HT  
                 $self->{next_input_character} == 0x000A or # LF  
                 $self->{next_input_character} == 0x000B or # VT  
                 $self->{next_input_character} == 0x000C or # FF  
                 $self->{next_input_character} == 0x0020 or # SP  
                 $self->{next_input_character} == 0x003E or # >  
                 $self->{next_input_character} == 0x002F or # /  
                 $self->{next_input_character} == 0x003C or # <  
                 $self->{next_input_character} == -1) {  
           !!!parse-error (type => 'unmatched end tag');  
           $self->{next_input_character} = shift @next_char; # reconsume  
           !!!back-next-input-character (@next_char);  
371            $self->{state} = 'data';            $self->{state} = 'data';
   
372            !!!emit ({type => 'character', data => '</'});            !!!emit ({type => 'character', data => '</'});
   
373            redo A;            redo A;
         } else {  
           $self->{next_input_character} = shift @next_char;  
           !!!back-next-input-character (@next_char);  
           # and consume...  
374          }          }
375        }        }
376                
# Line 699  sub _get_next_token ($) { Line 431  sub _get_next_token ($) {
431          !!!next-input-character;          !!!next-input-character;
432    
433          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
434    
435          redo A;          redo A;
436        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 709  sub _get_next_token ($) { Line 440  sub _get_next_token ($) {
440          ## Stay in this state          ## Stay in this state
441          !!!next-input-character;          !!!next-input-character;
442          redo A;          redo A;
443        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
                $self->{next_input_character} == -1) {  
444          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
445          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
446            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 726  sub _get_next_token ($) { Line 456  sub _get_next_token ($) {
456          # reconsume          # reconsume
457    
458          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
459    
460          redo A;          redo A;
461        } elsif ($self->{next_input_character} == 0x002F) { # /        } elsif ($self->{next_input_character} == 0x002F) { # /
# Line 773  sub _get_next_token ($) { Line 502  sub _get_next_token ($) {
502          !!!next-input-character;          !!!next-input-character;
503    
504          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
505    
506          redo A;          redo A;
507        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 796  sub _get_next_token ($) { Line 524  sub _get_next_token ($) {
524          ## Stay in the state          ## Stay in the state
525          # next-input-character is already done          # next-input-character is already done
526          redo A;          redo A;
527        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
                $self->{next_input_character} == -1) {  
528          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
529          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
530            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 813  sub _get_next_token ($) { Line 540  sub _get_next_token ($) {
540          # reconsume          # reconsume
541    
542          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
543    
544          redo A;          redo A;
545        } else {        } else {
# Line 865  sub _get_next_token ($) { Line 591  sub _get_next_token ($) {
591          !!!next-input-character;          !!!next-input-character;
592    
593          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
594    
595          redo A;          redo A;
596        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 888  sub _get_next_token ($) { Line 613  sub _get_next_token ($) {
613          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
614          # next-input-character is already done          # next-input-character is already done
615          redo A;          redo A;
616        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
                $self->{next_input_character} == -1) {  
617          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
618          $before_leave->();          $before_leave->();
619          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
# Line 906  sub _get_next_token ($) { Line 630  sub _get_next_token ($) {
630          # reconsume          # reconsume
631    
632          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
633    
634          redo A;          redo A;
635        } else {        } else {
# Line 943  sub _get_next_token ($) { Line 666  sub _get_next_token ($) {
666          !!!next-input-character;          !!!next-input-character;
667    
668          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
669    
670          redo A;          redo A;
671        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 966  sub _get_next_token ($) { Line 688  sub _get_next_token ($) {
688          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
689          # next-input-character is already done          # next-input-character is already done
690          redo A;          redo A;
691        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
                $self->{next_input_character} == -1) {  
692          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
693          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
694            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 983  sub _get_next_token ($) { Line 704  sub _get_next_token ($) {
704          # reconsume          # reconsume
705    
706          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
707    
708          redo A;          redo A;
709        } else {        } else {
# Line 1029  sub _get_next_token ($) { Line 749  sub _get_next_token ($) {
749          !!!next-input-character;          !!!next-input-character;
750    
751          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
752    
753          redo A;          redo A;
754        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
                $self->{next_input_character} == -1) {  
755          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
756          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
757            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 1049  sub _get_next_token ($) { Line 767  sub _get_next_token ($) {
767          ## reconsume          ## reconsume
768    
769          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
770    
771          redo A;          redo A;
772        } else {        } else {
# Line 1084  sub _get_next_token ($) { Line 801  sub _get_next_token ($) {
801          ## reconsume          ## reconsume
802    
803          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
804    
805          redo A;          redo A;
806        } else {        } else {
# Line 1119  sub _get_next_token ($) { Line 835  sub _get_next_token ($) {
835          ## reconsume          ## reconsume
836    
837          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
838    
839          redo A;          redo A;
840        } else {        } else {
# Line 1157  sub _get_next_token ($) { Line 872  sub _get_next_token ($) {
872          !!!next-input-character;          !!!next-input-character;
873    
874          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
875    
876          redo A;          redo A;
877        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
                $self->{next_input_character} == -1) {  
878          !!!parse-error (type => 'unclosed tag');          !!!parse-error (type => 'unclosed tag');
879          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
880            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 1177  sub _get_next_token ($) { Line 890  sub _get_next_token ($) {
890          ## reconsume          ## reconsume
891    
892          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
893    
894          redo A;          redo A;
895        } else {        } else {
# Line 1236  sub _get_next_token ($) { Line 948  sub _get_next_token ($) {
948          push @next_char, $self->{next_input_character};          push @next_char, $self->{next_input_character};
949          if ($self->{next_input_character} == 0x002D) { # -          if ($self->{next_input_character} == 0x002D) { # -
950            $self->{current_token} = {type => 'comment', data => ''};            $self->{current_token} = {type => 'comment', data => ''};
951            $self->{state} = 'comment';            $self->{state} = 'comment start';
952            !!!next-input-character;            !!!next-input-character;
953            redo A;            redo A;
954          }          }
# Line 1286  sub _get_next_token ($) { Line 998  sub _get_next_token ($) {
998                
999        ## ISSUE: typos in spec: chacacters, is is a parse error        ## ISSUE: typos in spec: chacacters, is is a parse error
1000        ## ISSUE: spec is somewhat unclear on "is the first character that will be in the comment"; what is "that will be in the comment" is what the algorithm defines, isn't it?        ## ISSUE: spec is somewhat unclear on "is the first character that will be in the comment"; what is "that will be in the comment" is what the algorithm defines, isn't it?
1001        } elsif ($self->{state} eq 'comment start') {
1002          if ($self->{next_input_character} == 0x002D) { # -
1003            $self->{state} = 'comment start dash';
1004            !!!next-input-character;
1005            redo A;
1006          } elsif ($self->{next_input_character} == 0x003E) { # >
1007            !!!parse-error (type => 'bogus comment');
1008            $self->{state} = 'data';
1009            !!!next-input-character;
1010    
1011            !!!emit ($self->{current_token}); # comment
1012    
1013            redo A;
1014          } elsif ($self->{next_input_character} == -1) {
1015            !!!parse-error (type => 'unclosed comment');
1016            $self->{state} = 'data';
1017            ## reconsume
1018    
1019            !!!emit ($self->{current_token}); # comment
1020    
1021            redo A;
1022          } else {
1023            $self->{current_token}->{data} # comment
1024                .= chr ($self->{next_input_character});
1025            $self->{state} = 'comment';
1026            !!!next-input-character;
1027            redo A;
1028          }
1029        } elsif ($self->{state} eq 'comment start dash') {
1030          if ($self->{next_input_character} == 0x002D) { # -
1031            $self->{state} = 'comment end';
1032            !!!next-input-character;
1033            redo A;
1034          } elsif ($self->{next_input_character} == 0x003E) { # >
1035            !!!parse-error (type => 'bogus comment');
1036            $self->{state} = 'data';
1037            !!!next-input-character;
1038    
1039            !!!emit ($self->{current_token}); # comment
1040    
1041            redo A;
1042          } elsif ($self->{next_input_character} == -1) {
1043            !!!parse-error (type => 'unclosed comment');
1044            $self->{state} = 'data';
1045            ## reconsume
1046    
1047            !!!emit ($self->{current_token}); # comment
1048    
1049            redo A;
1050          } else {
1051            $self->{current_token}->{data} # comment
1052                .= chr ($self->{next_input_character});
1053            $self->{state} = 'comment';
1054            !!!next-input-character;
1055            redo A;
1056          }
1057      } elsif ($self->{state} eq 'comment') {      } elsif ($self->{state} eq 'comment') {
1058        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1059          $self->{state} = 'comment dash';          $self->{state} = 'comment end dash';
1060          !!!next-input-character;          !!!next-input-character;
1061          redo A;          redo A;
1062        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
# Line 1297  sub _get_next_token ($) { Line 1065  sub _get_next_token ($) {
1065          ## reconsume          ## reconsume
1066    
1067          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1068    
1069          redo A;          redo A;
1070        } else {        } else {
# Line 1306  sub _get_next_token ($) { Line 1073  sub _get_next_token ($) {
1073          !!!next-input-character;          !!!next-input-character;
1074          redo A;          redo A;
1075        }        }
1076      } elsif ($self->{state} eq 'comment dash') {      } elsif ($self->{state} eq 'comment end dash') {
1077        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1078          $self->{state} = 'comment end';          $self->{state} = 'comment end';
1079          !!!next-input-character;          !!!next-input-character;
# Line 1317  sub _get_next_token ($) { Line 1084  sub _get_next_token ($) {
1084          ## reconsume          ## reconsume
1085    
1086          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1087    
1088          redo A;          redo A;
1089        } else {        } else {
# Line 1332  sub _get_next_token ($) { Line 1098  sub _get_next_token ($) {
1098          !!!next-input-character;          !!!next-input-character;
1099    
1100          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1101    
1102          redo A;          redo A;
1103        } elsif ($self->{next_input_character} == 0x002D) { # -        } elsif ($self->{next_input_character} == 0x002D) { # -
# Line 1347  sub _get_next_token ($) { Line 1112  sub _get_next_token ($) {
1112          ## reconsume          ## reconsume
1113    
1114          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1115    
1116          redo A;          redo A;
1117        } else {        } else {
# Line 1381  sub _get_next_token ($) { Line 1145  sub _get_next_token ($) {
1145          ## Stay in the state          ## Stay in the state
1146          !!!next-input-character;          !!!next-input-character;
1147          redo A;          redo A;
       } elsif (0x0061 <= $self->{next_input_character} and  
                $self->{next_input_character} <= 0x007A) { # a..z  
 ## 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;  
1148        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
1149          !!!parse-error (type => 'no DOCTYPE name');          !!!parse-error (type => 'no DOCTYPE name');
1150          $self->{state} = 'data';          $self->{state} = 'data';
1151          !!!next-input-character;          !!!next-input-character;
1152    
1153          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1154    
1155          redo A;          redo A;
1156        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
# Line 1403  sub _get_next_token ($) { Line 1158  sub _get_next_token ($) {
1158          $self->{state} = 'data';          $self->{state} = 'data';
1159          ## reconsume          ## reconsume
1160    
1161          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1162    
1163          redo A;          redo A;
1164        } else {        } else {
1165          $self->{current_token} = {type => 'DOCTYPE',          $self->{current_token}
1166                            name => chr ($self->{next_input_character}),              = {type => 'DOCTYPE',
1167                            error => 1};                 name => chr ($self->{next_input_character}),
1168                   correct => 1};
1169  ## ISSUE: "Set the token's name name to the" in the spec  ## ISSUE: "Set the token's name name to the" in the spec
1170          $self->{state} = 'DOCTYPE name';          $self->{state} = 'DOCTYPE name';
1171          !!!next-input-character;          !!!next-input-character;
1172          redo A;          redo A;
1173        }        }
1174      } elsif ($self->{state} eq 'DOCTYPE name') {      } elsif ($self->{state} eq 'DOCTYPE name') {
1175    ## ISSUE: Redundant "First," in the spec.
1176        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1177            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1178            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
1179            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
1180            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1181          $self->{state} = 'after DOCTYPE name';          $self->{state} = 'after DOCTYPE name';
1182          !!!next-input-character;          !!!next-input-character;
1183          redo A;          redo A;
1184        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1185          $self->{state} = 'data';          $self->{state} = 'data';
1186          !!!next-input-character;          !!!next-input-character;
1187    
1188          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1189    
1190          redo A;          redo A;
       } elsif (0x0061 <= $self->{next_input_character} and  
                $self->{next_input_character} <= 0x007A) { # a..z  
         $self->{current_token}->{name} .= chr ($self->{next_input_character} - 0x0020); # DOCTYPE  
         #$self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML');  
         ## Stay in the state  
         !!!next-input-character;  
         redo A;  
1191        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1192          !!!parse-error (type => 'unclosed DOCTYPE');          !!!parse-error (type => 'unclosed DOCTYPE');
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1193          $self->{state} = 'data';          $self->{state} = 'data';
1194          ## reconsume          ## reconsume
1195    
1196          !!!emit ($self->{current_token});          delete $self->{current_token}->{correct};
1197          undef $self->{current_token};          !!!emit ($self->{current_token}); # DOCTYPE
1198    
1199          redo A;          redo A;
1200        } else {        } else {
1201          $self->{current_token}->{name}          $self->{current_token}->{name}
1202            .= chr ($self->{next_input_character}); # DOCTYPE            .= chr ($self->{next_input_character}); # DOCTYPE
         #$self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML');  
1203          ## Stay in the state          ## Stay in the state
1204          !!!next-input-character;          !!!next-input-character;
1205          redo A;          redo A;
# Line 1473  sub _get_next_token ($) { Line 1218  sub _get_next_token ($) {
1218          !!!next-input-character;          !!!next-input-character;
1219    
1220          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1221    
1222          redo A;          redo A;
1223        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
# Line 1481  sub _get_next_token ($) { Line 1225  sub _get_next_token ($) {
1225          $self->{state} = 'data';          $self->{state} = 'data';
1226          ## reconsume          ## reconsume
1227    
1228            delete $self->{current_token}->{correct};
1229            !!!emit ($self->{current_token}); # DOCTYPE
1230    
1231            redo A;
1232          } elsif ($self->{next_input_character} == 0x0050 or # P
1233                   $self->{next_input_character} == 0x0070) { # p
1234            !!!next-input-character;
1235            if ($self->{next_input_character} == 0x0055 or # U
1236                $self->{next_input_character} == 0x0075) { # u
1237              !!!next-input-character;
1238              if ($self->{next_input_character} == 0x0042 or # B
1239                  $self->{next_input_character} == 0x0062) { # b
1240                !!!next-input-character;
1241                if ($self->{next_input_character} == 0x004C or # L
1242                    $self->{next_input_character} == 0x006C) { # l
1243                  !!!next-input-character;
1244                  if ($self->{next_input_character} == 0x0049 or # I
1245                      $self->{next_input_character} == 0x0069) { # i
1246                    !!!next-input-character;
1247                    if ($self->{next_input_character} == 0x0043 or # C
1248                        $self->{next_input_character} == 0x0063) { # c
1249                      $self->{state} = 'before DOCTYPE public identifier';
1250                      !!!next-input-character;
1251                      redo A;
1252                    }
1253                  }
1254                }
1255              }
1256            }
1257    
1258            #
1259          } elsif ($self->{next_input_character} == 0x0053 or # S
1260                   $self->{next_input_character} == 0x0073) { # s
1261            !!!next-input-character;
1262            if ($self->{next_input_character} == 0x0059 or # Y
1263                $self->{next_input_character} == 0x0079) { # y
1264              !!!next-input-character;
1265              if ($self->{next_input_character} == 0x0053 or # S
1266                  $self->{next_input_character} == 0x0073) { # s
1267                !!!next-input-character;
1268                if ($self->{next_input_character} == 0x0054 or # T
1269                    $self->{next_input_character} == 0x0074) { # t
1270                  !!!next-input-character;
1271                  if ($self->{next_input_character} == 0x0045 or # E
1272                      $self->{next_input_character} == 0x0065) { # e
1273                    !!!next-input-character;
1274                    if ($self->{next_input_character} == 0x004D or # M
1275                        $self->{next_input_character} == 0x006D) { # m
1276                      $self->{state} = 'before DOCTYPE system identifier';
1277                      !!!next-input-character;
1278                      redo A;
1279                    }
1280                  }
1281                }
1282              }
1283            }
1284    
1285            #
1286          } else {
1287            !!!next-input-character;
1288            #
1289          }
1290    
1291          !!!parse-error (type => 'string after DOCTYPE name');
1292          $self->{state} = 'bogus DOCTYPE';
1293          # next-input-character is already done
1294          redo A;
1295        } elsif ($self->{state} eq 'before DOCTYPE public identifier') {
1296          if ({
1297                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1298                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1299              }->{$self->{next_input_character}}) {
1300            ## Stay in the state
1301            !!!next-input-character;
1302            redo A;
1303          } elsif ($self->{next_input_character} eq 0x0022) { # "
1304            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1305            $self->{state} = 'DOCTYPE public identifier (double-quoted)';
1306            !!!next-input-character;
1307            redo A;
1308          } elsif ($self->{next_input_character} eq 0x0027) { # '
1309            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1310            $self->{state} = 'DOCTYPE public identifier (single-quoted)';
1311            !!!next-input-character;
1312            redo A;
1313          } elsif ($self->{next_input_character} eq 0x003E) { # >
1314            !!!parse-error (type => 'no PUBLIC literal');
1315    
1316            $self->{state} = 'data';
1317            !!!next-input-character;
1318    
1319            delete $self->{current_token}->{correct};
1320            !!!emit ($self->{current_token}); # DOCTYPE
1321    
1322            redo A;
1323          } elsif ($self->{next_input_character} == -1) {
1324            !!!parse-error (type => 'unclosed DOCTYPE');
1325    
1326            $self->{state} = 'data';
1327            ## reconsume
1328    
1329            delete $self->{current_token}->{correct};
1330            !!!emit ($self->{current_token}); # DOCTYPE
1331    
1332            redo A;
1333          } else {
1334            !!!parse-error (type => 'string after PUBLIC');
1335            $self->{state} = 'bogus DOCTYPE';
1336            !!!next-input-character;
1337            redo A;
1338          }
1339        } elsif ($self->{state} eq 'DOCTYPE public identifier (double-quoted)') {
1340          if ($self->{next_input_character} == 0x0022) { # "
1341            $self->{state} = 'after DOCTYPE public identifier';
1342            !!!next-input-character;
1343            redo A;
1344          } elsif ($self->{next_input_character} == -1) {
1345            !!!parse-error (type => 'unclosed PUBLIC literal');
1346    
1347            $self->{state} = 'data';
1348            ## reconsume
1349    
1350            delete $self->{current_token}->{correct};
1351            !!!emit ($self->{current_token}); # DOCTYPE
1352    
1353            redo A;
1354          } else {
1355            $self->{current_token}->{public_identifier} # DOCTYPE
1356                .= chr $self->{next_input_character};
1357            ## Stay in the state
1358            !!!next-input-character;
1359            redo A;
1360          }
1361        } elsif ($self->{state} eq 'DOCTYPE public identifier (single-quoted)') {
1362          if ($self->{next_input_character} == 0x0027) { # '
1363            $self->{state} = 'after DOCTYPE public identifier';
1364            !!!next-input-character;
1365            redo A;
1366          } elsif ($self->{next_input_character} == -1) {
1367            !!!parse-error (type => 'unclosed PUBLIC literal');
1368    
1369            $self->{state} = 'data';
1370            ## reconsume
1371    
1372            delete $self->{current_token}->{correct};
1373            !!!emit ($self->{current_token}); # DOCTYPE
1374    
1375            redo A;
1376          } else {
1377            $self->{current_token}->{public_identifier} # DOCTYPE
1378                .= chr $self->{next_input_character};
1379            ## Stay in the state
1380            !!!next-input-character;
1381            redo A;
1382          }
1383        } elsif ($self->{state} eq 'after DOCTYPE public identifier') {
1384          if ({
1385                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1386                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1387              }->{$self->{next_input_character}}) {
1388            ## Stay in the state
1389            !!!next-input-character;
1390            redo A;
1391          } elsif ($self->{next_input_character} == 0x0022) { # "
1392            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1393            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1394            !!!next-input-character;
1395            redo A;
1396          } elsif ($self->{next_input_character} == 0x0027) { # '
1397            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1398            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1399            !!!next-input-character;
1400            redo A;
1401          } elsif ($self->{next_input_character} == 0x003E) { # >
1402            $self->{state} = 'data';
1403            !!!next-input-character;
1404    
1405            !!!emit ($self->{current_token}); # DOCTYPE
1406    
1407            redo A;
1408          } elsif ($self->{next_input_character} == -1) {
1409            !!!parse-error (type => 'unclosed DOCTYPE');
1410    
1411            $self->{state} = 'data';
1412            ## recomsume
1413    
1414            delete $self->{current_token}->{correct};
1415            !!!emit ($self->{current_token}); # DOCTYPE
1416    
1417            redo A;
1418          } else {
1419            !!!parse-error (type => 'string after PUBLIC literal');
1420            $self->{state} = 'bogus DOCTYPE';
1421            !!!next-input-character;
1422            redo A;
1423          }
1424        } elsif ($self->{state} eq 'before DOCTYPE system identifier') {
1425          if ({
1426                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1427                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1428              }->{$self->{next_input_character}}) {
1429            ## Stay in the state
1430            !!!next-input-character;
1431            redo A;
1432          } elsif ($self->{next_input_character} == 0x0022) { # "
1433            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1434            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1435            !!!next-input-character;
1436            redo A;
1437          } elsif ($self->{next_input_character} == 0x0027) { # '
1438            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1439            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1440            !!!next-input-character;
1441            redo A;
1442          } elsif ($self->{next_input_character} == 0x003E) { # >
1443            !!!parse-error (type => 'no SYSTEM literal');
1444            $self->{state} = 'data';
1445            !!!next-input-character;
1446    
1447            delete $self->{current_token}->{correct};
1448            !!!emit ($self->{current_token}); # DOCTYPE
1449    
1450            redo A;
1451          } elsif ($self->{next_input_character} == -1) {
1452            !!!parse-error (type => 'unclosed DOCTYPE');
1453    
1454            $self->{state} = 'data';
1455            ## recomsume
1456    
1457            delete $self->{current_token}->{correct};
1458            !!!emit ($self->{current_token}); # DOCTYPE
1459    
1460            redo A;
1461          } else {
1462            !!!parse-error (type => 'string after PUBLIC literal');
1463            $self->{state} = 'bogus DOCTYPE';
1464            !!!next-input-character;
1465            redo A;
1466          }
1467        } elsif ($self->{state} eq 'DOCTYPE system identifier (double-quoted)') {
1468          if ($self->{next_input_character} == 0x0022) { # "
1469            $self->{state} = 'after DOCTYPE system identifier';
1470            !!!next-input-character;
1471            redo A;
1472          } elsif ($self->{next_input_character} == -1) {
1473            !!!parse-error (type => 'unclosed SYSTEM literal');
1474    
1475            $self->{state} = 'data';
1476            ## reconsume
1477    
1478            delete $self->{current_token}->{correct};
1479            !!!emit ($self->{current_token}); # DOCTYPE
1480    
1481            redo A;
1482          } else {
1483            $self->{current_token}->{system_identifier} # DOCTYPE
1484                .= chr $self->{next_input_character};
1485            ## Stay in the state
1486            !!!next-input-character;
1487            redo A;
1488          }
1489        } elsif ($self->{state} eq 'DOCTYPE system identifier (single-quoted)') {
1490          if ($self->{next_input_character} == 0x0027) { # '
1491            $self->{state} = 'after DOCTYPE system identifier';
1492            !!!next-input-character;
1493            redo A;
1494          } elsif ($self->{next_input_character} == -1) {
1495            !!!parse-error (type => 'unclosed SYSTEM literal');
1496    
1497            $self->{state} = 'data';
1498            ## reconsume
1499    
1500            delete $self->{current_token}->{correct};
1501            !!!emit ($self->{current_token}); # DOCTYPE
1502    
1503            redo A;
1504          } else {
1505            $self->{current_token}->{system_identifier} # DOCTYPE
1506                .= chr $self->{next_input_character};
1507            ## Stay in the state
1508            !!!next-input-character;
1509            redo A;
1510          }
1511        } elsif ($self->{state} eq 'after DOCTYPE system identifier') {
1512          if ({
1513                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1514                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1515              }->{$self->{next_input_character}}) {
1516            ## Stay in the state
1517            !!!next-input-character;
1518            redo A;
1519          } elsif ($self->{next_input_character} == 0x003E) { # >
1520            $self->{state} = 'data';
1521            !!!next-input-character;
1522    
1523            !!!emit ($self->{current_token}); # DOCTYPE
1524    
1525            redo A;
1526          } elsif ($self->{next_input_character} == -1) {
1527            !!!parse-error (type => 'unclosed DOCTYPE');
1528    
1529            $self->{state} = 'data';
1530            ## recomsume
1531    
1532            delete $self->{current_token}->{correct};
1533          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1534    
1535          redo A;          redo A;
1536        } else {        } else {
1537          !!!parse-error (type => 'string after DOCTYPE name');          !!!parse-error (type => 'string after SYSTEM literal');
         $self->{current_token}->{error} = 1; # DOCTYPE  
1538          $self->{state} = 'bogus DOCTYPE';          $self->{state} = 'bogus DOCTYPE';
1539          !!!next-input-character;          !!!next-input-character;
1540          redo A;          redo A;
# Line 1497  sub _get_next_token ($) { Line 1544  sub _get_next_token ($) {
1544          $self->{state} = 'data';          $self->{state} = 'data';
1545          !!!next-input-character;          !!!next-input-character;
1546    
1547            delete $self->{current_token}->{correct};
1548          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1549    
1550          redo A;          redo A;
1551        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
# Line 1506  sub _get_next_token ($) { Line 1553  sub _get_next_token ($) {
1553          $self->{state} = 'data';          $self->{state} = 'data';
1554          ## reconsume          ## reconsume
1555    
1556            delete $self->{current_token}->{correct};
1557          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1558    
1559          redo A;          redo A;
1560        } else {        } else {
# Line 1525  sub _get_next_token ($) { Line 1572  sub _get_next_token ($) {
1572    
1573  sub _tokenize_attempt_to_consume_an_entity ($) {  sub _tokenize_attempt_to_consume_an_entity ($) {
1574    my $self = shift;    my $self = shift;
1575      
1576    if ($self->{next_input_character} == 0x0023) { # #    if ({
1577           0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
1578           0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR
1579          }->{$self->{next_input_character}}) {
1580        ## Don't consume
1581        ## No error
1582        return undef;
1583      } elsif ($self->{next_input_character} == 0x0023) { # #
1584      !!!next-input-character;      !!!next-input-character;
1585      if ($self->{next_input_character} == 0x0078 or # x      if ($self->{next_input_character} == 0x0078 or # x
1586          $self->{next_input_character} == 0x0058) { # X          $self->{next_input_character} == 0x0058) { # X
# Line 1621  sub _tokenize_attempt_to_consume_an_enti Line 1675  sub _tokenize_attempt_to_consume_an_enti
1675    
1676      my $value = $entity_name;      my $value = $entity_name;
1677      my $match;      my $match;
1678        require Whatpm::_NamedEntityList;
1679        our $EntityChar;
1680    
1681      while (length $entity_name < 10 and      while (length $entity_name < 10 and
1682             ## NOTE: Some number greater than the maximum length of entity name             ## NOTE: Some number greater than the maximum length of entity name
1683             ((0x0041 <= $self->{next_input_character} and             ((0x0041 <= $self->{next_input_character} and # a
1684               $self->{next_input_character} <= 0x005A) or               $self->{next_input_character} <= 0x005A) or # x
1685              (0x0061 <= $self->{next_input_character} and              (0x0061 <= $self->{next_input_character} and # a
1686               $self->{next_input_character} <= 0x007A) or               $self->{next_input_character} <= 0x007A) or # z
1687              (0x0030 <= $self->{next_input_character} and              (0x0030 <= $self->{next_input_character} and # 0
1688               $self->{next_input_character} <= 0x0039))) {               $self->{next_input_character} <= 0x0039) or # 9
1689                $self->{next_input_character} == 0x003B)) { # ;
1690        $entity_name .= chr $self->{next_input_character};        $entity_name .= chr $self->{next_input_character};
1691        if (defined $entity_char->{$entity_name}) {        if (defined $EntityChar->{$entity_name}) {
1692          $value = $entity_char->{$entity_name};          $value = $EntityChar->{$entity_name};
1693          $match = 1;          if ($self->{next_input_character} == 0x003B) { # ;
1694              $match = 1;
1695              !!!next-input-character;
1696              last;
1697            } else {
1698              $match = -1;
1699            }
1700        } else {        } else {
1701          $value .= chr $self->{next_input_character};          $value .= chr $self->{next_input_character};
1702        }        }
1703        !!!next-input-character;        !!!next-input-character;
1704      }      }
1705            
1706      if ($match) {      if ($match > 0) {
1707        if ($self->{next_input_character} == 0x003B) { # ;        return {type => 'character', data => $value};
1708          !!!next-input-character;      } elsif ($match < 0) {
1709        } else {        !!!parse-error (type => 'refc');
         !!!parse-error (type => 'refc');  
       }  
   
1710        return {type => 'character', data => $value};        return {type => 'character', data => $value};
1711      } else {      } else {
1712        !!!parse-error (type => 'bare ero');        !!!parse-error (type => 'bare ero');
# Line 1667  sub _initialize_tree_constructor ($) { Line 1727  sub _initialize_tree_constructor ($) {
1727    $self->{document}->strict_error_checking (0);    $self->{document}->strict_error_checking (0);
1728    ## TODO: Turn mutation events off # MUST    ## TODO: Turn mutation events off # MUST
1729    ## TODO: Turn loose Document option (manakai extension) on    ## TODO: Turn loose Document option (manakai extension) on
1730    ## TODO: Mark the Document as an HTML document # MUST    $self->{document}->manakai_is_html (1); # MUST
1731  } # _initialize_tree_constructor  } # _initialize_tree_constructor
1732    
1733  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 1707  sub _construct_tree ($) { Line 1767  sub _construct_tree ($) {
1767    
1768  sub _tree_construction_initial ($) {  sub _tree_construction_initial ($) {
1769    my $self = shift;    my $self = shift;
1770    B: {    INITIAL: {
1771        if ($token->{type} eq 'DOCTYPE') {      if ($token->{type} eq 'DOCTYPE') {
1772          if ($token->{error}) {        ## NOTE: Conformance checkers MAY, instead of reporting "not HTML5"
1773            ## ISSUE: Spec currently left this case undefined.        ## error, switch to a conformance checking mode for another
1774            !!!parse-error (type => 'bogus DOCTYPE');        ## language.
1775          }        my $doctype_name = $token->{name};
1776          my $doctype = $self->{document}->create_document_type_definition        $doctype_name = '' unless defined $doctype_name;
1777            ($token->{name});        $doctype_name =~ tr/a-z/A-Z/;
1778          $self->{document}->append_child ($doctype);        if (not defined $token->{name} or # <!DOCTYPE>
1779          #$phase = 'root element';            defined $token->{public_identifier} or
1780          !!!next-token;            defined $token->{system_identifier}) {
1781          #redo B;          !!!parse-error (type => 'not HTML5');
1782          return;        } elsif ($doctype_name ne 'HTML') {
1783        } elsif ({          ## ISSUE: ASCII case-insensitive? (in fact it does not matter)
1784                  comment => 1,          !!!parse-error (type => 'not HTML5');
1785                  'start tag' => 1,        }
1786                  'end tag' => 1,        
1787                  'end-of-file' => 1,        my $doctype = $self->{document}->create_document_type_definition
1788                 }->{$token->{type}}) {          ($token->{name}); ## ISSUE: If name is missing (e.g. <!DOCTYPE>)?
1789          ## ISSUE: Spec currently left this case undefined.        $doctype->public_id ($token->{public_identifier})
1790          !!!parse-error (type => 'missing DOCTYPE');            if defined $token->{public_identifier};
1791          #$phase = 'root element';        $doctype->system_id ($token->{system_identifier})
1792          ## reprocess            if defined $token->{system_identifier};
1793          #redo B;        ## NOTE: Other DocumentType attributes are null or empty lists.
1794          return;        ## ISSUE: internalSubset = null??
1795        } elsif ($token->{type} eq 'character') {        $self->{document}->append_child ($doctype);
1796          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {        
1797            $self->{document}->manakai_append_text ($1);        if (not $token->{correct} or $doctype_name ne 'HTML') {
1798            ## ISSUE: DOM3 Core does not allow Document > Text          $self->{document}->manakai_compat_mode ('quirks');
1799            unless (length $token->{data}) {        } elsif (defined $token->{public_identifier}) {
1800              ## Stay in the phase          my $pubid = $token->{public_identifier};
1801              !!!next-token;          $pubid =~ tr/a-z/A-z/;
1802              redo B;          if ({
1803              "+//SILMARIL//DTD HTML PRO V0R11 19970101//EN" => 1,
1804              "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1805              "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1806              "-//IETF//DTD HTML 2.0 LEVEL 1//EN" => 1,
1807              "-//IETF//DTD HTML 2.0 LEVEL 2//EN" => 1,
1808              "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//EN" => 1,
1809              "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//EN" => 1,
1810              "-//IETF//DTD HTML 2.0 STRICT//EN" => 1,
1811              "-//IETF//DTD HTML 2.0//EN" => 1,
1812              "-//IETF//DTD HTML 2.1E//EN" => 1,
1813              "-//IETF//DTD HTML 3.0//EN" => 1,
1814              "-//IETF//DTD HTML 3.0//EN//" => 1,
1815              "-//IETF//DTD HTML 3.2 FINAL//EN" => 1,
1816              "-//IETF//DTD HTML 3.2//EN" => 1,
1817              "-//IETF//DTD HTML 3//EN" => 1,
1818              "-//IETF//DTD HTML LEVEL 0//EN" => 1,
1819              "-//IETF//DTD HTML LEVEL 0//EN//2.0" => 1,
1820              "-//IETF//DTD HTML LEVEL 1//EN" => 1,
1821              "-//IETF//DTD HTML LEVEL 1//EN//2.0" => 1,
1822              "-//IETF//DTD HTML LEVEL 2//EN" => 1,
1823              "-//IETF//DTD HTML LEVEL 2//EN//2.0" => 1,
1824              "-//IETF//DTD HTML LEVEL 3//EN" => 1,
1825              "-//IETF//DTD HTML LEVEL 3//EN//3.0" => 1,
1826              "-//IETF//DTD HTML STRICT LEVEL 0//EN" => 1,
1827              "-//IETF//DTD HTML STRICT LEVEL 0//EN//2.0" => 1,
1828              "-//IETF//DTD HTML STRICT LEVEL 1//EN" => 1,
1829              "-//IETF//DTD HTML STRICT LEVEL 1//EN//2.0" => 1,
1830              "-//IETF//DTD HTML STRICT LEVEL 2//EN" => 1,
1831              "-//IETF//DTD HTML STRICT LEVEL 2//EN//2.0" => 1,
1832              "-//IETF//DTD HTML STRICT LEVEL 3//EN" => 1,
1833              "-//IETF//DTD HTML STRICT LEVEL 3//EN//3.0" => 1,
1834              "-//IETF//DTD HTML STRICT//EN" => 1,
1835              "-//IETF//DTD HTML STRICT//EN//2.0" => 1,
1836              "-//IETF//DTD HTML STRICT//EN//3.0" => 1,
1837              "-//IETF//DTD HTML//EN" => 1,
1838              "-//IETF//DTD HTML//EN//2.0" => 1,
1839              "-//IETF//DTD HTML//EN//3.0" => 1,
1840              "-//METRIUS//DTD METRIUS PRESENTATIONAL//EN" => 1,
1841              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//EN" => 1,
1842              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//EN" => 1,
1843              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//EN" => 1,
1844              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//EN" => 1,
1845              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//EN" => 1,
1846              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//EN" => 1,
1847              "-//NETSCAPE COMM. CORP.//DTD HTML//EN" => 1,
1848              "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//EN" => 1,
1849              "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//EN" => 1,
1850              "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//EN" => 1,
1851              "-//SPYGLASS//DTD HTML 2.0 EXTENDED//EN" => 1,
1852              "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//EN" => 1,
1853              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//EN" => 1,
1854              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//EN" => 1,
1855              "-//W3C//DTD HTML 3 1995-03-24//EN" => 1,
1856              "-//W3C//DTD HTML 3.2 DRAFT//EN" => 1,
1857              "-//W3C//DTD HTML 3.2 FINAL//EN" => 1,
1858              "-//W3C//DTD HTML 3.2//EN" => 1,
1859              "-//W3C//DTD HTML 3.2S DRAFT//EN" => 1,
1860              "-//W3C//DTD HTML 4.0 FRAMESET//EN" => 1,
1861              "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN" => 1,
1862              "-//W3C//DTD HTML EXPERIMETNAL 19960712//EN" => 1,
1863              "-//W3C//DTD HTML EXPERIMENTAL 970421//EN" => 1,
1864              "-//W3C//DTD W3 HTML//EN" => 1,
1865              "-//W3O//DTD W3 HTML 3.0//EN" => 1,
1866              "-//W3O//DTD W3 HTML 3.0//EN//" => 1,
1867              "-//W3O//DTD W3 HTML STRICT 3.0//EN//" => 1,
1868              "-//WEBTECHS//DTD MOZILLA HTML 2.0//EN" => 1,
1869              "-//WEBTECHS//DTD MOZILLA HTML//EN" => 1,
1870              "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" => 1,
1871              "HTML" => 1,
1872            }->{$pubid}) {
1873              $self->{document}->manakai_compat_mode ('quirks');
1874            } elsif ($pubid eq "-//W3C//DTD HTML 4.01 FRAMESET//EN" or
1875                     $pubid eq "-//W3C//DTD HTML 4.01 TRANSITIONAL//EN") {
1876              if (defined $token->{system_identifier}) {
1877                $self->{document}->manakai_compat_mode ('quirks');
1878              } else {
1879                $self->{document}->manakai_compat_mode ('limited quirks');
1880            }            }
1881            } elsif ($pubid eq "-//W3C//DTD XHTML 1.0 Frameset//EN" or
1882                     $pubid eq "-//W3C//DTD XHTML 1.0 Transitional//EN") {
1883              $self->{document}->manakai_compat_mode ('limited quirks');
1884            }
1885          }
1886          if (defined $token->{system_identifier}) {
1887            my $sysid = $token->{system_identifier};
1888            $sysid =~ tr/A-Z/a-z/;
1889            if ($sysid eq "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd") {
1890              $self->{document}->manakai_compat_mode ('quirks');
1891            }
1892          }
1893          
1894          ## Go to the root element phase.
1895          !!!next-token;
1896          return;
1897        } elsif ({
1898                  'start tag' => 1,
1899                  'end tag' => 1,
1900                  'end-of-file' => 1,
1901                 }->{$token->{type}}) {
1902          !!!parse-error (type => 'no DOCTYPE');
1903          $self->{document}->manakai_compat_mode ('quirks');
1904          ## Go to the root element phase
1905          ## reprocess
1906          return;
1907        } elsif ($token->{type} eq 'character') {
1908          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
1909            ## Ignore the token
1910            unless (length $token->{data}) {
1911              ## Stay in the phase
1912              !!!next-token;
1913              redo INITIAL;
1914          }          }
         ## 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";  
1915        }        }
1916      } # B  
1917          !!!parse-error (type => 'no DOCTYPE');
1918          $self->{document}->manakai_compat_mode ('quirks');
1919          ## Go to the root element phase
1920          ## reprocess
1921          return;
1922        } elsif ($token->{type} eq 'comment') {
1923          my $comment = $self->{document}->create_comment ($token->{data});
1924          $self->{document}->append_child ($comment);
1925          
1926          ## Stay in the phase.
1927          !!!next-token;
1928          redo INITIAL;
1929        } else {
1930          die "$0: $token->{type}: Unknown token";
1931        }
1932      } # INITIAL
1933  } # _tree_construction_initial  } # _tree_construction_initial
1934    
1935  sub _tree_construction_root_element ($) {  sub _tree_construction_root_element ($) {
# Line 1950  sub _tree_construction_main ($) { Line 2128  sub _tree_construction_main ($) {
2128      }      }
2129    }; # $clear_up_to_marker    }; # $clear_up_to_marker
2130    
2131    my $style_start_tag = sub {    my $parse_rcdata = sub ($$) {
2132      my $style_el; !!!create-element ($style_el, 'style', $token->{attributes});      my ($content_model_flag, $insert) = @_;
2133      ## $self->{insertion_mode} eq 'in head' and ... (always true)  
2134      (($self->{insertion_mode} eq 'in head' and defined $self->{head_element})      ## Step 1
2135       ? $self->{head_element} : $self->{open_elements}->[-1]->[0])      my $start_tag_name = $token->{tag_name};
2136        ->append_child ($style_el);      my $el;
2137      $self->{content_model_flag} = 'CDATA';      !!!create-element ($el, $start_tag_name, $token->{attributes});
2138    
2139        ## Step 2
2140        $insert->($el); # /context node/->append_child ($el)
2141    
2142        ## Step 3
2143        $self->{content_model_flag} = $content_model_flag; # CDATA or RCDATA
2144      delete $self->{escape}; # MUST      delete $self->{escape}; # MUST
2145                  
2146        ## Step 4
2147      my $text = '';      my $text = '';
2148      !!!next-token;      !!!next-token;
2149      while ($token->{type} eq 'character') {      while ($token->{type} eq 'character') { # or until stop tokenizing
2150        $text .= $token->{data};        $text .= $token->{data};
2151        !!!next-token;        !!!next-token;
2152      } # stop if non-character token or tokenizer stops tokenising      }
2153    
2154        ## Step 5
2155      if (length $text) {      if (length $text) {
2156        $style_el->manakai_append_text ($text);        my $text = $self->{document}->create_text_node ($text);
2157          $el->append_child ($text);
2158      }      }
2159        
2160        ## Step 6
2161      $self->{content_model_flag} = 'PCDATA';      $self->{content_model_flag} = 'PCDATA';
2162                  
2163      if ($token->{type} eq 'end tag' and $token->{tag_name} eq 'style') {      ## Step 7
2164        if ($token->{type} eq 'end tag' and $token->{tag_name} eq $start_tag_name) {
2165        ## Ignore the token        ## Ignore the token
2166      } else {      } else {
2167        !!!parse-error (type => 'in CDATA:#'.$token->{type});        !!!parse-error (type => 'in '.$content_model_flag.':#'.$token->{type});
       ## ISSUE: And ignore?  
2168      }      }
2169      !!!next-token;      !!!next-token;
2170    }; # $style_start_tag    }; # $parse_rcdata
2171    
2172    my $script_start_tag = sub {    my $script_start_tag = sub ($) {
2173        my $insert = $_[0];
2174      my $script_el;      my $script_el;
2175      !!!create-element ($script_el, 'script', $token->{attributes});      !!!create-element ($script_el, 'script', $token->{attributes});
2176      ## TODO: mark as "parser-inserted"      ## TODO: mark as "parser-inserted"
# Line 2014  sub _tree_construction_main ($) { Line 2204  sub _tree_construction_main ($) {
2204      } else {      } else {
2205        ## TODO: $old_insertion_point = current insertion point        ## TODO: $old_insertion_point = current insertion point
2206        ## TODO: insertion point = just before the next input character        ## TODO: insertion point = just before the next input character
2207          
2208        (($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);  
2209                
2210        ## TODO: insertion point = $old_insertion_point (might be "undefined")        ## TODO: insertion point = $old_insertion_point (might be "undefined")
2211                
# Line 2210  sub _tree_construction_main ($) { Line 2399  sub _tree_construction_main ($) {
2399    }; # $formatting_end_tag    }; # $formatting_end_tag
2400    
2401    my $insert_to_current = sub {    my $insert_to_current = sub {
2402      $self->{open_elements}->[-1]->[0]->append_child (shift);      $self->{open_elements}->[-1]->[0]->append_child ($_[0]);
2403    }; # $insert_to_current    }; # $insert_to_current
2404    
2405    my $insert_to_foster = sub {    my $insert_to_foster = sub {
# Line 2248  sub _tree_construction_main ($) { Line 2437  sub _tree_construction_main ($) {
2437      my $insert = shift;      my $insert = shift;
2438      if ($token->{type} eq 'start tag') {      if ($token->{type} eq 'start tag') {
2439        if ($token->{tag_name} eq 'script') {        if ($token->{tag_name} eq 'script') {
2440          $script_start_tag->();          ## NOTE: This is an "as if in head" code clone
2441            $script_start_tag->($insert);
2442          return;          return;
2443        } elsif ($token->{tag_name} eq 'style') {        } elsif ($token->{tag_name} eq 'style') {
2444          $style_start_tag->();          ## NOTE: This is an "as if in head" code clone
2445            $parse_rcdata->('CDATA', $insert);
2446          return;          return;
2447        } elsif ({        } elsif ({
2448                  base => 1, link => 1, meta => 1,                  base => 1, link => 1, meta => 1,
2449                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2450          !!!parse-error (type => 'in body:'.$token->{tag_name});          ## NOTE: This is an "as if in head" code clone, only "-t" differs
2451          ## NOTE: This is an "as if in head" code clone          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2452          my $el;          pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
         !!!create-element ($el, $token->{tag_name}, $token->{attributes});  
         if (defined $self->{head_element}) {  
           $self->{head_element}->append_child ($el);  
         } else {  
           $insert->($el);  
         }  
           
2453          !!!next-token;          !!!next-token;
2454          return;          return;
2455        } elsif ($token->{tag_name} eq 'title') {        } elsif ($token->{tag_name} eq 'title') {
2456          !!!parse-error (type => 'in body:title');          !!!parse-error (type => 'in body:title');
2457          ## NOTE: There is an "as if in head" code clone          ## NOTE: This is an "as if in head" code clone
2458          my $title_el;          $parse_rcdata->('RCDATA', $insert);
         !!!create-element ($title_el, 'title', $token->{attributes});  
         (defined $self->{head_element} ? $self->{head_element} : $self->{open_elements}->[-1]->[0])  
           ->append_child ($title_el);  
         $self->{content_model_flag} = 'RCDATA';  
         delete $self->{escape}; # MUST  
           
         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;  
2459          return;          return;
2460        } elsif ($token->{tag_name} eq 'body') {        } elsif ($token->{tag_name} eq 'body') {
2461          !!!parse-error (type => 'in body:body');          !!!parse-error (type => 'in body:body');
# Line 2511  sub _tree_construction_main ($) { Line 2669  sub _tree_construction_main ($) {
2669            }            }
2670          } # INSCOPE          } # INSCOPE
2671                        
2672            ## NOTE: See <http://html5.org/tools/web-apps-tracker?from=925&to=926>
2673          ## has an element in scope          ## has an element in scope
2674          my $i;          #my $i;
2675          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {          #INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2676            my $node = $self->{open_elements}->[$_];          #  my $node = $self->{open_elements}->[$_];
2677            if ({          #  if ({
2678                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,          #       h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
2679                }->{$node->[1]}) {          #      }->{$node->[1]}) {
2680              $i = $_;          #    $i = $_;
2681              last INSCOPE;          #    last INSCOPE;
2682            } elsif ({          #  } elsif ({
2683                      table => 1, caption => 1, td => 1, th => 1,          #            table => 1, caption => 1, td => 1, th => 1,
2684                      button => 1, marquee => 1, object => 1, html => 1,          #            button => 1, marquee => 1, object => 1, html => 1,
2685                     }->{$node->[1]}) {          #           }->{$node->[1]}) {
2686              last INSCOPE;          #    last INSCOPE;
2687            }          #  }
2688          } # INSCOPE          #} # INSCOPE
2689                      #  
2690          if (defined $i) {          #if (defined $i) {
2691            !!!parse-error (type => 'in hn:hn');          #  !!! parse-error (type => 'in hn:hn');
2692            splice @{$self->{open_elements}}, $i;          #  splice @{$self->{open_elements}}, $i;
2693          }          #}
2694                        
2695          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2696                        
# Line 2574  sub _tree_construction_main ($) { Line 2733  sub _tree_construction_main ($) {
2733          return;          return;
2734        } elsif ({        } elsif ({
2735                  b => 1, big => 1, em => 1, font => 1, i => 1,                  b => 1, big => 1, em => 1, font => 1, i => 1,
2736                  nobr => 1, s => 1, small => 1, strile => 1,                  s => 1, small => 1, strile => 1,
2737                  strong => 1, tt => 1, u => 1,                  strong => 1, tt => 1, u => 1,
2738                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2739          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
# Line 2584  sub _tree_construction_main ($) { Line 2743  sub _tree_construction_main ($) {
2743                    
2744          !!!next-token;          !!!next-token;
2745          return;          return;
2746          } elsif ($token->{tag_name} eq 'nobr') {
2747            $reconstruct_active_formatting_elements->($insert_to_current);
2748    
2749            ## has a |nobr| element in scope
2750            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2751              my $node = $self->{open_elements}->[$_];
2752              if ($node->[1] eq 'nobr') {
2753                !!!back-token;
2754                $token = {type => 'end tag', tag_name => 'nobr'};
2755                return;
2756              } elsif ({
2757                        table => 1, caption => 1, td => 1, th => 1,
2758                        button => 1, marquee => 1, object => 1, html => 1,
2759                       }->{$node->[1]}) {
2760                last INSCOPE;
2761              }
2762            } # INSCOPE
2763            
2764            !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2765            push @$active_formatting_elements, $self->{open_elements}->[-1];
2766            
2767            !!!next-token;
2768            return;
2769        } elsif ($token->{tag_name} eq 'button') {        } elsif ($token->{tag_name} eq 'button') {
2770          ## has a button element in scope          ## has a button element in scope
2771          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
# Line 2619  sub _tree_construction_main ($) { Line 2801  sub _tree_construction_main ($) {
2801          return;          return;
2802        } elsif ($token->{tag_name} eq 'xmp') {        } elsif ($token->{tag_name} eq 'xmp') {
2803          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2804                    $parse_rcdata->('CDATA', $insert);
         !!!insert-element-t ($token->{tag_name}, $token->{attributes});  
           
         $self->{content_model_flag} = 'CDATA';  
         delete $self->{escape}; # MUST  
           
         !!!next-token;  
2805          return;          return;
2806        } elsif ($token->{tag_name} eq 'table') {        } elsif ($token->{tag_name} eq 'table') {
2807          ## has a p element in scope          ## has a p element in scope
# Line 2703  sub _tree_construction_main ($) { Line 2879  sub _tree_construction_main ($) {
2879            return;            return;
2880          } else {          } else {
2881            my $at = $token->{attributes};            my $at = $token->{attributes};
2882              my $form_attrs;
2883              $form_attrs->{action} = $at->{action} if $at->{action};
2884              my $prompt_attr = $at->{prompt};
2885            $at->{name} = {name => 'name', value => 'isindex'};            $at->{name} = {name => 'name', value => 'isindex'};
2886              delete $at->{action};
2887              delete $at->{prompt};
2888            my @tokens = (            my @tokens = (
2889                          {type => 'start tag', tag_name => 'form'},                          {type => 'start tag', tag_name => 'form',
2890                             attributes => $form_attrs},
2891                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2892                          {type => 'start tag', tag_name => 'p'},                          {type => 'start tag', tag_name => 'p'},
2893                          {type => 'start tag', tag_name => 'label'},                          {type => 'start tag', tag_name => 'label'},
2894                          {type => 'character',                         );
2895                           data => 'This is a searchable index. Insert your search keywords here: '}, # SHOULD            if ($prompt_attr) {
2896                          ## TODO: make this configurable              push @tokens, {type => 'character', data => $prompt_attr->{value}};
2897              } else {
2898                push @tokens, {type => 'character',
2899                               data => 'This is a searchable index. Insert your search keywords here: '}; # SHOULD
2900                ## TODO: make this configurable
2901              }
2902              push @tokens,
2903                          {type => 'start tag', tag_name => 'input', attributes => $at},                          {type => 'start tag', tag_name => 'input', attributes => $at},
2904                          #{type => 'character', data => ''}, # SHOULD                          #{type => 'character', data => ''}, # SHOULD
2905                          {type => 'end tag', tag_name => 'label'},                          {type => 'end tag', tag_name => 'label'},
2906                          {type => 'end tag', tag_name => 'p'},                          {type => 'end tag', tag_name => 'p'},
2907                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2908                          {type => 'end tag', tag_name => 'form'},                          {type => 'end tag', tag_name => 'form'};
                        );  
2909            $token = shift @tokens;            $token = shift @tokens;
2910            !!!back-token (@tokens);            !!!back-token (@tokens);
2911            return;            return;
2912          }          }
2913        } 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}}) {  
2914          my $tag_name = $token->{tag_name};          my $tag_name = $token->{tag_name};
2915          my $el;          my $el;
2916          !!!create-element ($el, $token->{tag_name}, $token->{attributes});          !!!create-element ($el, $token->{tag_name}, $token->{attributes});
2917                    
2918          if ($token->{tag_name} eq 'textarea') {          ## TODO: $self->{form_element} if defined
2919            ## TODO: $self->{form_element} if defined          $self->{content_model_flag} = 'RCDATA';
           $self->{content_model_flag} = 'RCDATA';  
         } else {  
           $self->{content_model_flag} = 'CDATA';  
         }  
2920          delete $self->{escape}; # MUST          delete $self->{escape}; # MUST
2921                    
2922          $insert->($el);          $insert->($el);
2923                    
2924          my $text = '';          my $text = '';
2925          if ($token->{tag_name} eq 'textarea') {          !!!next-token;
2926            !!!next-token;          if ($token->{type} eq 'character') {
2927            if ($token->{type} eq 'character') {            $token->{data} =~ s/^\x0A//;
2928              $token->{data} =~ s/^\x0A//;            unless (length $token->{data}) {
2929              unless (length $token->{data}) {              !!!next-token;
               !!!next-token;  
             }  
2930            }            }
         } else {  
           !!!next-token;  
2931          }          }
2932          while ($token->{type} eq 'character') {          while ($token->{type} eq 'character') {
2933            $text .= $token->{data};            $text .= $token->{data};
# Line 2770  sub _tree_construction_main ($) { Line 2943  sub _tree_construction_main ($) {
2943              $token->{tag_name} eq $tag_name) {              $token->{tag_name} eq $tag_name) {
2944            ## Ignore the token            ## Ignore the token
2945          } else {          } else {
2946            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?  
2947          }          }
2948          !!!next-token;          !!!next-token;
2949          return;          return;
2950          } elsif ({
2951                    iframe => 1,
2952                    noembed => 1,
2953                    noframes => 1,
2954                    noscript => 0, ## TODO: 1 if scripting is enabled
2955                   }->{$token->{tag_name}}) {
2956            $parse_rcdata->('CDATA', $insert);
2957            return;
2958        } elsif ($token->{tag_name} eq 'select') {        } elsif ($token->{tag_name} eq 'select') {
2959          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2960                    
# Line 2809  sub _tree_construction_main ($) { Line 2985  sub _tree_construction_main ($) {
2985        }        }
2986      } elsif ($token->{type} eq 'end tag') {      } elsif ($token->{type} eq 'end tag') {
2987        if ($token->{tag_name} eq 'body') {        if ($token->{tag_name} eq 'body') {
2988          if (@{$self->{open_elements}} > 1 and $self->{open_elements}->[1]->[1] eq 'body') {          if (@{$self->{open_elements}} > 1 and
2989            ## ISSUE: There is an issue in the spec.              $self->{open_elements}->[1]->[1] eq 'body') {
2990            if ($self->{open_elements}->[-1]->[1] ne 'body') {            for (@{$self->{open_elements}}) {
2991              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);              unless ({
2992                           dd => 1, dt => 1, li => 1, p => 1, td => 1,
2993                           th => 1, tr => 1, body => 1, html => 1,
2994                        }->{$_->[1]}) {
2995                  !!!parse-error (type => 'not closed:'.$_->[1]);
2996                }
2997            }            }
2998    
2999            $self->{insertion_mode} = 'after body';            $self->{insertion_mode} = 'after body';
3000            !!!next-token;            !!!next-token;
3001            return;            return;
# Line 3019  sub _tree_construction_main ($) { Line 3201  sub _tree_construction_main ($) {
3201                  #not $phrasing_category->{$node->[1]} and                  #not $phrasing_category->{$node->[1]} and
3202                  ($special_category->{$node->[1]} or                  ($special_category->{$node->[1]} or
3203                   $scoping_category->{$node->[1]})) {                   $scoping_category->{$node->[1]})) {
3204                !!!parse-error (type => 'not closed:'.$node->[1]);                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3205                ## Ignore the token                ## Ignore the token
3206                !!!next-token;                !!!next-token;
3207                last S2;                last S2;
# Line 3122  sub _tree_construction_main ($) { Line 3304  sub _tree_construction_main ($) {
3304              }              }
3305              redo B;              redo B;
3306            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3307              if ($token->{tag_name} eq 'html') {              if ({head => 1, body => 1, html => 1}->{$token->{tag_name}}) {
3308                ## As if <head>                ## As if <head>
3309                !!!create-element ($self->{head_element}, 'head');                !!!create-element ($self->{head_element}, 'head');
3310                $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 3314  sub _tree_construction_main ($) {
3314                redo B;                redo B;
3315              } else {              } else {
3316                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3317                ## Ignore the token                ## Ignore the token ## ISSUE: An issue in the spec.
3318                !!!next-token;                !!!next-token;
3319                redo B;                redo B;
3320              }              }
3321            } else {            } else {
3322              die "$0: $token->{type}: Unknown type";              die "$0: $token->{type}: Unknown type";
3323            }            }
3324          } elsif ($self->{insertion_mode} eq 'in head') {          } elsif ($self->{insertion_mode} eq 'in head' or
3325                     $self->{insertion_mode} eq 'in head noscript' or
3326                     $self->{insertion_mode} eq 'after head') {
3327            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3328              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3329                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
# Line 3156  sub _tree_construction_main ($) { Line 3340  sub _tree_construction_main ($) {
3340              !!!next-token;              !!!next-token;
3341              redo B;              redo B;
3342            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3343              if ($token->{tag_name} eq 'title') {              if ({base => ($self->{insertion_mode} eq 'in head' or
3344                ## NOTE: There is an "as if in head" code clone                            $self->{insertion_mode} eq 'after head'),
3345                my $title_el;                   link => 1, meta => 1}->{$token->{tag_name}}) {
3346                !!!create-element ($title_el, 'title', $token->{attributes});                ## NOTE: There is a "as if in head" code clone.
3347                (defined $self->{head_element} ? $self->{head_element} : $self->{open_elements}->[-1]->[0])                if ($self->{insertion_mode} eq 'after head') {
3348                  ->append_child ($title_el);                  !!!parse-error (type => 'after head:'.$token->{tag_name});
3349                $self->{content_model_flag} = 'RCDATA';                  push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3350                delete $self->{escape}; # MUST                }
3351                  !!!insert-element ($token->{tag_name}, $token->{attributes});
3352                my $text = '';                pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
3353                  pop @{$self->{open_elements}}
3354                      if $self->{insertion_mode} eq 'after head';
3355                !!!next-token;                !!!next-token;
3356                while ($token->{type} eq 'character') {                redo B;
3357                  $text .= $token->{data};              } elsif ($token->{tag_name} eq 'title' and
3358                         $self->{insertion_mode} eq 'in head') {
3359                  ## NOTE: There is a "as if in head" code clone.
3360                  if ($self->{insertion_mode} eq 'after head') {
3361                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3362                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3363                  }
3364                  $parse_rcdata->('RCDATA', $insert_to_current);
3365                  pop @{$self->{open_elements}}
3366                      if $self->{insertion_mode} eq 'after head';
3367                  redo B;
3368                } elsif ($token->{tag_name} eq 'style') {
3369                  ## NOTE: Or (scripting is enabled and tag_name eq 'noscript' and
3370                  ## insertion mode 'in head')
3371                  ## NOTE: There is a "as if in head" code clone.
3372                  if ($self->{insertion_mode} eq 'after head') {
3373                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3374                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3375                  }
3376                  $parse_rcdata->('CDATA', $insert_to_current);
3377                  pop @{$self->{open_elements}}
3378                      if $self->{insertion_mode} eq 'after head';
3379                  redo B;
3380                } elsif ($token->{tag_name} eq 'noscript') {
3381                  if ($self->{insertion_mode} eq 'in head') {
3382                    ## NOTE: and scripting is disalbed
3383                    !!!insert-element ($token->{tag_name}, $token->{attributes});
3384                    $self->{insertion_mode} = 'in head noscript';
3385                  !!!next-token;                  !!!next-token;
3386                }                  redo B;
3387                if (length $text) {                } elsif ($self->{insertion_mode} eq 'in head noscript') {
3388                  $title_el->manakai_append_text ($text);                  !!!parse-error (type => 'noscript in noscript');
               }  
                 
               $self->{content_model_flag} = 'PCDATA';  
                 
               if ($token->{type} eq 'end tag' and  
                   $token->{tag_name} eq 'title') {  
3389                  ## Ignore the token                  ## Ignore the token
3390                    redo B;
3391                } else {                } else {
3392                  !!!parse-error (type => 'in RCDATA:#'.$token->{type});                  #
                 ## ISSUE: And ignore?  
3393                }                }
3394                } elsif ($token->{tag_name} eq 'head' and
3395                         $self->{insertion_mode} ne 'after head') {
3396                  !!!parse-error (type => 'in head:head'); # or in head noscript
3397                  ## Ignore the token
3398                !!!next-token;                !!!next-token;
3399                redo B;                redo B;
3400              } elsif ($token->{tag_name} eq 'style') {              } elsif ($self->{insertion_mode} ne 'in head noscript' and
3401                $style_start_tag->();                       $token->{tag_name} eq 'script') {
3402                  if ($self->{insertion_mode} eq 'after head') {
3403                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3404                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3405                  }
3406                  ## NOTE: There is a "as if in head" code clone.
3407                  $script_start_tag->($insert_to_current);
3408                  pop @{$self->{open_elements}}
3409                      if $self->{insertion_mode} eq 'after head';
3410                redo B;                redo B;
3411              } elsif ($token->{tag_name} eq 'script') {              } elsif ($self->{insertion_mode} eq 'after head' and
3412                $script_start_tag->();                       $token->{tag_name} eq 'body') {
3413                redo B;                !!!insert-element ('body', $token->{attributes});
3414              } elsif ({base => 1, link => 1, meta => 1}->{$token->{tag_name}}) {                $self->{insertion_mode} = 'in body';
               ## NOTE: There are "as if in head" code clones  
               my $el;  
               !!!create-element ($el, $token->{tag_name}, $token->{attributes});  
               (defined $self->{head_element} ? $self->{head_element} : $self->{open_elements}->[-1]->[0])  
                 ->append_child ($el);  
   
3415                !!!next-token;                !!!next-token;
3416                redo B;                redo B;
3417              } elsif ($token->{tag_name} eq 'head') {              } elsif ($self->{insertion_mode} eq 'after head' and
3418                !!!parse-error (type => 'in head:head');                       $token->{tag_name} eq 'frameset') {
3419                ## Ignore the token                !!!insert-element ('frameset', $token->{attributes});
3420                  $self->{insertion_mode} = 'in frameset';
3421                !!!next-token;                !!!next-token;
3422                redo B;                redo B;
3423              } else {              } else {
3424                #                #
3425              }              }
3426            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3427              if ($token->{tag_name} eq 'head') {              if ($self->{insertion_mode} eq 'in head' and
3428                if ($self->{open_elements}->[-1]->[1] eq 'head') {                  $token->{tag_name} eq 'head') {
3429                  pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
               } else {  
                 !!!parse-error (type => 'unmatched end tag:head');  
               }  
3430                $self->{insertion_mode} = 'after head';                $self->{insertion_mode} = 'after head';
3431                !!!next-token;                !!!next-token;
3432                redo B;                redo B;
3433              } elsif ($token->{tag_name} eq 'html') {              } elsif ($self->{insertion_mode} eq 'in head noscript' and
3434                    $token->{tag_name} eq 'noscript') {
3435                  pop @{$self->{open_elements}};
3436                  $self->{insertion_mode} = 'in head';
3437                  !!!next-token;
3438                  redo B;
3439                } elsif ($self->{insertion_mode} eq 'in head' and
3440                         ($token->{tag_name} eq 'body' or
3441                          $token->{tag_name} eq 'html')) {
3442                #                #
3443              } else {              } elsif ($self->{insertion_mode} ne 'after head') {
3444                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3445                ## Ignore the token                ## Ignore the token
3446                !!!next-token;                !!!next-token;
3447                redo B;                redo B;
3448                } else {
3449                  #
3450              }              }
3451            } else {            } else {
3452              #              #
3453            }            }
3454    
3455            if ($self->{open_elements}->[-1]->[1] eq 'head') {            ## As if </head> or </noscript> or <body>
3456              ## As if </head>            if ($self->{insertion_mode} eq 'in head') {
3457                pop @{$self->{open_elements}};
3458                $self->{insertion_mode} = 'after head';
3459              } elsif ($self->{insertion_mode} eq 'in head noscript') {
3460              pop @{$self->{open_elements}};              pop @{$self->{open_elements}};
3461                !!!parse-error (type => 'in noscript:'.(defined $token->{tag_name} ? ($token->{type} eq 'end tag' ? '/' : '') . $token->{tag_name} : '#' . $token->{type}));
3462                $self->{insertion_mode} = 'in head';
3463              } else { # 'after head'
3464                !!!insert-element ('body');
3465                $self->{insertion_mode} = 'in body';
3466            }            }
           $self->{insertion_mode} = 'after head';  
3467            ## reprocess            ## reprocess
3468            redo B;            redo B;
3469    
3470            ## 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;  
3471          } elsif ($self->{insertion_mode} eq 'in body') {          } elsif ($self->{insertion_mode} eq 'in body') {
3472            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3473              ## NOTE: There is a code clone of "character in body".              ## NOTE: There is a code clone of "character in body".
# Line 4935  sub set_inner_html ($$$) { Line 5116  sub set_inner_html ($$$) {
5116      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
5117    
5118      ## Step 1 # MUST      ## Step 1 # MUST
5119      my $doc = $node->owner_document->implementation->create_document;      my $this_doc = $node->owner_document;
5120      ## TODO: Mark as HTML document      my $doc = $this_doc->implementation->create_document;
5121        $doc->manakai_is_html (1);
5122      my $p = $class->new;      my $p = $class->new;
5123      $p->{document} = $doc;      $p->{document} = $doc;
5124    
# Line 4946  sub set_inner_html ($$$) { Line 5128  sub set_inner_html ($$$) {
5128      my $column = 0;      my $column = 0;
5129      $p->{set_next_input_character} = sub {      $p->{set_next_input_character} = sub {
5130        my $self = shift;        my $self = shift;
5131    
5132          pop @{$self->{prev_input_character}};
5133          unshift @{$self->{prev_input_character}}, $self->{next_input_character};
5134    
5135        $self->{next_input_character} = -1 and return if $i >= length $$s;        $self->{next_input_character} = -1 and return if $i >= length $$s;
5136        $self->{next_input_character} = ord substr $$s, $i++, 1;        $self->{next_input_character} = ord substr $$s, $i++, 1;
5137        $column++;        $column++;
# Line 4954  sub set_inner_html ($$$) { Line 5140  sub set_inner_html ($$$) {
5140          $line++;          $line++;
5141          $column = 0;          $column = 0;
5142        } elsif ($self->{next_input_character} == 0x000D) { # CR        } elsif ($self->{next_input_character} == 0x000D) { # CR
5143          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;  
           }  
         }  
5144          $self->{next_input_character} = 0x000A; # LF # MUST          $self->{next_input_character} = 0x000A; # LF # MUST
5145          $line++;          $line++;
5146          $column = 0;          $column = 0;
5147        } elsif ($self->{next_input_character} > 0x10FFFF) {        } elsif ($self->{next_input_character} > 0x10FFFF) {
5148          $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST          $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5149        } elsif ($self->{next_input_character} == 0x0000) { # NULL        } elsif ($self->{next_input_character} == 0x0000) { # NULL
5150            !!!parse-error (type => 'NULL');
5151          $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST          $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5152        }        }
5153      };      };
5154        $p->{prev_input_character} = [-1, -1, -1];
5155        $p->{next_input_character} = -1;
5156            
5157      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
5158        my (%opt) = @_;        my (%opt) = @_;
# Line 5051  sub set_inner_html ($$$) { Line 5231  sub set_inner_html ($$$) {
5231      ## Step 12 # MUST      ## Step 12 # MUST
5232      @cn = @{$root->child_nodes};      @cn = @{$root->child_nodes};
5233      for (@cn) {      for (@cn) {
5234          $this_doc->adopt_node ($_);
5235        $node->append_child ($_);        $node->append_child ($_);
5236      }      }
5237      ## ISSUE: adopt_node? mutation events?      ## ISSUE: mutation events?
5238    
5239      $p->_terminate_tree_constructor;      $p->_terminate_tree_constructor;
5240    } else {    } else {
# Line 5124  sub get_inner_html ($$$) { Line 5305  sub get_inner_html ($$$) {
5305          spacer => 1, wbr => 1,          spacer => 1, wbr => 1,
5306        }->{$tag_name};        }->{$tag_name};
5307    
5308          $s .= "\x0A" if $tag_name eq 'pre' or $tag_name eq 'textarea';
5309    
5310        if (not $in_cdata and {        if (not $in_cdata and {
5311          style => 1, script => 1, xmp => 1, iframe => 1,          style => 1, script => 1, xmp => 1, iframe => 1,
5312          noembed => 1, noframes => 1, noscript => 1,          noembed => 1, noframes => 1, noscript => 1,

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24