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

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

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

revision 1.2 by wakaba, Tue May 1 10:47:37 2007 UTC revision 1.63 by wakaba, Sun Nov 11 06:54:36 2007 UTC
# Line 1  Line 1 
1  package Whatpm::HTML;  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    use Error qw(:try);
5    
6  ## This is an early version of an HTML parser.  ## ISSUE:
7    ## var doc = implementation.createDocument (null, null, null);
8    ## doc.write ('');
9    ## alert (doc.compatMode);
10    
11    ## ISSUE: HTML5 revision 967 says that the encoding layer MUST NOT
12    ## strip BOM and the HTML layer MUST ignore it.  Whether we can do it
13    ## is not yet clear.
14    ## "{U+FEFF}..." in UTF-16BE/UTF-16LE is three or four characters?
15    ## "{U+FEFF}..." in GB18030?
16    
17  my $permitted_slash_tag_name = {  my $permitted_slash_tag_name = {
18    base => 1,    base => 1,
# Line 18  my $permitted_slash_tag_name = { Line 28  my $permitted_slash_tag_name = {
28    input => 1,    input => 1,
29  };  };
30    
31  my $entity_char = {  my $c1_entity_char = {
32    AElig => "\x{00C6}",    0x80 => 0x20AC,
33    Aacute => "\x{00C1}",    0x81 => 0xFFFD,
34    Acirc => "\x{00C2}",    0x82 => 0x201A,
35    Agrave => "\x{00C0}",    0x83 => 0x0192,
36    Alpha => "\x{0391}",    0x84 => 0x201E,
37    Aring => "\x{00C5}",    0x85 => 0x2026,
38    Atilde => "\x{00C3}",    0x86 => 0x2020,
39    Auml => "\x{00C4}",    0x87 => 0x2021,
40    Beta => "\x{0392}",    0x88 => 0x02C6,
41    Ccedil => "\x{00C7}",    0x89 => 0x2030,
42    Chi => "\x{03A7}",    0x8A => 0x0160,
43    Dagger => "\x{2021}",    0x8B => 0x2039,
44    Delta => "\x{0394}",    0x8C => 0x0152,
45    ETH => "\x{00D0}",    0x8D => 0xFFFD,
46    Eacute => "\x{00C9}",    0x8E => 0x017D,
47    Ecirc => "\x{00CA}",    0x8F => 0xFFFD,
48    Egrave => "\x{00C8}",    0x90 => 0xFFFD,
49    Epsilon => "\x{0395}",    0x91 => 0x2018,
50    Eta => "\x{0397}",    0x92 => 0x2019,
51    Euml => "\x{00CB}",    0x93 => 0x201C,
52    Gamma => "\x{0393}",    0x94 => 0x201D,
53    Iacute => "\x{00CD}",    0x95 => 0x2022,
54    Icirc => "\x{00CE}",    0x96 => 0x2013,
55    Igrave => "\x{00CC}",    0x97 => 0x2014,
56    Iota => "\x{0399}",    0x98 => 0x02DC,
57    Iuml => "\x{00CF}",    0x99 => 0x2122,
58    Kappa => "\x{039A}",    0x9A => 0x0161,
59    Lambda => "\x{039B}",    0x9B => 0x203A,
60    Mu => "\x{039C}",    0x9C => 0x0153,
61    Ntilde => "\x{00D1}",    0x9D => 0xFFFD,
62    Nu => "\x{039D}",    0x9E => 0x017E,
63    OElig => "\x{0152}",    0x9F => 0x0178,
64    Oacute => "\x{00D3}",  }; # $c1_entity_char
   Ocirc => "\x{00D4}",  
   Ograve => "\x{00D2}",  
   Omega => "\x{03A9}",  
   Omicron => "\x{039F}",  
   Oslash => "\x{00D8}",  
   Otilde => "\x{00D5}",  
   Ouml => "\x{00D6}",  
   Phi => "\x{03A6}",  
   Pi => "\x{03A0}",  
   Prime => "\x{2033}",  
   Psi => "\x{03A8}",  
   Rho => "\x{03A1}",  
   Scaron => "\x{0160}",  
   Sigma => "\x{03A3}",  
   THORN => "\x{00DE}",  
   Tau => "\x{03A4}",  
   Theta => "\x{0398}",  
   Uacute => "\x{00DA}",  
   Ucirc => "\x{00DB}",  
   Ugrave => "\x{00D9}",  
   Upsilon => "\x{03A5}",  
   Uuml => "\x{00DC}",  
   Xi => "\x{039E}",  
   Yacute => "\x{00DD}",  
   Yuml => "\x{0178}",  
   Zeta => "\x{0396}",  
   aacute => "\x{00E1}",  
   acirc => "\x{00E2}",  
   acute => "\x{00B4}",  
   aelig => "\x{00E6}",  
   agrave => "\x{00E0}",  
   alefsym => "\x{2135}",  
   alpha => "\x{03B1}",  
   amp => "\x{0026}",  
   AMP => "\x{0026}",  
   and => "\x{2227}",  
   ang => "\x{2220}",  
   apos => "\x{0027}",  
   aring => "\x{00E5}",  
   asymp => "\x{2248}",  
   atilde => "\x{00E3}",  
   auml => "\x{00E4}",  
   bdquo => "\x{201E}",  
   beta => "\x{03B2}",  
   brvbar => "\x{00A6}",  
   bull => "\x{2022}",  
   cap => "\x{2229}",  
   ccedil => "\x{00E7}",  
   cedil => "\x{00B8}",  
   cent => "\x{00A2}",  
   chi => "\x{03C7}",  
   circ => "\x{02C6}",  
   clubs => "\x{2663}",  
   cong => "\x{2245}",  
   copy => "\x{00A9}",  
   COPY => "\x{00A9}",  
   crarr => "\x{21B5}",  
   cup => "\x{222A}",  
   curren => "\x{00A4}",  
   dArr => "\x{21D3}",  
   dagger => "\x{2020}",  
   darr => "\x{2193}",  
   deg => "\x{00B0}",  
   delta => "\x{03B4}",  
   diams => "\x{2666}",  
   divide => "\x{00F7}",  
   eacute => "\x{00E9}",  
   ecirc => "\x{00EA}",  
   egrave => "\x{00E8}",  
   empty => "\x{2205}",  
   emsp => "\x{2003}",  
   ensp => "\x{2002}",  
   epsilon => "\x{03B5}",  
   equiv => "\x{2261}",  
   eta => "\x{03B7}",  
   eth => "\x{00F0}",  
   euml => "\x{00EB}",  
   euro => "\x{20AC}",  
   exist => "\x{2203}",  
   fnof => "\x{0192}",  
   forall => "\x{2200}",  
   frac12 => "\x{00BD}",  
   frac14 => "\x{00BC}",  
   frac34 => "\x{00BE}",  
   frasl => "\x{2044}",  
   gamma => "\x{03B3}",  
   ge => "\x{2265}",  
   gt => "\x{003E}",  
   GT => "\x{003E}",  
   hArr => "\x{21D4}",  
   harr => "\x{2194}",  
   hearts => "\x{2665}",  
   hellip => "\x{2026}",  
   iacute => "\x{00ED}",  
   icirc => "\x{00EE}",  
   iexcl => "\x{00A1}",  
   igrave => "\x{00EC}",  
   image => "\x{2111}",  
   infin => "\x{221E}",  
   int => "\x{222B}",  
   iota => "\x{03B9}",  
   iquest => "\x{00BF}",  
   isin => "\x{2208}",  
   iuml => "\x{00EF}",  
   kappa => "\x{03BA}",  
   lArr => "\x{21D0}",  
   lambda => "\x{03BB}",  
   lang => "\x{2329}",  
   laquo => "\x{00AB}",  
   larr => "\x{2190}",  
   lceil => "\x{2308}",  
   ldquo => "\x{201C}",  
   le => "\x{2264}",  
   lfloor => "\x{230A}",  
   lowast => "\x{2217}",  
   loz => "\x{25CA}",  
   lrm => "\x{200E}",  
   lsaquo => "\x{2039}",  
   lsquo => "\x{2018}",  
   lt => "\x{003C}",  
   LT => "\x{003C}",  
   macr => "\x{00AF}",  
   mdash => "\x{2014}",  
   micro => "\x{00B5}",  
   middot => "\x{00B7}",  
   minus => "\x{2212}",  
   mu => "\x{03BC}",  
   nabla => "\x{2207}",  
   nbsp => "\x{00A0}",  
   ndash => "\x{2013}",  
   ne => "\x{2260}",  
   ni => "\x{220B}",  
   not => "\x{00AC}",  
   notin => "\x{2209}",  
   nsub => "\x{2284}",  
   ntilde => "\x{00F1}",  
   nu => "\x{03BD}",  
   oacute => "\x{00F3}",  
   ocirc => "\x{00F4}",  
   oelig => "\x{0153}",  
   ograve => "\x{00F2}",  
   oline => "\x{203E}",  
   omega => "\x{03C9}",  
   omicron => "\x{03BF}",  
   oplus => "\x{2295}",  
   or => "\x{2228}",  
   ordf => "\x{00AA}",  
   ordm => "\x{00BA}",  
   oslash => "\x{00F8}",  
   otilde => "\x{00F5}",  
   otimes => "\x{2297}",  
   ouml => "\x{00F6}",  
   para => "\x{00B6}",  
   part => "\x{2202}",  
   permil => "\x{2030}",  
   perp => "\x{22A5}",  
   phi => "\x{03C6}",  
   pi => "\x{03C0}",  
   piv => "\x{03D6}",  
   plusmn => "\x{00B1}",  
   pound => "\x{00A3}",  
   prime => "\x{2032}",  
   prod => "\x{220F}",  
   prop => "\x{221D}",  
   psi => "\x{03C8}",  
   quot => "\x{0022}",  
   QUOT => "\x{0022}",  
   rArr => "\x{21D2}",  
   radic => "\x{221A}",  
   rang => "\x{232A}",  
   raquo => "\x{00BB}",  
   rarr => "\x{2192}",  
   rceil => "\x{2309}",  
   rdquo => "\x{201D}",  
   real => "\x{211C}",  
   reg => "\x{00AE}",  
   REG => "\x{00AE}",  
   rfloor => "\x{230B}",  
   rho => "\x{03C1}",  
   rlm => "\x{200F}",  
   rsaquo => "\x{203A}",  
   rsquo => "\x{2019}",  
   sbquo => "\x{201A}",  
   scaron => "\x{0161}",  
   sdot => "\x{22C5}",  
   sect => "\x{00A7}",  
   shy => "\x{00AD}",  
   sigma => "\x{03C3}",  
   sigmaf => "\x{03C2}",  
   sim => "\x{223C}",  
   spades => "\x{2660}",  
   sub => "\x{2282}",  
   sube => "\x{2286}",  
   sum => "\x{2211}",  
   sup => "\x{2283}",  
   sup1 => "\x{00B9}",  
   sup2 => "\x{00B2}",  
   sup3 => "\x{00B3}",  
   supe => "\x{2287}",  
   szlig => "\x{00DF}",  
   tau => "\x{03C4}",  
   there4 => "\x{2234}",  
   theta => "\x{03B8}",  
   thetasym => "\x{03D1}",  
   thinsp => "\x{2009}",  
   thorn => "\x{00FE}",  
   tilde => "\x{02DC}",  
   times => "\x{00D7}",  
   trade => "\x{2122}",  
   uArr => "\x{21D1}",  
   uacute => "\x{00FA}",  
   uarr => "\x{2191}",  
   ucirc => "\x{00FB}",  
   ugrave => "\x{00F9}",  
   uml => "\x{00A8}",  
   upsih => "\x{03D2}",  
   upsilon => "\x{03C5}",  
   uuml => "\x{00FC}",  
   weierp => "\x{2118}",  
   xi => "\x{03BE}",  
   yacute => "\x{00FD}",  
   yen => "\x{00A5}",  
   yuml => "\x{00FF}",  
   zeta => "\x{03B6}",  
   zwj => "\x{200D}",  
   zwnj => "\x{200C}",  
 };  
65    
66  my $special_category = {  my $special_category = {
67    address => 1, area => 1, base => 1, basefont => 1, bgsound => 1,    address => 1, area => 1, base => 1, basefont => 1, bgsound => 1,
# Line 302  my $formatting_category = { Line 85  my $formatting_category = {
85  };  };
86  # $phrasing_category: all other elements  # $phrasing_category: all other elements
87    
88    sub parse_byte_string ($$$$;$) {
89      my $self = ref $_[0] ? shift : shift->new;
90      my $charset = shift;
91      my $bytes_s = ref $_[0] ? $_[0] : \($_[0]);
92      my $s;
93      
94      if (defined $charset) {
95        require Encode;
96        $s = \ (Encode::decode ($charset, $$bytes_s));
97        $self->{input_encoding} = lc $charset; ## TODO: normalize name ## TODO: set $doc->input_encoding
98        $self->{confident} = 1;
99      } else {
100        $s = ref $_[0] ? $_[0] : \($_[0]);
101        $self->{confident} = 0;
102      }
103    
104      $self->{change_encoding} = sub {
105        my $self = shift;
106        my $charset = lc shift;
107        ## TODO: if $charset is supported
108        ## TODO: normalize charset name
109    
110        ## "Change the encoding" algorithm:
111    
112        ## Step 1    
113        if ($charset eq 'utf-16') { ## ISSUE: UTF-16BE -> UTF-8? UTF-16LE -> UTF-8?
114          $charset = 'utf-8';
115        }
116    
117        ## Step 2
118        if (defined $self->{input_encoding} and
119            $self->{input_encoding} eq $charset) {
120          $self->{confident} = 1;
121          return;
122        }
123    
124        !!!parse-error (type => 'charset label detected', level => 'w');
125    
126        ## Step 3
127        # if (can) {
128          ## change the encoding on the fly.
129          #$self->{confident} = 1;
130          #return;
131        # }
132    
133        ## Step 4
134        throw Whatpm::HTML::RestartParser (charset => $charset);
135      }; # $self->{change_encoding}
136    
137      my @args = @_; shift @args; # $s
138      my $return;
139      try {
140        $return = $self->parse_char_string ($s, @args);  
141      } catch Whatpm::HTML::RestartParser with {
142        my $charset = shift->{charset};
143        $s = \ (Encode::decode ($charset, $$bytes_s));    
144        $self->{input_encoding} = $charset; ## TODO: $doc->input_encoding;
145        $self->{confident} = 1;
146        $return = $self->parse_char_string ($s, @args);
147      };
148      return $return;
149    } # parse_byte_string
150    
151    *parse_char_string = \&parse_string;
152    
153  sub parse_string ($$$;$) {  sub parse_string ($$$;$) {
154    my $self = shift->new;    my $self = ref $_[0] ? shift : shift->new;
155    my $s = \$_[0];    my $s = ref $_[0] ? $_[0] : \($_[0]);
156    $self->{document} = $_[1];    $self->{document} = $_[1];
157      @{$self->{document}->child_nodes} = ();
158    
159      ## NOTE: |set_inner_html| copies most of this method's code
160    
161      $self->{confident} = 1 unless exists $self->{confident};
162    
   my $i;  
163    my $i = 0;    my $i = 0;
164      my $line = 1;
165      my $column = 0;
166    $self->{set_next_input_character} = sub {    $self->{set_next_input_character} = sub {
167      my $self = shift;      my $self = shift;
168    
169        pop @{$self->{prev_input_character}};
170        unshift @{$self->{prev_input_character}}, $self->{next_input_character};
171    
172      $self->{next_input_character} = -1 and return if $i >= length $$s;      $self->{next_input_character} = -1 and return if $i >= length $$s;
173      $self->{next_input_character} = ord substr $$s, $i++, 1;      $self->{next_input_character} = ord substr $$s, $i++, 1;
174        $column++;
175            
176      if ($self->{next_input_character} == 0x000D) { # CR      if ($self->{next_input_character} == 0x000A) { # LF
177        if ($i >= length $$s) {        $line++;
178          #        $column = 0;
179        } else {      } elsif ($self->{next_input_character} == 0x000D) { # CR
180          my $next_char = ord substr $$s, $i++, 1;        $i++ if substr ($$s, $i, 1) eq "\x0A";
         if ($next_char == 0x000A) { # LF  
           #  
         } else {  
           push @{$self->{char}}, $next_char;  
         }  
       }  
181        $self->{next_input_character} = 0x000A; # LF # MUST        $self->{next_input_character} = 0x000A; # LF # MUST
182          $line++;
183          $column = 0;
184      } elsif ($self->{next_input_character} > 0x10FFFF) {      } elsif ($self->{next_input_character} > 0x10FFFF) {
185        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
186      } elsif ($self->{next_input_character} == 0x0000) { # NULL      } elsif ($self->{next_input_character} == 0x0000) { # NULL
187          !!!parse-error (type => 'NULL');
188        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
189      }      }
190    };    };
191      $self->{prev_input_character} = [-1, -1, -1];
192      $self->{next_input_character} = -1;
193    
194    $self->{parse_error} = $_[2] || sub {    my $onerror = $_[2] || sub {
195      warn "Parse error at character $i\n"; ## TODO: Report (line, column) pair      my (%opt) = @_;
196        warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n";
197      };
198      $self->{parse_error} = sub {
199        $onerror->(@_, line => $line, column => $column);
200    };    };
201    
202    $self->_initialize_tokenizer;    $self->_initialize_tokenizer;
# Line 354  sub new ($) { Line 216  sub new ($) {
216    $self->{parse_error} = sub {    $self->{parse_error} = sub {
217      #      #
218    };    };
219      $self->{change_encoding} = sub {
220        # if ($_[0] is a supported encoding) {
221        #   run "change the encoding" algorithm;
222        #   throw Whatpm::HTML::RestartParser (charset => $new_encoding);
223        # }
224      };
225      $self->{application_cache_selection} = sub {
226        #
227      };
228    return $self;    return $self;
229  } # new  } # new
230    
231    sub CM_ENTITY () { 0b001 } # & markup in data
232    sub CM_LIMITED_MARKUP () { 0b010 } # < markup in data (limited)
233    sub CM_FULL_MARKUP () { 0b100 } # < markup in data (any)
234    
235    sub PLAINTEXT_CONTENT_MODEL () { 0 }
236    sub CDATA_CONTENT_MODEL () { CM_LIMITED_MARKUP }
237    sub RCDATA_CONTENT_MODEL () { CM_ENTITY | CM_LIMITED_MARKUP }
238    sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
239    
240    sub DATA_STATE () { 0 }
241    sub ENTITY_DATA_STATE () { 1 }
242    sub TAG_OPEN_STATE () { 2 }
243    sub CLOSE_TAG_OPEN_STATE () { 3 }
244    sub TAG_NAME_STATE () { 4 }
245    sub BEFORE_ATTRIBUTE_NAME_STATE () { 5 }
246    sub ATTRIBUTE_NAME_STATE () { 6 }
247    sub AFTER_ATTRIBUTE_NAME_STATE () { 7 }
248    sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 }
249    sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
250    sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
251    sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
252    sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
253    sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
254    sub COMMENT_START_STATE () { 14 }
255    sub COMMENT_START_DASH_STATE () { 15 }
256    sub COMMENT_STATE () { 16 }
257    sub COMMENT_END_STATE () { 17 }
258    sub COMMENT_END_DASH_STATE () { 18 }
259    sub BOGUS_COMMENT_STATE () { 19 }
260    sub DOCTYPE_STATE () { 20 }
261    sub BEFORE_DOCTYPE_NAME_STATE () { 21 }
262    sub DOCTYPE_NAME_STATE () { 22 }
263    sub AFTER_DOCTYPE_NAME_STATE () { 23 }
264    sub BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE () { 24 }
265    sub DOCTYPE_PUBLIC_IDENTIFIER_DOUBLE_QUOTED_STATE () { 25 }
266    sub DOCTYPE_PUBLIC_IDENTIFIER_SINGLE_QUOTED_STATE () { 26 }
267    sub AFTER_DOCTYPE_PUBLIC_IDENTIFIER_STATE () { 27 }
268    sub BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE () { 28 }
269    sub DOCTYPE_SYSTEM_IDENTIFIER_DOUBLE_QUOTED_STATE () { 29 }
270    sub DOCTYPE_SYSTEM_IDENTIFIER_SINGLE_QUOTED_STATE () { 30 }
271    sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STATE () { 31 }
272    sub BOGUS_DOCTYPE_STATE () { 32 }
273    
274    sub DOCTYPE_TOKEN () { 1 }
275    sub COMMENT_TOKEN () { 2 }
276    sub START_TAG_TOKEN () { 3 }
277    sub END_TAG_TOKEN () { 4 }
278    sub END_OF_FILE_TOKEN () { 5 }
279    sub CHARACTER_TOKEN () { 6 }
280    
281    sub AFTER_HTML_IMS () { 0b100 }
282    sub HEAD_IMS ()       { 0b1000 }
283    sub BODY_IMS ()       { 0b10000 }
284    sub BODY_TABLE_IMS () { 0b100000 }
285    sub TABLE_IMS ()      { 0b1000000 }
286    sub ROW_IMS ()        { 0b10000000 }
287    sub BODY_AFTER_IMS () { 0b100000000 }
288    sub FRAME_IMS ()      { 0b1000000000 }
289    
290    sub AFTER_HTML_BODY_IM () { AFTER_HTML_IMS | BODY_AFTER_IMS }
291    sub AFTER_HTML_FRAMESET_IM () { AFTER_HTML_IMS | FRAME_IMS }
292    sub IN_HEAD_IM () { HEAD_IMS | 0b00 }
293    sub IN_HEAD_NOSCRIPT_IM () { HEAD_IMS | 0b01 }
294    sub AFTER_HEAD_IM () { HEAD_IMS | 0b10 }
295    sub BEFORE_HEAD_IM () { HEAD_IMS | 0b11 }
296    sub IN_BODY_IM () { BODY_IMS }
297    sub IN_CELL_IM () { BODY_IMS | BODY_TABLE_IMS | 0b01 }
298    sub IN_CAPTION_IM () { BODY_IMS | BODY_TABLE_IMS | 0b10 }
299    sub IN_ROW_IM () { TABLE_IMS | ROW_IMS | 0b01 }
300    sub IN_TABLE_BODY_IM () { TABLE_IMS | ROW_IMS | 0b10 }
301    sub IN_TABLE_IM () { TABLE_IMS }
302    sub AFTER_BODY_IM () { BODY_AFTER_IMS }
303    sub IN_FRAMESET_IM () { FRAME_IMS | 0b01 }
304    sub AFTER_FRAMESET_IM () { FRAME_IMS | 0b10 }
305    sub IN_SELECT_IM () { 0b01 }
306    sub IN_COLUMN_GROUP_IM () { 0b10 }
307    
308  ## Implementations MUST act as if state machine in the spec  ## Implementations MUST act as if state machine in the spec
309    
310  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
311    my $self = shift;    my $self = shift;
312    $self->{state} = 'data'; # MUST    $self->{state} = DATA_STATE; # MUST
313    $self->{content_model_flag} = 'PCDATA'; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
314    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE
315    undef $self->{current_attribute};    undef $self->{current_attribute};
316    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
# Line 371  sub _initialize_tokenizer ($) { Line 319  sub _initialize_tokenizer ($) {
319    # $self->{next_input_character}    # $self->{next_input_character}
320    !!!next-input-character;    !!!next-input-character;
321    $self->{token} = [];    $self->{token} = [];
322      # $self->{escape}
323  } # _initialize_tokenizer  } # _initialize_tokenizer
324    
325  ## A token has:  ## A token has:
326  ##   ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',  ##   ->{type} == DOCTYPE_TOKEN, START_TAG_TOKEN, END_TAG_TOKEN, COMMENT_TOKEN,
327  ##       'character', or 'end-of-file'  ##       CHARACTER_TOKEN, or END_OF_FILE_TOKEN
328  ##   ->{name} (DOCTYPE, start tag (tagname), end tag (tagname))  ##   ->{name} (DOCTYPE_TOKEN)
329      ## ISSUE: the spec need s/tagname/tag name/  ##   ->{tag_name} (START_TAG_TOKEN, END_TAG_TOKEN)
330  ##   ->{error} == 1 or 0 (DOCTYPE)  ##   ->{public_identifier} (DOCTYPE_TOKEN)
331  ##   ->{attributes} isa HASH (start tag, end tag)  ##   ->{system_identifier} (DOCTYPE_TOKEN)
332  ##   ->{data} (comment, character)  ##   ->{correct} == 1 or 0 (DOCTYPE_TOKEN)
333    ##   ->{attributes} isa HASH (START_TAG_TOKEN, END_TAG_TOKEN)
334  ## Macros  ##   ->{data} (COMMENT_TOKEN, CHARACTER_TOKEN)
 ##   Macros MUST be preceded by three EXCLAMATION MARKs.  
 ##   emit ($token)  
 ##     Emits the specified token.  
335    
336  ## Emitted token MUST immediately be handled by the tree construction state.  ## Emitted token MUST immediately be handled by the tree construction state.
337    
# Line 395  sub _initialize_tokenizer ($) { Line 341  sub _initialize_tokenizer ($) {
341  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
342  ## and removed from the list.  ## and removed from the list.
343    
344    ## NOTE: HTML5 "Writing HTML documents" section, applied to
345    ## documents and not to user agents and conformance checkers,
346    ## contains some requirements that are not detected by the
347    ## parsing algorithm:
348    ## - Some requirements on character encoding declarations. ## TODO
349    ## - "Elements MUST NOT contain content that their content model disallows."
350    ##   ... Some are parse error, some are not (will be reported by c.c.).
351    ## - Polytheistic slash SHOULD NOT be used. (Applied only to atheists.) ## TODO
352    ## - Text (in elements, attributes, and comments) SHOULD NOT contain
353    ##   control characters other than space characters. ## TODO: (what is control character? C0, C1 and DEL?  Unicode control character?)
354    
355    ## TODO: HTML5 poses authors two SHOULD-level requirements that cannot
356    ## be detected by the HTML5 parsing algorithm:
357    ## - Text,
358    
359  sub _get_next_token ($) {  sub _get_next_token ($) {
360    my $self = shift;    my $self = shift;
361    if (@{$self->{token}}) {    if (@{$self->{token}}) {
# Line 402  sub _get_next_token ($) { Line 363  sub _get_next_token ($) {
363    }    }
364    
365    A: {    A: {
366      if ($self->{state} eq 'data') {      if ($self->{state} == DATA_STATE) {
367        if ($self->{next_input_character} == 0x0026) { # &        if ($self->{next_input_character} == 0x0026) { # &
368          if ($self->{content_model_flag} eq 'PCDATA' or          if ($self->{content_model} & CM_ENTITY) { # PCDATA | RCDATA
369              $self->{content_model_flag} eq 'RCDATA') {            $self->{state} = ENTITY_DATA_STATE;
           $self->{state} = 'entity data';  
370            !!!next-input-character;            !!!next-input-character;
371            redo A;            redo A;
372          } else {          } else {
373            #            #
374          }          }
375          } elsif ($self->{next_input_character} == 0x002D) { # -
376            if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
377              unless ($self->{escape}) {
378                if ($self->{prev_input_character}->[0] == 0x002D and # -
379                    $self->{prev_input_character}->[1] == 0x0021 and # !
380                    $self->{prev_input_character}->[2] == 0x003C) { # <
381                  $self->{escape} = 1;
382                }
383              }
384            }
385            
386            #
387        } elsif ($self->{next_input_character} == 0x003C) { # <        } elsif ($self->{next_input_character} == 0x003C) { # <
388          if ($self->{content_model_flag} ne 'PLAINTEXT') {          if ($self->{content_model} & CM_FULL_MARKUP or # PCDATA
389            $self->{state} = 'tag open';              (($self->{content_model} & CM_LIMITED_MARKUP) and # CDATA | RCDATA
390                 not $self->{escape})) {
391              $self->{state} = TAG_OPEN_STATE;
392            !!!next-input-character;            !!!next-input-character;
393            redo A;            redo A;
394          } else {          } else {
395            #            #
396          }          }
397          } elsif ($self->{next_input_character} == 0x003E) { # >
398            if ($self->{escape} and
399                ($self->{content_model} & CM_LIMITED_MARKUP)) { # RCDATA | CDATA
400              if ($self->{prev_input_character}->[0] == 0x002D and # -
401                  $self->{prev_input_character}->[1] == 0x002D) { # -
402                delete $self->{escape};
403              }
404            }
405            
406            #
407        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
408          !!!emit ({type => 'end-of-file'});          !!!emit ({type => END_OF_FILE_TOKEN});
409          last A; ## TODO: ok?          last A; ## TODO: ok?
410        }        }
411        # Anything else        # Anything else
412        my $token = {type => 'character',        my $token = {type => CHARACTER_TOKEN,
413                     data => chr $self->{next_input_character}};                     data => chr $self->{next_input_character}};
414        ## Stay in the data state        ## Stay in the data state
415        !!!next-input-character;        !!!next-input-character;
# Line 433  sub _get_next_token ($) { Line 417  sub _get_next_token ($) {
417        !!!emit ($token);        !!!emit ($token);
418    
419        redo A;        redo A;
420      } elsif ($self->{state} eq 'entity data') {      } elsif ($self->{state} == ENTITY_DATA_STATE) {
421        ## (cannot happen in CDATA state)        ## (cannot happen in CDATA state)
422                
423        my $token = $self->_tokenize_attempt_to_consume_an_entity;        my $token = $self->_tokenize_attempt_to_consume_an_entity (0);
424    
425        $self->{state} = 'data';        $self->{state} = DATA_STATE;
426        # next-input-character is already done        # next-input-character is already done
427    
428        unless (defined $token) {        unless (defined $token) {
429          !!!emit ({type => 'character', data => '&'});          !!!emit ({type => CHARACTER_TOKEN, data => '&'});
430        } else {        } else {
431          !!!emit ($token);          !!!emit ($token);
432        }        }
433    
434        redo A;        redo A;
435      } elsif ($self->{state} eq 'tag open') {      } elsif ($self->{state} == TAG_OPEN_STATE) {
436        if ($self->{content_model_flag} eq 'RCDATA' or        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
           $self->{content_model_flag} eq 'CDATA') {  
437          if ($self->{next_input_character} == 0x002F) { # /          if ($self->{next_input_character} == 0x002F) { # /
438            !!!next-input-character;            !!!next-input-character;
439            $self->{state} = 'close tag open';            $self->{state} = CLOSE_TAG_OPEN_STATE;
440            redo A;            redo A;
441          } else {          } else {
442            ## reconsume            ## reconsume
443            $self->{state} = 'data';            $self->{state} = DATA_STATE;
444    
445            !!!emit ({type => 'character', data => '<'});            !!!emit ({type => CHARACTER_TOKEN, data => '<'});
446    
447            redo A;            redo A;
448          }          }
449        } elsif ($self->{content_model_flag} eq 'PCDATA') {        } elsif ($self->{content_model} & CM_FULL_MARKUP) { # PCDATA
450          if ($self->{next_input_character} == 0x0021) { # !          if ($self->{next_input_character} == 0x0021) { # !
451            $self->{state} = 'markup declaration open';            $self->{state} = MARKUP_DECLARATION_OPEN_STATE;
452            !!!next-input-character;            !!!next-input-character;
453            redo A;            redo A;
454          } elsif ($self->{next_input_character} == 0x002F) { # /          } elsif ($self->{next_input_character} == 0x002F) { # /
455            $self->{state} = 'close tag open';            $self->{state} = CLOSE_TAG_OPEN_STATE;
456            !!!next-input-character;            !!!next-input-character;
457            redo A;            redo A;
458          } elsif (0x0041 <= $self->{next_input_character} and          } elsif (0x0041 <= $self->{next_input_character} and
459                   $self->{next_input_character} <= 0x005A) { # A..Z                   $self->{next_input_character} <= 0x005A) { # A..Z
460            $self->{current_token}            $self->{current_token}
461              = {type => 'start tag',              = {type => START_TAG_TOKEN,
462                 tag_name => chr ($self->{next_input_character} + 0x0020)};                 tag_name => chr ($self->{next_input_character} + 0x0020)};
463            $self->{state} = 'tag name';            $self->{state} = TAG_NAME_STATE;
464            !!!next-input-character;            !!!next-input-character;
465            redo A;            redo A;
466          } elsif (0x0061 <= $self->{next_input_character} and          } elsif (0x0061 <= $self->{next_input_character} and
467                   $self->{next_input_character} <= 0x007A) { # a..z                   $self->{next_input_character} <= 0x007A) { # a..z
468            $self->{current_token} = {type => 'start tag',            $self->{current_token} = {type => START_TAG_TOKEN,
469                              tag_name => chr ($self->{next_input_character})};                              tag_name => chr ($self->{next_input_character})};
470            $self->{state} = 'tag name';            $self->{state} = TAG_NAME_STATE;
471            !!!next-input-character;            !!!next-input-character;
472            redo A;            redo A;
473          } elsif ($self->{next_input_character} == 0x003E) { # >          } elsif ($self->{next_input_character} == 0x003E) { # >
474            !!!parse-error;            !!!parse-error (type => 'empty start tag');
475            $self->{state} = 'data';            $self->{state} = DATA_STATE;
476            !!!next-input-character;            !!!next-input-character;
477    
478            !!!emit ({type => 'character', data => '<>'});            !!!emit ({type => CHARACTER_TOKEN, data => '<>'});
479    
480            redo A;            redo A;
481          } elsif ($self->{next_input_character} == 0x003F) { # ?          } elsif ($self->{next_input_character} == 0x003F) { # ?
482            !!!parse-error;            !!!parse-error (type => 'pio');
483            $self->{state} = 'bogus comment';            $self->{state} = BOGUS_COMMENT_STATE;
484            ## $self->{next_input_character} is intentionally left as is            ## $self->{next_input_character} is intentionally left as is
485            redo A;            redo A;
486          } else {          } else {
487            !!!parse-error;            !!!parse-error (type => 'bare stago');
488            $self->{state} = 'data';            $self->{state} = DATA_STATE;
489            ## reconsume            ## reconsume
490    
491            !!!emit ({type => 'character', data => '<'});            !!!emit ({type => CHARACTER_TOKEN, data => '<'});
492    
493            redo A;            redo A;
494          }          }
495        } else {        } else {
496          die "$0: $self->{content_model_flag}: Unknown content model flag";          die "$0: $self->{content_model} in tag open";
497        }        }
498      } elsif ($self->{state} eq 'close tag open') {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
499        if ($self->{content_model_flag} eq 'RCDATA' or        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
500            $self->{content_model_flag} eq 'CDATA') {          if (defined $self->{last_emitted_start_tag_name}) {
501          my @next_char;            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>
502          TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {            my @next_char;
503              TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {
504                push @next_char, $self->{next_input_character};
505                my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);
506                my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;
507                if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {
508                  !!!next-input-character;
509                  next TAGNAME;
510                } else {
511                  $self->{next_input_character} = shift @next_char; # reconsume
512                  !!!back-next-input-character (@next_char);
513                  $self->{state} = DATA_STATE;
514    
515                  !!!emit ({type => CHARACTER_TOKEN, data => '</'});
516      
517                  redo A;
518                }
519              }
520            push @next_char, $self->{next_input_character};            push @next_char, $self->{next_input_character};
521            my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);        
522            my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;            unless ($self->{next_input_character} == 0x0009 or # HT
523            if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {                    $self->{next_input_character} == 0x000A or # LF
524              !!!next-input-character;                    $self->{next_input_character} == 0x000B or # VT
525              next TAGNAME;                    $self->{next_input_character} == 0x000C or # FF
526            } else {                    $self->{next_input_character} == 0x0020 or # SP
527              !!!parse-error;                    $self->{next_input_character} == 0x003E or # >
528                      $self->{next_input_character} == 0x002F or # /
529                      $self->{next_input_character} == -1) {
530              $self->{next_input_character} = shift @next_char; # reconsume              $self->{next_input_character} = shift @next_char; # reconsume
531              !!!back-next-input-character (@next_char);              !!!back-next-input-character (@next_char);
532              $self->{state} = 'data';              $self->{state} = DATA_STATE;
533                !!!emit ({type => CHARACTER_TOKEN, data => '</'});
             !!!emit ({type => 'character', data => '</'});  
   
534              redo A;              redo A;
535              } else {
536                $self->{next_input_character} = shift @next_char;
537                !!!back-next-input-character (@next_char);
538                # and consume...
539            }            }
         }  
         push @next_char, $self->{next_input_character};  
       
         unless ($self->{next_input_character} == 0x0009 or # HT  
                 $self->{next_input_character} == 0x000A or # LF  
                 $self->{next_input_character} == 0x000B or # VT  
                 $self->{next_input_character} == 0x000C or # FF  
                 $self->{next_input_character} == 0x0020 or # SP  
                 $self->{next_input_character} == 0x003E or # >  
                 $self->{next_input_character} == 0x002F or # /  
                 $self->{next_input_character} == 0x003C or # <  
                 $self->{next_input_character} == -1) {  
           !!!parse-error;  
           $self->{next_input_character} = shift @next_char; # reconsume  
           !!!back-next-input-character (@next_char);  
           $self->{state} = 'data';  
   
           !!!emit ({type => 'character', data => '</'});  
   
           redo A;  
540          } else {          } else {
541            $self->{next_input_character} = shift @next_char;            ## No start tag token has ever been emitted
542            !!!back-next-input-character (@next_char);            # next-input-character is already done
543            # and consume...            $self->{state} = DATA_STATE;
544              !!!emit ({type => CHARACTER_TOKEN, data => '</'});
545              redo A;
546          }          }
547        }        }
548                
549        if (0x0041 <= $self->{next_input_character} and        if (0x0041 <= $self->{next_input_character} and
550            $self->{next_input_character} <= 0x005A) { # A..Z            $self->{next_input_character} <= 0x005A) { # A..Z
551          $self->{current_token} = {type => 'end tag',          $self->{current_token} = {type => END_TAG_TOKEN,
552                            tag_name => chr ($self->{next_input_character} + 0x0020)};                            tag_name => chr ($self->{next_input_character} + 0x0020)};
553          $self->{state} = 'tag name';          $self->{state} = TAG_NAME_STATE;
554          !!!next-input-character;          !!!next-input-character;
555          redo A;          redo A;
556        } elsif (0x0061 <= $self->{next_input_character} and        } elsif (0x0061 <= $self->{next_input_character} and
557                 $self->{next_input_character} <= 0x007A) { # a..z                 $self->{next_input_character} <= 0x007A) { # a..z
558          $self->{current_token} = {type => 'end tag',          $self->{current_token} = {type => END_TAG_TOKEN,
559                            tag_name => chr ($self->{next_input_character})};                            tag_name => chr ($self->{next_input_character})};
560          $self->{state} = 'tag name';          $self->{state} = TAG_NAME_STATE;
561          !!!next-input-character;          !!!next-input-character;
562          redo A;          redo A;
563        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
564          !!!parse-error;          !!!parse-error (type => 'empty end tag');
565          $self->{state} = 'data';          $self->{state} = DATA_STATE;
566          !!!next-input-character;          !!!next-input-character;
567          redo A;          redo A;
568        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
569          !!!parse-error;          !!!parse-error (type => 'bare etago');
570          $self->{state} = 'data';          $self->{state} = DATA_STATE;
571          # reconsume          # reconsume
572    
573          !!!emit ({type => 'character', data => '</'});          !!!emit ({type => CHARACTER_TOKEN, data => '</'});
574    
575          redo A;          redo A;
576        } else {        } else {
577          !!!parse-error;          !!!parse-error (type => 'bogus end tag');
578          $self->{state} = 'bogus comment';          $self->{state} = BOGUS_COMMENT_STATE;
579          ## $self->{next_input_character} is intentionally left as is          ## $self->{next_input_character} is intentionally left as is
580          redo A;          redo A;
581        }        }
582      } elsif ($self->{state} eq 'tag name') {      } elsif ($self->{state} == TAG_NAME_STATE) {
583        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
584            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
585            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
586            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
587            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
588          $self->{state} = 'before attribute name';          $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE;
589          !!!next-input-character;          !!!next-input-character;
590          redo A;          redo A;
591        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
592          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
593              $self->{current_token}->{first_start_tag}
594                  = not defined $self->{last_emitted_start_tag_name};
595            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
596          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
597            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
598            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
599              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
600            }            }
601          } else {          } else {
602            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
603          }          }
604          $self->{state} = 'data';          $self->{state} = DATA_STATE;
605          !!!next-input-character;          !!!next-input-character;
606    
607          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
608    
609          redo A;          redo A;
610        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 627  sub _get_next_token ($) { Line 614  sub _get_next_token ($) {
614          ## Stay in this state          ## Stay in this state
615          !!!next-input-character;          !!!next-input-character;
616          redo A;          redo A;
617        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
618                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
619          !!!parse-error;          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
620          if ($self->{current_token}->{type} eq 'start tag') {            $self->{current_token}->{first_start_tag}
621                  = not defined $self->{last_emitted_start_tag_name};
622            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
623          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
624            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
625            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
626              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
627            }            }
628          } else {          } else {
629            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
630          }          }
631          $self->{state} = 'data';          $self->{state} = DATA_STATE;
632          # reconsume          # reconsume
633    
634          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
635    
636          redo A;          redo A;
637        } elsif ($self->{next_input_character} == 0x002F) { # /        } elsif ($self->{next_input_character} == 0x002F) { # /
638          !!!next-input-character;          !!!next-input-character;
639          if ($self->{next_input_character} == 0x003E and # >          if ($self->{next_input_character} == 0x003E and # >
640              $self->{current_token}->{type} eq 'start tag' and              $self->{current_token}->{type} == START_TAG_TOKEN and
641              $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {              $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {
642            # permitted slash            # permitted slash
643            #            #
644          } else {          } else {
645            !!!parse-error;            !!!parse-error (type => 'nestc');
646          }          }
647          $self->{state} = 'before attribute name';          $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE;
648          # next-input-character is already done          # next-input-character is already done
649          redo A;          redo A;
650        } else {        } else {
# Line 667  sub _get_next_token ($) { Line 654  sub _get_next_token ($) {
654          !!!next-input-character;          !!!next-input-character;
655          redo A;          redo A;
656        }        }
657      } elsif ($self->{state} eq 'before attribute name') {      } elsif ($self->{state} == BEFORE_ATTRIBUTE_NAME_STATE) {
658        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
659            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
660            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
# Line 677  sub _get_next_token ($) { Line 664  sub _get_next_token ($) {
664          !!!next-input-character;          !!!next-input-character;
665          redo A;          redo A;
666        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
667          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
668              $self->{current_token}->{first_start_tag}
669                  = not defined $self->{last_emitted_start_tag_name};
670            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
671          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
672            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
673            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
674              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
675            }            }
676          } else {          } else {
677            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
678          }          }
679          $self->{state} = 'data';          $self->{state} = DATA_STATE;
680          !!!next-input-character;          !!!next-input-character;
681    
682          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
683    
684          redo A;          redo A;
685        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
686                 $self->{next_input_character} <= 0x005A) { # A..Z                 $self->{next_input_character} <= 0x005A) { # A..Z
687          $self->{current_attribute} = {name => chr ($self->{next_input_character} + 0x0020),          $self->{current_attribute} = {name => chr ($self->{next_input_character} + 0x0020),
688                                value => ''};                                value => ''};
689          $self->{state} = 'attribute name';          $self->{state} = ATTRIBUTE_NAME_STATE;
690          !!!next-input-character;          !!!next-input-character;
691          redo A;          redo A;
692        } elsif ($self->{next_input_character} == 0x002F) { # /        } elsif ($self->{next_input_character} == 0x002F) { # /
693          !!!next-input-character;          !!!next-input-character;
694          if ($self->{next_input_character} == 0x003E and # >          if ($self->{next_input_character} == 0x003E and # >
695              $self->{current_token}->{type} eq 'start tag' and              $self->{current_token}->{type} == START_TAG_TOKEN and
696              $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {              $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {
697            # permitted slash            # permitted slash
698            #            #
699          } else {          } else {
700            !!!parse-error;            !!!parse-error (type => 'nestc');
701          }          }
702          ## Stay in the state          ## Stay in the state
703          # next-input-character is already done          # next-input-character is already done
704          redo A;          redo A;
705        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
706                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
707          !!!parse-error;          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
708          if ($self->{current_token}->{type} eq 'start tag') {            $self->{current_token}->{first_start_tag}
709                  = not defined $self->{last_emitted_start_tag_name};
710            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
711          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
712            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
713            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
714              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
715            }            }
716          } else {          } else {
717            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
718          }          }
719          $self->{state} = 'data';          $self->{state} = DATA_STATE;
720          # reconsume          # reconsume
721    
722          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
723    
724          redo A;          redo A;
725        } else {        } else {
726          $self->{current_attribute} = {name => chr ($self->{next_input_character}),          $self->{current_attribute} = {name => chr ($self->{next_input_character}),
727                                value => ''};                                value => ''};
728          $self->{state} = 'attribute name';          $self->{state} = ATTRIBUTE_NAME_STATE;
729          !!!next-input-character;          !!!next-input-character;
730          redo A;          redo A;
731        }        }
732      } elsif ($self->{state} eq 'attribute name') {      } elsif ($self->{state} == ATTRIBUTE_NAME_STATE) {
733        my $before_leave = sub {        my $before_leave = sub {
734          if (exists $self->{current_token}->{attributes} # start tag or end tag          if (exists $self->{current_token}->{attributes} # start tag or end tag
735              ->{$self->{current_attribute}->{name}}) { # MUST              ->{$self->{current_attribute}->{name}}) { # MUST
736            !!!parse-error;            !!!parse-error (type => 'duplicate attribute:'.$self->{current_attribute}->{name});
737            ## Discard $self->{current_attribute} # MUST            ## Discard $self->{current_attribute} # MUST
738          } else {          } else {
739            $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}}            $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}}
# Line 759  sub _get_next_token ($) { Line 747  sub _get_next_token ($) {
747            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
748            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
749          $before_leave->();          $before_leave->();
750          $self->{state} = 'after attribute name';          $self->{state} = AFTER_ATTRIBUTE_NAME_STATE;
751          !!!next-input-character;          !!!next-input-character;
752          redo A;          redo A;
753        } elsif ($self->{next_input_character} == 0x003D) { # =        } elsif ($self->{next_input_character} == 0x003D) { # =
754          $before_leave->();          $before_leave->();
755          $self->{state} = 'before attribute value';          $self->{state} = BEFORE_ATTRIBUTE_VALUE_STATE;
756          !!!next-input-character;          !!!next-input-character;
757          redo A;          redo A;
758        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
759          $before_leave->();          $before_leave->();
760          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
761              $self->{current_token}->{first_start_tag}
762                  = not defined $self->{last_emitted_start_tag_name};
763            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
764          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
765            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
766            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
767              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
768            }            }
769          } else {          } else {
770            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
771          }          }
772          $self->{state} = 'data';          $self->{state} = DATA_STATE;
773          !!!next-input-character;          !!!next-input-character;
774    
775          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
776    
777          redo A;          redo A;
778        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 796  sub _get_next_token ($) { Line 785  sub _get_next_token ($) {
785          $before_leave->();          $before_leave->();
786          !!!next-input-character;          !!!next-input-character;
787          if ($self->{next_input_character} == 0x003E and # >          if ($self->{next_input_character} == 0x003E and # >
788              $self->{current_token}->{type} eq 'start tag' and              $self->{current_token}->{type} == START_TAG_TOKEN and
789              $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {              $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {
790            # permitted slash            # permitted slash
791            #            #
792          } else {          } else {
793            !!!parse-error;            !!!parse-error (type => 'nestc');
794          }          }
795          $self->{state} = 'before attribute name';          $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE;
796          # next-input-character is already done          # next-input-character is already done
797          redo A;          redo A;
798        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
799                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
800          $before_leave->();          $before_leave->();
801          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
802              $self->{current_token}->{first_start_tag}
803                  = not defined $self->{last_emitted_start_tag_name};
804            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
805          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
806            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
807            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
808              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
809            }            }
810          } else {          } else {
811            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
812          }          }
813          $self->{state} = 'data';          $self->{state} = DATA_STATE;
814          # reconsume          # reconsume
815    
816          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
817    
818          redo A;          redo A;
819        } else {        } else {
# Line 833  sub _get_next_token ($) { Line 822  sub _get_next_token ($) {
822          !!!next-input-character;          !!!next-input-character;
823          redo A;          redo A;
824        }        }
825      } elsif ($self->{state} eq 'after attribute name') {      } elsif ($self->{state} == AFTER_ATTRIBUTE_NAME_STATE) {
826        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
827            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
828            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
# Line 843  sub _get_next_token ($) { Line 832  sub _get_next_token ($) {
832          !!!next-input-character;          !!!next-input-character;
833          redo A;          redo A;
834        } elsif ($self->{next_input_character} == 0x003D) { # =        } elsif ($self->{next_input_character} == 0x003D) { # =
835          $self->{state} = 'before attribute value';          $self->{state} = BEFORE_ATTRIBUTE_VALUE_STATE;
836          !!!next-input-character;          !!!next-input-character;
837          redo A;          redo A;
838        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
839          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
840              $self->{current_token}->{first_start_tag}
841                  = not defined $self->{last_emitted_start_tag_name};
842            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
843          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
844            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
845            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
846              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
847            }            }
848          } else {          } else {
849            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
850          }          }
851          $self->{state} = 'data';          $self->{state} = DATA_STATE;
852          !!!next-input-character;          !!!next-input-character;
853    
854          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
855    
856          redo A;          redo A;
857        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
858                 $self->{next_input_character} <= 0x005A) { # A..Z                 $self->{next_input_character} <= 0x005A) { # A..Z
859          $self->{current_attribute} = {name => chr ($self->{next_input_character} + 0x0020),          $self->{current_attribute} = {name => chr ($self->{next_input_character} + 0x0020),
860                                value => ''};                                value => ''};
861          $self->{state} = 'attribute name';          $self->{state} = ATTRIBUTE_NAME_STATE;
862          !!!next-input-character;          !!!next-input-character;
863          redo A;          redo A;
864        } elsif ($self->{next_input_character} == 0x002F) { # /        } elsif ($self->{next_input_character} == 0x002F) { # /
865          !!!next-input-character;          !!!next-input-character;
866          if ($self->{next_input_character} == 0x003E and # >          if ($self->{next_input_character} == 0x003E and # >
867              $self->{current_token}->{type} eq 'start tag' and              $self->{current_token}->{type} == START_TAG_TOKEN and
868              $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {              $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) {
869            # permitted slash            # permitted slash
870            #            #
871          } else {          } else {
872            !!!parse-error;            !!!parse-error (type => 'nestc');
873              ## TODO: Different error type for <aa / bb> than <aa/>
874          }          }
875          $self->{state} = 'before attribute name';          $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE;
876          # next-input-character is already done          # next-input-character is already done
877          redo A;          redo A;
878        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
879                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
880          !!!parse-error;          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
881          if ($self->{current_token}->{type} eq 'start tag') {            $self->{current_token}->{first_start_tag}
882                  = not defined $self->{last_emitted_start_tag_name};
883            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
884          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
885            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
886            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
887              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
888            }            }
889          } else {          } else {
890            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
891          }          }
892          $self->{state} = 'data';          $self->{state} = DATA_STATE;
893          # reconsume          # reconsume
894    
895          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
896    
897          redo A;          redo A;
898        } else {        } else {
899          $self->{current_attribute} = {name => chr ($self->{next_input_character}),          $self->{current_attribute} = {name => chr ($self->{next_input_character}),
900                                value => ''};                                value => ''};
901          $self->{state} = 'attribute name';          $self->{state} = ATTRIBUTE_NAME_STATE;
902          !!!next-input-character;          !!!next-input-character;
903          redo A;                  redo A;        
904        }        }
905      } elsif ($self->{state} eq 'before attribute value') {      } elsif ($self->{state} == BEFORE_ATTRIBUTE_VALUE_STATE) {
906        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
907            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
908            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
# Line 921  sub _get_next_token ($) { Line 912  sub _get_next_token ($) {
912          !!!next-input-character;          !!!next-input-character;
913          redo A;          redo A;
914        } elsif ($self->{next_input_character} == 0x0022) { # "        } elsif ($self->{next_input_character} == 0x0022) { # "
915          $self->{state} = 'attribute value (double-quoted)';          $self->{state} = ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE;
916          !!!next-input-character;          !!!next-input-character;
917          redo A;          redo A;
918        } elsif ($self->{next_input_character} == 0x0026) { # &        } elsif ($self->{next_input_character} == 0x0026) { # &
919          $self->{state} = 'attribute value (unquoted)';          $self->{state} = ATTRIBUTE_VALUE_UNQUOTED_STATE;
920          ## reconsume          ## reconsume
921          redo A;          redo A;
922        } elsif ($self->{next_input_character} == 0x0027) { # '        } elsif ($self->{next_input_character} == 0x0027) { # '
923          $self->{state} = 'attribute value (single-quoted)';          $self->{state} = ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE;
924          !!!next-input-character;          !!!next-input-character;
925          redo A;          redo A;
926        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
927          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
928              $self->{current_token}->{first_start_tag}
929                  = not defined $self->{last_emitted_start_tag_name};
930            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
931          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
932            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
933            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
934              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
935            }            }
936          } else {          } else {
937            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
938          }          }
939          $self->{state} = 'data';          $self->{state} = DATA_STATE;
940          !!!next-input-character;          !!!next-input-character;
941    
942          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
943    
944          redo A;          redo A;
945        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
946                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
947          !!!parse-error;          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
948          if ($self->{current_token}->{type} eq 'start tag') {            $self->{current_token}->{first_start_tag}
949                  = not defined $self->{last_emitted_start_tag_name};
950            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
951          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
952            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
953            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
954              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
955            }            }
956          } else {          } else {
957            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
958          }          }
959          $self->{state} = 'data';          $self->{state} = DATA_STATE;
960          ## reconsume          ## reconsume
961    
962          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
963    
964          redo A;          redo A;
965        } else {        } else {
966          $self->{current_attribute}->{value} .= chr ($self->{next_input_character});          $self->{current_attribute}->{value} .= chr ($self->{next_input_character});
967          $self->{state} = 'attribute value (unquoted)';          $self->{state} = ATTRIBUTE_VALUE_UNQUOTED_STATE;
968          !!!next-input-character;          !!!next-input-character;
969          redo A;          redo A;
970        }        }
971      } elsif ($self->{state} eq 'attribute value (double-quoted)') {      } elsif ($self->{state} == ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE) {
972        if ($self->{next_input_character} == 0x0022) { # "        if ($self->{next_input_character} == 0x0022) { # "
973          $self->{state} = 'before attribute name';          $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE;
974          !!!next-input-character;          !!!next-input-character;
975          redo A;          redo A;
976        } elsif ($self->{next_input_character} == 0x0026) { # &        } elsif ($self->{next_input_character} == 0x0026) { # &
977          $self->{last_attribute_value_state} = 'attribute value (double-quoted)';          $self->{last_attribute_value_state} = $self->{state};
978          $self->{state} = 'entity in attribute value';          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;
979          !!!next-input-character;          !!!next-input-character;
980          redo A;          redo A;
981        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
982          !!!parse-error;          !!!parse-error (type => 'unclosed attribute value');
983          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
984              $self->{current_token}->{first_start_tag}
985                  = not defined $self->{last_emitted_start_tag_name};
986            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
987          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
988            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
989            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
990              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
991            }            }
992          } else {          } else {
993            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
994          }          }
995          $self->{state} = 'data';          $self->{state} = DATA_STATE;
996          ## reconsume          ## reconsume
997    
998          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
999    
1000          redo A;          redo A;
1001        } else {        } else {
# Line 1011  sub _get_next_token ($) { Line 1004  sub _get_next_token ($) {
1004          !!!next-input-character;          !!!next-input-character;
1005          redo A;          redo A;
1006        }        }
1007      } elsif ($self->{state} eq 'attribute value (single-quoted)') {      } elsif ($self->{state} == ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE) {
1008        if ($self->{next_input_character} == 0x0027) { # '        if ($self->{next_input_character} == 0x0027) { # '
1009          $self->{state} = 'before attribute name';          $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE;
1010          !!!next-input-character;          !!!next-input-character;
1011          redo A;          redo A;
1012        } elsif ($self->{next_input_character} == 0x0026) { # &        } elsif ($self->{next_input_character} == 0x0026) { # &
1013          $self->{last_attribute_value_state} = 'attribute value (single-quoted)';          $self->{last_attribute_value_state} = $self->{state};
1014          $self->{state} = 'entity in attribute value';          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;
1015          !!!next-input-character;          !!!next-input-character;
1016          redo A;          redo A;
1017        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1018          !!!parse-error;          !!!parse-error (type => 'unclosed attribute value');
1019          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1020              $self->{current_token}->{first_start_tag}
1021                  = not defined $self->{last_emitted_start_tag_name};
1022            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1023          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
1024            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
1025            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
1026              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
1027            }            }
1028          } else {          } else {
1029            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
1030          }          }
1031          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1032          ## reconsume          ## reconsume
1033    
1034          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
1035    
1036          redo A;          redo A;
1037        } else {        } else {
# Line 1046  sub _get_next_token ($) { Line 1040  sub _get_next_token ($) {
1040          !!!next-input-character;          !!!next-input-character;
1041          redo A;          redo A;
1042        }        }
1043      } elsif ($self->{state} eq 'attribute value (unquoted)') {      } elsif ($self->{state} == ATTRIBUTE_VALUE_UNQUOTED_STATE) {
1044        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1045            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1046            $self->{next_input_character} == 0x000B or # HT            $self->{next_input_character} == 0x000B or # HT
1047            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
1048            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
1049          $self->{state} = 'before attribute name';          $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE;
1050          !!!next-input-character;          !!!next-input-character;
1051          redo A;          redo A;
1052        } elsif ($self->{next_input_character} == 0x0026) { # &        } elsif ($self->{next_input_character} == 0x0026) { # &
1053          $self->{last_attribute_value_state} = 'attribute value (unquoted)';          $self->{last_attribute_value_state} = $self->{state};
1054          $self->{state} = 'entity in attribute value';          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;
1055          !!!next-input-character;          !!!next-input-character;
1056          redo A;          redo A;
1057        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
1058          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1059              $self->{current_token}->{first_start_tag}
1060                  = not defined $self->{last_emitted_start_tag_name};
1061            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1062          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
1063            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
1064            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
1065              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
1066            }            }
1067          } else {          } else {
1068            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
1069          }          }
1070          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1071          !!!next-input-character;          !!!next-input-character;
1072    
1073          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
1074    
1075          redo A;          redo A;
1076        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
1077                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
1078          !!!parse-error;          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1079          if ($self->{current_token}->{type} eq 'start tag') {            $self->{current_token}->{first_start_tag}
1080                  = not defined $self->{last_emitted_start_tag_name};
1081            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1082          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
1083            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
1084            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
1085              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
1086            }            }
1087          } else {          } else {
1088            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
1089          }          }
1090          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1091          ## reconsume          ## reconsume
1092    
1093          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
1094    
1095          redo A;          redo A;
1096        } else {        } else {
# Line 1104  sub _get_next_token ($) { Line 1099  sub _get_next_token ($) {
1099          !!!next-input-character;          !!!next-input-character;
1100          redo A;          redo A;
1101        }        }
1102      } elsif ($self->{state} eq 'entity in attribute value') {      } elsif ($self->{state} == ENTITY_IN_ATTRIBUTE_VALUE_STATE) {
1103        my $token = $self->_tokenize_attempt_to_consume_an_entity;        my $token = $self->_tokenize_attempt_to_consume_an_entity (1);
1104    
1105        unless (defined $token) {        unless (defined $token) {
1106          $self->{current_attribute}->{value} .= '&';          $self->{current_attribute}->{value} .= '&';
# Line 1117  sub _get_next_token ($) { Line 1112  sub _get_next_token ($) {
1112        $self->{state} = $self->{last_attribute_value_state};        $self->{state} = $self->{last_attribute_value_state};
1113        # next-input-character is already done        # next-input-character is already done
1114        redo A;        redo A;
1115      } elsif ($self->{state} eq 'bogus comment') {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
1116        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
1117                
1118        my $token = {type => 'comment', data => ''};        my $token = {type => COMMENT_TOKEN, data => ''};
1119    
1120        BC: {        BC: {
1121          if ($self->{next_input_character} == 0x003E) { # >          if ($self->{next_input_character} == 0x003E) { # >
1122            $self->{state} = 'data';            $self->{state} = DATA_STATE;
1123            !!!next-input-character;            !!!next-input-character;
1124    
1125            !!!emit ($token);            !!!emit ($token);
1126    
1127            redo A;            redo A;
1128          } elsif ($self->{next_input_character} == -1) {          } elsif ($self->{next_input_character} == -1) {
1129            $self->{state} = 'data';            $self->{state} = DATA_STATE;
1130            ## reconsume            ## reconsume
1131    
1132            !!!emit ($token);            !!!emit ($token);
# Line 1143  sub _get_next_token ($) { Line 1138  sub _get_next_token ($) {
1138            redo BC;            redo BC;
1139          }          }
1140        } # BC        } # BC
1141      } elsif ($self->{state} eq 'markup declaration open') {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
1142        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
1143    
1144        my @next_char;        my @next_char;
# Line 1153  sub _get_next_token ($) { Line 1148  sub _get_next_token ($) {
1148          !!!next-input-character;          !!!next-input-character;
1149          push @next_char, $self->{next_input_character};          push @next_char, $self->{next_input_character};
1150          if ($self->{next_input_character} == 0x002D) { # -          if ($self->{next_input_character} == 0x002D) { # -
1151            $self->{current_token} = {type => 'comment', data => ''};            $self->{current_token} = {type => COMMENT_TOKEN, data => ''};
1152            $self->{state} = 'comment';            $self->{state} = COMMENT_START_STATE;
1153            !!!next-input-character;            !!!next-input-character;
1154            redo A;            redo A;
1155          }          }
# Line 1185  sub _get_next_token ($) { Line 1180  sub _get_next_token ($) {
1180                    if ($self->{next_input_character} == 0x0045 or # E                    if ($self->{next_input_character} == 0x0045 or # E
1181                        $self->{next_input_character} == 0x0065) { # e                        $self->{next_input_character} == 0x0065) { # e
1182                      ## ISSUE: What a stupid code this is!                      ## ISSUE: What a stupid code this is!
1183                      $self->{state} = 'DOCTYPE';                      $self->{state} = DOCTYPE_STATE;
1184                      !!!next-input-character;                      !!!next-input-character;
1185                      redo A;                      redo A;
1186                    }                    }
# Line 1196  sub _get_next_token ($) { Line 1191  sub _get_next_token ($) {
1191          }          }
1192        }        }
1193    
1194        !!!parse-error;        !!!parse-error (type => 'bogus comment');
1195        $self->{next_input_character} = shift @next_char;        $self->{next_input_character} = shift @next_char;
1196        !!!back-next-input-character (@next_char);        !!!back-next-input-character (@next_char);
1197        $self->{state} = 'bogus comment';        $self->{state} = BOGUS_COMMENT_STATE;
1198        redo A;        redo A;
1199                
1200        ## ISSUE: typos in spec: chacacters, is is a parse error        ## ISSUE: typos in spec: chacacters, is is a parse error
1201        ## 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?
1202      } elsif ($self->{state} eq 'comment') {      } elsif ($self->{state} == COMMENT_START_STATE) {
1203        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1204          $self->{state} = 'comment dash';          $self->{state} = COMMENT_START_DASH_STATE;
1205          !!!next-input-character;          !!!next-input-character;
1206          redo A;          redo A;
1207          } elsif ($self->{next_input_character} == 0x003E) { # >
1208            !!!parse-error (type => 'bogus comment');
1209            $self->{state} = DATA_STATE;
1210            !!!next-input-character;
1211    
1212            !!!emit ($self->{current_token}); # comment
1213    
1214            redo A;
1215        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1216          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1217          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1218            ## reconsume
1219    
1220            !!!emit ($self->{current_token}); # comment
1221    
1222            redo A;
1223          } else {
1224            $self->{current_token}->{data} # comment
1225                .= chr ($self->{next_input_character});
1226            $self->{state} = COMMENT_STATE;
1227            !!!next-input-character;
1228            redo A;
1229          }
1230        } elsif ($self->{state} == COMMENT_START_DASH_STATE) {
1231          if ($self->{next_input_character} == 0x002D) { # -
1232            $self->{state} = COMMENT_END_STATE;
1233            !!!next-input-character;
1234            redo A;
1235          } elsif ($self->{next_input_character} == 0x003E) { # >
1236            !!!parse-error (type => 'bogus comment');
1237            $self->{state} = DATA_STATE;
1238            !!!next-input-character;
1239    
1240            !!!emit ($self->{current_token}); # comment
1241    
1242            redo A;
1243          } elsif ($self->{next_input_character} == -1) {
1244            !!!parse-error (type => 'unclosed comment');
1245            $self->{state} = DATA_STATE;
1246            ## reconsume
1247    
1248            !!!emit ($self->{current_token}); # comment
1249    
1250            redo A;
1251          } else {
1252            $self->{current_token}->{data} # comment
1253                .= '-' . chr ($self->{next_input_character});
1254            $self->{state} = COMMENT_STATE;
1255            !!!next-input-character;
1256            redo A;
1257          }
1258        } elsif ($self->{state} == COMMENT_STATE) {
1259          if ($self->{next_input_character} == 0x002D) { # -
1260            $self->{state} = COMMENT_END_DASH_STATE;
1261            !!!next-input-character;
1262            redo A;
1263          } elsif ($self->{next_input_character} == -1) {
1264            !!!parse-error (type => 'unclosed comment');
1265            $self->{state} = DATA_STATE;
1266          ## reconsume          ## reconsume
1267    
1268          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1269    
1270          redo A;          redo A;
1271        } else {        } else {
# Line 1224  sub _get_next_token ($) { Line 1274  sub _get_next_token ($) {
1274          !!!next-input-character;          !!!next-input-character;
1275          redo A;          redo A;
1276        }        }
1277      } elsif ($self->{state} eq 'comment dash') {      } elsif ($self->{state} == COMMENT_END_DASH_STATE) {
1278        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1279          $self->{state} = 'comment end';          $self->{state} = COMMENT_END_STATE;
1280          !!!next-input-character;          !!!next-input-character;
1281          redo A;          redo A;
1282        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1283          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1284          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1285          ## reconsume          ## reconsume
1286    
1287          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1288    
1289          redo A;          redo A;
1290        } else {        } else {
1291          $self->{current_token}->{data} .= '-' . chr ($self->{next_input_character}); # comment          $self->{current_token}->{data} .= '-' . chr ($self->{next_input_character}); # comment
1292          $self->{state} = 'comment';          $self->{state} = COMMENT_STATE;
1293          !!!next-input-character;          !!!next-input-character;
1294          redo A;          redo A;
1295        }        }
1296      } elsif ($self->{state} eq 'comment end') {      } elsif ($self->{state} == COMMENT_END_STATE) {
1297        if ($self->{next_input_character} == 0x003E) { # >        if ($self->{next_input_character} == 0x003E) { # >
1298          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1299          !!!next-input-character;          !!!next-input-character;
1300    
1301          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1302    
1303          redo A;          redo A;
1304        } elsif ($self->{next_input_character} == 0x002D) { # -        } elsif ($self->{next_input_character} == 0x002D) { # -
1305          !!!parse-error;          !!!parse-error (type => 'dash in comment');
1306          $self->{current_token}->{data} .= '-'; # comment          $self->{current_token}->{data} .= '-'; # comment
1307          ## Stay in the state          ## Stay in the state
1308          !!!next-input-character;          !!!next-input-character;
1309          redo A;          redo A;
1310        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1311          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1312          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1313          ## reconsume          ## reconsume
1314    
1315          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1316    
1317          redo A;          redo A;
1318        } else {        } else {
1319          !!!parse-error;          !!!parse-error (type => 'dash in comment');
1320          $self->{current_token}->{data} .= '--' . chr ($self->{next_input_character}); # comment          $self->{current_token}->{data} .= '--' . chr ($self->{next_input_character}); # comment
1321          $self->{state} = 'comment';          $self->{state} = COMMENT_STATE;
1322          !!!next-input-character;          !!!next-input-character;
1323          redo A;          redo A;
1324        }        }
1325      } elsif ($self->{state} eq 'DOCTYPE') {      } elsif ($self->{state} == DOCTYPE_STATE) {
1326        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1327            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1328            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
1329            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
1330            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
1331          $self->{state} = 'before DOCTYPE name';          $self->{state} = BEFORE_DOCTYPE_NAME_STATE;
1332          !!!next-input-character;          !!!next-input-character;
1333          redo A;          redo A;
1334        } else {        } else {
1335          !!!parse-error;          !!!parse-error (type => 'no space before DOCTYPE name');
1336          $self->{state} = 'before DOCTYPE name';          $self->{state} = BEFORE_DOCTYPE_NAME_STATE;
1337          ## reconsume          ## reconsume
1338          redo A;          redo A;
1339        }        }
1340      } elsif ($self->{state} eq 'before DOCTYPE name') {      } elsif ($self->{state} == BEFORE_DOCTYPE_NAME_STATE) {
1341        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1342            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1343            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
# Line 1299  sub _get_next_token ($) { Line 1346  sub _get_next_token ($) {
1346          ## Stay in the state          ## Stay in the state
1347          !!!next-input-character;          !!!next-input-character;
1348          redo A;          redo A;
       } elsif (0x0061 <= $self->{next_input_character} and  
                $self->{next_input_character} <= 0x007A) { # a..z  
         $self->{current_token} = {type => 'DOCTYPE',  
                           name => chr ($self->{next_input_character} - 0x0020),  
                           error => 1};  
         $self->{state} = 'DOCTYPE name';  
         !!!next-input-character;  
         redo A;  
1349        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
1350          !!!parse-error;          !!!parse-error (type => 'no DOCTYPE name');
1351          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1352          !!!next-input-character;          !!!next-input-character;
1353    
1354          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => DOCTYPE_TOKEN}); # incorrect
1355    
1356          redo A;          redo A;
1357        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1358          !!!parse-error;          !!!parse-error (type => 'no DOCTYPE name');
1359          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1360          ## reconsume          ## reconsume
1361    
1362          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => DOCTYPE_TOKEN}); # incorrect
1363    
1364          redo A;          redo A;
1365        } else {        } else {
1366          $self->{current_token} = {type => 'DOCTYPE',          $self->{current_token}
1367                            name => chr ($self->{next_input_character}),              = {type => DOCTYPE_TOKEN,
1368                            error => 1};                 name => chr ($self->{next_input_character}),
1369          $self->{state} = 'DOCTYPE name';                 correct => 1};
1370    ## ISSUE: "Set the token's name name to the" in the spec
1371            $self->{state} = DOCTYPE_NAME_STATE;
1372          !!!next-input-character;          !!!next-input-character;
1373          redo A;          redo A;
1374        }        }
1375      } elsif ($self->{state} eq 'DOCTYPE name') {      } elsif ($self->{state} == DOCTYPE_NAME_STATE) {
1376    ## ISSUE: Redundant "First," in the spec.
1377        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1378            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1379            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
1380            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
1381            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
1382          $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE          $self->{state} = AFTER_DOCTYPE_NAME_STATE;
         $self->{state} = 'after DOCTYPE name';  
1383          !!!next-input-character;          !!!next-input-character;
1384          redo A;          redo A;
1385        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
1386          $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE          $self->{state} = DATA_STATE;
         $self->{state} = 'data';  
1387          !!!next-input-character;          !!!next-input-character;
1388    
1389          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1390    
1391          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;  
1392        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1393          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
1394          $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE          $self->{state} = DATA_STATE;
         $self->{state} = 'data';  
1395          ## reconsume          ## reconsume
1396    
1397          !!!emit ($self->{current_token});          delete $self->{current_token}->{correct};
1398          undef $self->{current_token};          !!!emit ($self->{current_token}); # DOCTYPE
1399    
1400          redo A;          redo A;
1401        } else {        } else {
1402          $self->{current_token}->{name}          $self->{current_token}->{name}
1403            .= chr ($self->{next_input_character}); # DOCTYPE            .= chr ($self->{next_input_character}); # DOCTYPE
         #$self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML');  
1404          ## Stay in the state          ## Stay in the state
1405          !!!next-input-character;          !!!next-input-character;
1406          redo A;          redo A;
1407        }        }
1408      } elsif ($self->{state} eq 'after DOCTYPE name') {      } elsif ($self->{state} == AFTER_DOCTYPE_NAME_STATE) {
1409        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1410            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1411            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
# Line 1385  sub _get_next_token ($) { Line 1415  sub _get_next_token ($) {
1415          !!!next-input-character;          !!!next-input-character;
1416          redo A;          redo A;
1417        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
1418          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1419          !!!next-input-character;          !!!next-input-character;
1420    
1421          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1422    
1423          redo A;          redo A;
1424        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1425          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
1426          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1427          ## reconsume          ## reconsume
1428    
1429            delete $self->{current_token}->{correct};
1430          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1431    
1432          redo A;          redo A;
1433          } elsif ($self->{next_input_character} == 0x0050 or # P
1434                   $self->{next_input_character} == 0x0070) { # p
1435            !!!next-input-character;
1436            if ($self->{next_input_character} == 0x0055 or # U
1437                $self->{next_input_character} == 0x0075) { # u
1438              !!!next-input-character;
1439              if ($self->{next_input_character} == 0x0042 or # B
1440                  $self->{next_input_character} == 0x0062) { # b
1441                !!!next-input-character;
1442                if ($self->{next_input_character} == 0x004C or # L
1443                    $self->{next_input_character} == 0x006C) { # l
1444                  !!!next-input-character;
1445                  if ($self->{next_input_character} == 0x0049 or # I
1446                      $self->{next_input_character} == 0x0069) { # i
1447                    !!!next-input-character;
1448                    if ($self->{next_input_character} == 0x0043 or # C
1449                        $self->{next_input_character} == 0x0063) { # c
1450                      $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
1451                      !!!next-input-character;
1452                      redo A;
1453                    }
1454                  }
1455                }
1456              }
1457            }
1458    
1459            #
1460          } elsif ($self->{next_input_character} == 0x0053 or # S
1461                   $self->{next_input_character} == 0x0073) { # s
1462            !!!next-input-character;
1463            if ($self->{next_input_character} == 0x0059 or # Y
1464                $self->{next_input_character} == 0x0079) { # y
1465              !!!next-input-character;
1466              if ($self->{next_input_character} == 0x0053 or # S
1467                  $self->{next_input_character} == 0x0073) { # s
1468                !!!next-input-character;
1469                if ($self->{next_input_character} == 0x0054 or # T
1470                    $self->{next_input_character} == 0x0074) { # t
1471                  !!!next-input-character;
1472                  if ($self->{next_input_character} == 0x0045 or # E
1473                      $self->{next_input_character} == 0x0065) { # e
1474                    !!!next-input-character;
1475                    if ($self->{next_input_character} == 0x004D or # M
1476                        $self->{next_input_character} == 0x006D) { # m
1477                      $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
1478                      !!!next-input-character;
1479                      redo A;
1480                    }
1481                  }
1482                }
1483              }
1484            }
1485    
1486            #
1487        } else {        } else {
1488          !!!parse-error;          !!!next-input-character;
1489          $self->{current_token}->{error} = 1; # DOCTYPE          #
1490          $self->{state} = 'bogus DOCTYPE';        }
1491    
1492          !!!parse-error (type => 'string after DOCTYPE name');
1493          $self->{state} = BOGUS_DOCTYPE_STATE;
1494          # next-input-character is already done
1495          redo A;
1496        } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
1497          if ({
1498                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1499                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1500              }->{$self->{next_input_character}}) {
1501            ## Stay in the state
1502            !!!next-input-character;
1503            redo A;
1504          } elsif ($self->{next_input_character} eq 0x0022) { # "
1505            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1506            $self->{state} = DOCTYPE_PUBLIC_IDENTIFIER_DOUBLE_QUOTED_STATE;
1507            !!!next-input-character;
1508            redo A;
1509          } elsif ($self->{next_input_character} eq 0x0027) { # '
1510            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1511            $self->{state} = DOCTYPE_PUBLIC_IDENTIFIER_SINGLE_QUOTED_STATE;
1512            !!!next-input-character;
1513            redo A;
1514          } elsif ($self->{next_input_character} eq 0x003E) { # >
1515            !!!parse-error (type => 'no PUBLIC literal');
1516    
1517            $self->{state} = DATA_STATE;
1518            !!!next-input-character;
1519    
1520            delete $self->{current_token}->{correct};
1521            !!!emit ($self->{current_token}); # DOCTYPE
1522    
1523            redo A;
1524          } elsif ($self->{next_input_character} == -1) {
1525            !!!parse-error (type => 'unclosed DOCTYPE');
1526    
1527            $self->{state} = DATA_STATE;
1528            ## reconsume
1529    
1530            delete $self->{current_token}->{correct};
1531            !!!emit ($self->{current_token}); # DOCTYPE
1532    
1533            redo A;
1534          } else {
1535            !!!parse-error (type => 'string after PUBLIC');
1536            $self->{state} = BOGUS_DOCTYPE_STATE;
1537            !!!next-input-character;
1538            redo A;
1539          }
1540        } elsif ($self->{state} == DOCTYPE_PUBLIC_IDENTIFIER_DOUBLE_QUOTED_STATE) {
1541          if ($self->{next_input_character} == 0x0022) { # "
1542            $self->{state} = AFTER_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
1543            !!!next-input-character;
1544            redo A;
1545          } elsif ($self->{next_input_character} == -1) {
1546            !!!parse-error (type => 'unclosed PUBLIC literal');
1547    
1548            $self->{state} = DATA_STATE;
1549            ## reconsume
1550    
1551            delete $self->{current_token}->{correct};
1552            !!!emit ($self->{current_token}); # DOCTYPE
1553    
1554            redo A;
1555          } else {
1556            $self->{current_token}->{public_identifier} # DOCTYPE
1557                .= chr $self->{next_input_character};
1558            ## Stay in the state
1559            !!!next-input-character;
1560            redo A;
1561          }
1562        } elsif ($self->{state} == DOCTYPE_PUBLIC_IDENTIFIER_SINGLE_QUOTED_STATE) {
1563          if ($self->{next_input_character} == 0x0027) { # '
1564            $self->{state} = AFTER_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
1565            !!!next-input-character;
1566            redo A;
1567          } elsif ($self->{next_input_character} == -1) {
1568            !!!parse-error (type => 'unclosed PUBLIC literal');
1569    
1570            $self->{state} = DATA_STATE;
1571            ## reconsume
1572    
1573            delete $self->{current_token}->{correct};
1574            !!!emit ($self->{current_token}); # DOCTYPE
1575    
1576            redo A;
1577          } else {
1578            $self->{current_token}->{public_identifier} # DOCTYPE
1579                .= chr $self->{next_input_character};
1580            ## Stay in the state
1581            !!!next-input-character;
1582            redo A;
1583          }
1584        } elsif ($self->{state} == AFTER_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
1585          if ({
1586                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1587                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1588              }->{$self->{next_input_character}}) {
1589            ## Stay in the state
1590            !!!next-input-character;
1591            redo A;
1592          } elsif ($self->{next_input_character} == 0x0022) { # "
1593            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1594            $self->{state} = DOCTYPE_SYSTEM_IDENTIFIER_DOUBLE_QUOTED_STATE;
1595            !!!next-input-character;
1596            redo A;
1597          } elsif ($self->{next_input_character} == 0x0027) { # '
1598            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1599            $self->{state} = DOCTYPE_SYSTEM_IDENTIFIER_SINGLE_QUOTED_STATE;
1600            !!!next-input-character;
1601            redo A;
1602          } elsif ($self->{next_input_character} == 0x003E) { # >
1603            $self->{state} = DATA_STATE;
1604            !!!next-input-character;
1605    
1606            !!!emit ($self->{current_token}); # DOCTYPE
1607    
1608            redo A;
1609          } elsif ($self->{next_input_character} == -1) {
1610            !!!parse-error (type => 'unclosed DOCTYPE');
1611    
1612            $self->{state} = DATA_STATE;
1613            ## reconsume
1614    
1615            delete $self->{current_token}->{correct};
1616            !!!emit ($self->{current_token}); # DOCTYPE
1617    
1618            redo A;
1619          } else {
1620            !!!parse-error (type => 'string after PUBLIC literal');
1621            $self->{state} = BOGUS_DOCTYPE_STATE;
1622            !!!next-input-character;
1623            redo A;
1624          }
1625        } elsif ($self->{state} == BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE) {
1626          if ({
1627                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1628                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1629              }->{$self->{next_input_character}}) {
1630            ## Stay in the state
1631            !!!next-input-character;
1632            redo A;
1633          } elsif ($self->{next_input_character} == 0x0022) { # "
1634            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1635            $self->{state} = DOCTYPE_SYSTEM_IDENTIFIER_DOUBLE_QUOTED_STATE;
1636            !!!next-input-character;
1637            redo A;
1638          } elsif ($self->{next_input_character} == 0x0027) { # '
1639            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1640            $self->{state} = DOCTYPE_SYSTEM_IDENTIFIER_SINGLE_QUOTED_STATE;
1641            !!!next-input-character;
1642            redo A;
1643          } elsif ($self->{next_input_character} == 0x003E) { # >
1644            !!!parse-error (type => 'no SYSTEM literal');
1645            $self->{state} = DATA_STATE;
1646            !!!next-input-character;
1647    
1648            delete $self->{current_token}->{correct};
1649            !!!emit ($self->{current_token}); # DOCTYPE
1650    
1651            redo A;
1652          } elsif ($self->{next_input_character} == -1) {
1653            !!!parse-error (type => 'unclosed DOCTYPE');
1654    
1655            $self->{state} = DATA_STATE;
1656            ## reconsume
1657    
1658            delete $self->{current_token}->{correct};
1659            !!!emit ($self->{current_token}); # DOCTYPE
1660    
1661            redo A;
1662          } else {
1663            !!!parse-error (type => 'string after SYSTEM');
1664            $self->{state} = BOGUS_DOCTYPE_STATE;
1665          !!!next-input-character;          !!!next-input-character;
1666          redo A;          redo A;
1667        }        }
1668      } elsif ($self->{state} eq 'bogus DOCTYPE') {      } elsif ($self->{state} == DOCTYPE_SYSTEM_IDENTIFIER_DOUBLE_QUOTED_STATE) {
1669          if ($self->{next_input_character} == 0x0022) { # "
1670            $self->{state} = AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
1671            !!!next-input-character;
1672            redo A;
1673          } elsif ($self->{next_input_character} == -1) {
1674            !!!parse-error (type => 'unclosed SYSTEM literal');
1675    
1676            $self->{state} = DATA_STATE;
1677            ## reconsume
1678    
1679            delete $self->{current_token}->{correct};
1680            !!!emit ($self->{current_token}); # DOCTYPE
1681    
1682            redo A;
1683          } else {
1684            $self->{current_token}->{system_identifier} # DOCTYPE
1685                .= chr $self->{next_input_character};
1686            ## Stay in the state
1687            !!!next-input-character;
1688            redo A;
1689          }
1690        } elsif ($self->{state} == DOCTYPE_SYSTEM_IDENTIFIER_SINGLE_QUOTED_STATE) {
1691          if ($self->{next_input_character} == 0x0027) { # '
1692            $self->{state} = AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
1693            !!!next-input-character;
1694            redo A;
1695          } elsif ($self->{next_input_character} == -1) {
1696            !!!parse-error (type => 'unclosed SYSTEM literal');
1697    
1698            $self->{state} = DATA_STATE;
1699            ## reconsume
1700    
1701            delete $self->{current_token}->{correct};
1702            !!!emit ($self->{current_token}); # DOCTYPE
1703    
1704            redo A;
1705          } else {
1706            $self->{current_token}->{system_identifier} # DOCTYPE
1707                .= chr $self->{next_input_character};
1708            ## Stay in the state
1709            !!!next-input-character;
1710            redo A;
1711          }
1712        } elsif ($self->{state} == AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STATE) {
1713          if ({
1714                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1715                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1716              }->{$self->{next_input_character}}) {
1717            ## Stay in the state
1718            !!!next-input-character;
1719            redo A;
1720          } elsif ($self->{next_input_character} == 0x003E) { # >
1721            $self->{state} = DATA_STATE;
1722            !!!next-input-character;
1723    
1724            !!!emit ($self->{current_token}); # DOCTYPE
1725    
1726            redo A;
1727          } elsif ($self->{next_input_character} == -1) {
1728            !!!parse-error (type => 'unclosed DOCTYPE');
1729    
1730            $self->{state} = DATA_STATE;
1731            ## reconsume
1732    
1733            delete $self->{current_token}->{correct};
1734            !!!emit ($self->{current_token}); # DOCTYPE
1735    
1736            redo A;
1737          } else {
1738            !!!parse-error (type => 'string after SYSTEM literal');
1739            $self->{state} = BOGUS_DOCTYPE_STATE;
1740            !!!next-input-character;
1741            redo A;
1742          }
1743        } elsif ($self->{state} == BOGUS_DOCTYPE_STATE) {
1744        if ($self->{next_input_character} == 0x003E) { # >        if ($self->{next_input_character} == 0x003E) { # >
1745          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1746          !!!next-input-character;          !!!next-input-character;
1747    
1748            delete $self->{current_token}->{correct};
1749          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1750    
1751          redo A;          redo A;
1752        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1753          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
1754          $self->{state} = 'data';          $self->{state} = DATA_STATE;
1755          ## reconsume          ## reconsume
1756    
1757            delete $self->{current_token}->{correct};
1758          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1759    
1760          redo A;          redo A;
1761        } else {        } else {
# Line 1439  sub _get_next_token ($) { Line 1771  sub _get_next_token ($) {
1771    die "$0: _get_next_token: unexpected case";    die "$0: _get_next_token: unexpected case";
1772  } # _get_next_token  } # _get_next_token
1773    
1774  sub _tokenize_attempt_to_consume_an_entity ($) {  sub _tokenize_attempt_to_consume_an_entity ($$) {
1775    my $self = shift;    my ($self, $in_attr) = @_;
1776      
1777    if ($self->{next_input_character} == 0x0023) { # #    if ({
1778           0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
1779           0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR
1780          }->{$self->{next_input_character}}) {
1781        ## Don't consume
1782        ## No error
1783        return undef;
1784      } elsif ($self->{next_input_character} == 0x0023) { # #
1785      !!!next-input-character;      !!!next-input-character;
     my $num;  
1786      if ($self->{next_input_character} == 0x0078 or # x      if ($self->{next_input_character} == 0x0078 or # x
1787          $self->{next_input_character} == 0x0058) { # X          $self->{next_input_character} == 0x0058) { # X
1788          my $code;
1789        X: {        X: {
1790          my $x_char = $self->{next_input_character};          my $x_char = $self->{next_input_character};
1791          !!!next-input-character;          !!!next-input-character;
1792          if (0x0030 <= $self->{next_input_character} and          if (0x0030 <= $self->{next_input_character} and
1793              $self->{next_input_character} <= 0x0039) { # 0..9              $self->{next_input_character} <= 0x0039) { # 0..9
1794            $num ||= 0;            $code ||= 0;
1795            $num *= 0x10;            $code *= 0x10;
1796            $num += $self->{next_input_character} - 0x0030;            $code += $self->{next_input_character} - 0x0030;
1797            redo X;            redo X;
1798          } elsif (0x0061 <= $self->{next_input_character} and          } elsif (0x0061 <= $self->{next_input_character} and
1799                   $self->{next_input_character} <= 0x0066) { # a..f                   $self->{next_input_character} <= 0x0066) { # a..f
1800            ## ISSUE: the spec says U+0078, which is apparently incorrect            $code ||= 0;
1801            $num ||= 0;            $code *= 0x10;
1802            $num *= 0x10;            $code += $self->{next_input_character} - 0x0060 + 9;
           $num += $self->{next_input_character} - 0x0060 + 9;  
1803            redo X;            redo X;
1804          } elsif (0x0041 <= $self->{next_input_character} and          } elsif (0x0041 <= $self->{next_input_character} and
1805                   $self->{next_input_character} <= 0x0046) { # A..F                   $self->{next_input_character} <= 0x0046) { # A..F
1806            ## ISSUE: the spec says U+0058, which is apparently incorrect            $code ||= 0;
1807            $num ||= 0;            $code *= 0x10;
1808            $num *= 0x10;            $code += $self->{next_input_character} - 0x0040 + 9;
           $num += $self->{next_input_character} - 0x0040 + 9;  
1809            redo X;            redo X;
1810          } elsif (not defined $num) { # no hexadecimal digit          } elsif (not defined $code) { # no hexadecimal digit
1811            !!!parse-error;            !!!parse-error (type => 'bare hcro');
1812              !!!back-next-input-character ($x_char, $self->{next_input_character});
1813            $self->{next_input_character} = 0x0023; # #            $self->{next_input_character} = 0x0023; # #
           !!!back-next-input-character ($x_char);  
1814            return undef;            return undef;
1815          } elsif ($self->{next_input_character} == 0x003B) { # ;          } elsif ($self->{next_input_character} == 0x003B) { # ;
1816            !!!next-input-character;            !!!next-input-character;
1817          } else {          } else {
1818            !!!parse-error;            !!!parse-error (type => 'no refc');
1819          }          }
1820    
1821          ## TODO: check the definition for |a valid Unicode character|.          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
1822          if ($num > 1114111 or $num == 0) {            !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1823            $num = 0xFFFD; # REPLACEMENT CHARACTER            $code = 0xFFFD;
1824            ## ISSUE: Why this is not an error?          } elsif ($code > 0x10FFFF) {
1825              !!!parse-error (type => sprintf 'invalid character reference:U-%08X', $code);
1826              $code = 0xFFFD;
1827            } elsif ($code == 0x000D) {
1828              !!!parse-error (type => 'CR character reference');
1829              $code = 0x000A;
1830            } elsif (0x80 <= $code and $code <= 0x9F) {
1831              !!!parse-error (type => sprintf 'C1 character reference:U+%04X', $code);
1832              $code = $c1_entity_char->{$code};
1833          }          }
1834    
1835          return {type => 'character', data => chr $num};          return {type => CHARACTER_TOKEN, data => chr $code};
1836        } # X        } # X
1837      } elsif (0x0030 <= $self->{next_input_character} and      } elsif (0x0030 <= $self->{next_input_character} and
1838               $self->{next_input_character} <= 0x0039) { # 0..9               $self->{next_input_character} <= 0x0039) { # 0..9
# Line 1505  sub _tokenize_attempt_to_consume_an_enti Line 1850  sub _tokenize_attempt_to_consume_an_enti
1850        if ($self->{next_input_character} == 0x003B) { # ;        if ($self->{next_input_character} == 0x003B) { # ;
1851          !!!next-input-character;          !!!next-input-character;
1852        } else {        } else {
1853          !!!parse-error;          !!!parse-error (type => 'no refc');
1854        }        }
1855    
1856        ## TODO: check the definition for |a valid Unicode character|.        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
1857        if ($code > 1114111 or $code == 0) {          !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1858          $code = 0xFFFD; # REPLACEMENT CHARACTER          $code = 0xFFFD;
1859          ## ISSUE: Why this is not an error?        } elsif ($code > 0x10FFFF) {
1860            !!!parse-error (type => sprintf 'invalid character reference:U-%08X', $code);
1861            $code = 0xFFFD;
1862          } elsif ($code == 0x000D) {
1863            !!!parse-error (type => 'CR character reference');
1864            $code = 0x000A;
1865          } elsif (0x80 <= $code and $code <= 0x9F) {
1866            !!!parse-error (type => sprintf 'C1 character reference:U+%04X', $code);
1867            $code = $c1_entity_char->{$code};
1868        }        }
1869                
1870        return {type => 'character', data => chr $code};        return {type => CHARACTER_TOKEN, data => chr $code};
1871      } else {      } else {
1872        !!!parse-error;        !!!parse-error (type => 'bare nero');
1873        !!!back-next-input-character ($self->{next_input_character});        !!!back-next-input-character ($self->{next_input_character});
1874        $self->{next_input_character} = 0x0023; # #        $self->{next_input_character} = 0x0023; # #
1875        return undef;        return undef;
# Line 1529  sub _tokenize_attempt_to_consume_an_enti Line 1882  sub _tokenize_attempt_to_consume_an_enti
1882      !!!next-input-character;      !!!next-input-character;
1883    
1884      my $value = $entity_name;      my $value = $entity_name;
1885      my $match;      my $match = 0;
1886        require Whatpm::_NamedEntityList;
1887        our $EntityChar;
1888    
1889      while (length $entity_name < 10 and      while (length $entity_name < 10 and
1890             ## NOTE: Some number greater than the maximum length of entity name             ## NOTE: Some number greater than the maximum length of entity name
1891             ((0x0041 <= $self->{next_input_character} and             ((0x0041 <= $self->{next_input_character} and # a
1892               $self->{next_input_character} <= 0x005A) or               $self->{next_input_character} <= 0x005A) or # x
1893              (0x0061 <= $self->{next_input_character} and              (0x0061 <= $self->{next_input_character} and # a
1894               $self->{next_input_character} <= 0x007A) or               $self->{next_input_character} <= 0x007A) or # z
1895              (0x0030 <= $self->{next_input_character} and              (0x0030 <= $self->{next_input_character} and # 0
1896               $self->{next_input_character} <= 0x0039))) {               $self->{next_input_character} <= 0x0039) or # 9
1897                $self->{next_input_character} == 0x003B)) { # ;
1898        $entity_name .= chr $self->{next_input_character};        $entity_name .= chr $self->{next_input_character};
1899        if (defined $entity_char->{$entity_name}) {        if (defined $EntityChar->{$entity_name}) {
1900          $value = $entity_char->{$entity_name};          if ($self->{next_input_character} == 0x003B) { # ;
1901          $match = 1;            $value = $EntityChar->{$entity_name};
1902              $match = 1;
1903              !!!next-input-character;
1904              last;
1905            } else {
1906              $value = $EntityChar->{$entity_name};
1907              $match = -1;
1908              !!!next-input-character;
1909            }
1910        } else {        } else {
1911          $value .= chr $self->{next_input_character};          $value .= chr $self->{next_input_character};
1912            $match *= 2;
1913            !!!next-input-character;
1914        }        }
       !!!next-input-character;  
1915      }      }
1916            
1917      if ($match) {      if ($match > 0) {
1918        if ($self->{next_input_character} == 0x003B) { # ;        return {type => CHARACTER_TOKEN, data => $value};
1919          !!!next-input-character;      } elsif ($match < 0) {
1920          !!!parse-error (type => 'no refc');
1921          if ($in_attr and $match < -1) {
1922            return {type => CHARACTER_TOKEN, data => '&'.$entity_name};
1923        } else {        } else {
1924          !!!parse-error;          return {type => CHARACTER_TOKEN, data => $value};
1925        }        }
   
       return {type => 'character', data => $value};  
1926      } else {      } else {
1927        !!!parse-error;        !!!parse-error (type => 'bare ero');
1928        ## NOTE: No characters are consumed in the spec.        ## NOTE: No characters are consumed in the spec.
1929        !!!back-token ({type => 'character', data => $value});        return {type => CHARACTER_TOKEN, data => '&'.$value};
       return undef;  
1930      }      }
1931    } else {    } else {
1932      ## no characters are consumed      ## no characters are consumed
1933      !!!parse-error;      !!!parse-error (type => 'bare ero');
1934      return undef;      return undef;
1935    }    }
1936  } # _tokenize_attempt_to_consume_an_entity  } # _tokenize_attempt_to_consume_an_entity
# Line 1576  sub _initialize_tree_constructor ($) { Line 1941  sub _initialize_tree_constructor ($) {
1941    $self->{document}->strict_error_checking (0);    $self->{document}->strict_error_checking (0);
1942    ## TODO: Turn mutation events off # MUST    ## TODO: Turn mutation events off # MUST
1943    ## TODO: Turn loose Document option (manakai extension) on    ## TODO: Turn loose Document option (manakai extension) on
1944    ## TODO: Mark the Document as an HTML document # MUST    $self->{document}->manakai_is_html (1); # MUST
1945  } # _initialize_tree_constructor  } # _initialize_tree_constructor
1946    
1947  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 1587  sub _terminate_tree_constructor ($) { Line 1952  sub _terminate_tree_constructor ($) {
1952    
1953  ## ISSUE: Should append_child (for example) in script executed in tree construction stage fire mutation events?  ## ISSUE: Should append_child (for example) in script executed in tree construction stage fire mutation events?
1954    
1955    { # tree construction stage
1956      my $token;
1957    
1958  sub _construct_tree ($) {  sub _construct_tree ($) {
1959    my ($self) = @_;    my ($self) = @_;
1960    
# Line 1598  sub _construct_tree ($) { Line 1966  sub _construct_tree ($) {
1966    ## characters and insert one Text node whose data is concatenation    ## characters and insert one Text node whose data is concatenation
1967    ## of all those characters. # MUST    ## of all those characters. # MUST
1968        
   my $token;  
1969    !!!next-token;    !!!next-token;
1970    
1971    my $phase = 'initial'; # MUST    $self->{insertion_mode} = BEFORE_HEAD_IM;
1972      undef $self->{form_element};
1973      undef $self->{head_element};
1974      $self->{open_elements} = [];
1975      undef $self->{inner_html_node};
1976    
1977      $self->_tree_construction_initial; # MUST
1978      $self->_tree_construction_root_element;
1979      $self->_tree_construction_main;
1980    } # _construct_tree
1981    
1982    sub _tree_construction_initial ($) {
1983      my $self = shift;
1984      INITIAL: {
1985        if ($token->{type} == DOCTYPE_TOKEN) {
1986          ## NOTE: Conformance checkers MAY, instead of reporting "not HTML5"
1987          ## error, switch to a conformance checking mode for another
1988          ## language.
1989          my $doctype_name = $token->{name};
1990          $doctype_name = '' unless defined $doctype_name;
1991          $doctype_name =~ tr/a-z/A-Z/;
1992          if (not defined $token->{name} or # <!DOCTYPE>
1993              defined $token->{public_identifier} or
1994              defined $token->{system_identifier}) {
1995            !!!parse-error (type => 'not HTML5');
1996          } elsif ($doctype_name ne 'HTML') {
1997            ## ISSUE: ASCII case-insensitive? (in fact it does not matter)
1998            !!!parse-error (type => 'not HTML5');
1999          }
2000          
2001          my $doctype = $self->{document}->create_document_type_definition
2002            ($token->{name}); ## ISSUE: If name is missing (e.g. <!DOCTYPE>)?
2003          $doctype->public_id ($token->{public_identifier})
2004              if defined $token->{public_identifier};
2005          $doctype->system_id ($token->{system_identifier})
2006              if defined $token->{system_identifier};
2007          ## NOTE: Other DocumentType attributes are null or empty lists.
2008          ## ISSUE: internalSubset = null??
2009          $self->{document}->append_child ($doctype);
2010          
2011          if (not $token->{correct} or $doctype_name ne 'HTML') {
2012            $self->{document}->manakai_compat_mode ('quirks');
2013          } elsif (defined $token->{public_identifier}) {
2014            my $pubid = $token->{public_identifier};
2015            $pubid =~ tr/a-z/A-z/;
2016            if ({
2017              "+//SILMARIL//DTD HTML PRO V0R11 19970101//EN" => 1,
2018              "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
2019              "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
2020              "-//IETF//DTD HTML 2.0 LEVEL 1//EN" => 1,
2021              "-//IETF//DTD HTML 2.0 LEVEL 2//EN" => 1,
2022              "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//EN" => 1,
2023              "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//EN" => 1,
2024              "-//IETF//DTD HTML 2.0 STRICT//EN" => 1,
2025              "-//IETF//DTD HTML 2.0//EN" => 1,
2026              "-//IETF//DTD HTML 2.1E//EN" => 1,
2027              "-//IETF//DTD HTML 3.0//EN" => 1,
2028              "-//IETF//DTD HTML 3.0//EN//" => 1,
2029              "-//IETF//DTD HTML 3.2 FINAL//EN" => 1,
2030              "-//IETF//DTD HTML 3.2//EN" => 1,
2031              "-//IETF//DTD HTML 3//EN" => 1,
2032              "-//IETF//DTD HTML LEVEL 0//EN" => 1,
2033              "-//IETF//DTD HTML LEVEL 0//EN//2.0" => 1,
2034              "-//IETF//DTD HTML LEVEL 1//EN" => 1,
2035              "-//IETF//DTD HTML LEVEL 1//EN//2.0" => 1,
2036              "-//IETF//DTD HTML LEVEL 2//EN" => 1,
2037              "-//IETF//DTD HTML LEVEL 2//EN//2.0" => 1,
2038              "-//IETF//DTD HTML LEVEL 3//EN" => 1,
2039              "-//IETF//DTD HTML LEVEL 3//EN//3.0" => 1,
2040              "-//IETF//DTD HTML STRICT LEVEL 0//EN" => 1,
2041              "-//IETF//DTD HTML STRICT LEVEL 0//EN//2.0" => 1,
2042              "-//IETF//DTD HTML STRICT LEVEL 1//EN" => 1,
2043              "-//IETF//DTD HTML STRICT LEVEL 1//EN//2.0" => 1,
2044              "-//IETF//DTD HTML STRICT LEVEL 2//EN" => 1,
2045              "-//IETF//DTD HTML STRICT LEVEL 2//EN//2.0" => 1,
2046              "-//IETF//DTD HTML STRICT LEVEL 3//EN" => 1,
2047              "-//IETF//DTD HTML STRICT LEVEL 3//EN//3.0" => 1,
2048              "-//IETF//DTD HTML STRICT//EN" => 1,
2049              "-//IETF//DTD HTML STRICT//EN//2.0" => 1,
2050              "-//IETF//DTD HTML STRICT//EN//3.0" => 1,
2051              "-//IETF//DTD HTML//EN" => 1,
2052              "-//IETF//DTD HTML//EN//2.0" => 1,
2053              "-//IETF//DTD HTML//EN//3.0" => 1,
2054              "-//METRIUS//DTD METRIUS PRESENTATIONAL//EN" => 1,
2055              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//EN" => 1,
2056              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//EN" => 1,
2057              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//EN" => 1,
2058              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//EN" => 1,
2059              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//EN" => 1,
2060              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//EN" => 1,
2061              "-//NETSCAPE COMM. CORP.//DTD HTML//EN" => 1,
2062              "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//EN" => 1,
2063              "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//EN" => 1,
2064              "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//EN" => 1,
2065              "-//SPYGLASS//DTD HTML 2.0 EXTENDED//EN" => 1,
2066              "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//EN" => 1,
2067              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//EN" => 1,
2068              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//EN" => 1,
2069              "-//W3C//DTD HTML 3 1995-03-24//EN" => 1,
2070              "-//W3C//DTD HTML 3.2 DRAFT//EN" => 1,
2071              "-//W3C//DTD HTML 3.2 FINAL//EN" => 1,
2072              "-//W3C//DTD HTML 3.2//EN" => 1,
2073              "-//W3C//DTD HTML 3.2S DRAFT//EN" => 1,
2074              "-//W3C//DTD HTML 4.0 FRAMESET//EN" => 1,
2075              "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN" => 1,
2076              "-//W3C//DTD HTML EXPERIMETNAL 19960712//EN" => 1,
2077              "-//W3C//DTD HTML EXPERIMENTAL 970421//EN" => 1,
2078              "-//W3C//DTD W3 HTML//EN" => 1,
2079              "-//W3O//DTD W3 HTML 3.0//EN" => 1,
2080              "-//W3O//DTD W3 HTML 3.0//EN//" => 1,
2081              "-//W3O//DTD W3 HTML STRICT 3.0//EN//" => 1,
2082              "-//WEBTECHS//DTD MOZILLA HTML 2.0//EN" => 1,
2083              "-//WEBTECHS//DTD MOZILLA HTML//EN" => 1,
2084              "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" => 1,
2085              "HTML" => 1,
2086            }->{$pubid}) {
2087              $self->{document}->manakai_compat_mode ('quirks');
2088            } elsif ($pubid eq "-//W3C//DTD HTML 4.01 FRAMESET//EN" or
2089                     $pubid eq "-//W3C//DTD HTML 4.01 TRANSITIONAL//EN") {
2090              if (defined $token->{system_identifier}) {
2091                $self->{document}->manakai_compat_mode ('quirks');
2092              } else {
2093                $self->{document}->manakai_compat_mode ('limited quirks');
2094              }
2095            } elsif ($pubid eq "-//W3C//DTD XHTML 1.0 Frameset//EN" or
2096                     $pubid eq "-//W3C//DTD XHTML 1.0 Transitional//EN") {
2097              $self->{document}->manakai_compat_mode ('limited quirks');
2098            }
2099          }
2100          if (defined $token->{system_identifier}) {
2101            my $sysid = $token->{system_identifier};
2102            $sysid =~ tr/A-Z/a-z/;
2103            if ($sysid eq "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd") {
2104              $self->{document}->manakai_compat_mode ('quirks');
2105            }
2106          }
2107          
2108          ## Go to the root element phase.
2109          !!!next-token;
2110          return;
2111        } elsif ({
2112                  START_TAG_TOKEN, 1,
2113                  END_TAG_TOKEN, 1,
2114                  END_OF_FILE_TOKEN, 1,
2115                 }->{$token->{type}}) {
2116          !!!parse-error (type => 'no DOCTYPE');
2117          $self->{document}->manakai_compat_mode ('quirks');
2118          ## Go to the root element phase
2119          ## reprocess
2120          return;
2121        } elsif ($token->{type} == CHARACTER_TOKEN) {
2122          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
2123            ## Ignore the token
2124    
2125            unless (length $token->{data}) {
2126              ## Stay in the phase
2127              !!!next-token;
2128              redo INITIAL;
2129            }
2130          }
2131    
2132          !!!parse-error (type => 'no DOCTYPE');
2133          $self->{document}->manakai_compat_mode ('quirks');
2134          ## Go to the root element phase
2135          ## reprocess
2136          return;
2137        } elsif ($token->{type} == COMMENT_TOKEN) {
2138          my $comment = $self->{document}->create_comment ($token->{data});
2139          $self->{document}->append_child ($comment);
2140          
2141          ## Stay in the phase.
2142          !!!next-token;
2143          redo INITIAL;
2144        } else {
2145          die "$0: $token->{type}: Unknown token type";
2146        }
2147      } # INITIAL
2148    } # _tree_construction_initial
2149    
2150    sub _tree_construction_root_element ($) {
2151      my $self = shift;
2152      
2153      B: {
2154          if ($token->{type} == DOCTYPE_TOKEN) {
2155            !!!parse-error (type => 'in html:#DOCTYPE');
2156            ## Ignore the token
2157            ## Stay in the phase
2158            !!!next-token;
2159            redo B;
2160          } elsif ($token->{type} == COMMENT_TOKEN) {
2161            my $comment = $self->{document}->create_comment ($token->{data});
2162            $self->{document}->append_child ($comment);
2163            ## Stay in the phase
2164            !!!next-token;
2165            redo B;
2166          } elsif ($token->{type} == CHARACTER_TOKEN) {
2167            if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
2168              ## Ignore the token.
2169    
2170              unless (length $token->{data}) {
2171                ## Stay in the phase
2172                !!!next-token;
2173                redo B;
2174              }
2175            }
2176    
2177            $self->{application_cache_selection}->(undef);
2178    
2179            #
2180          } elsif ($token->{type} == START_TAG_TOKEN) {
2181            if ($token->{tag_name} eq 'html' and
2182                $token->{attributes}->{manifest}) { ## ISSUE: Spec spells as "application"
2183              $self->{application_cache_selection}
2184                   ->($token->{attributes}->{manifest}->{value});
2185              ## ISSUE: No relative reference resolution?
2186            } else {
2187              $self->{application_cache_selection}->(undef);
2188            }
2189    
2190            ## ISSUE: There is an issue in the spec
2191            #
2192          } elsif ({
2193                    END_TAG_TOKEN, 1,
2194                    END_OF_FILE_TOKEN, 1,
2195                   }->{$token->{type}}) {
2196            $self->{application_cache_selection}->(undef);
2197    
2198            ## ISSUE: There is an issue in the spec
2199            #
2200          } else {
2201            die "$0: $token->{type}: Unknown token type";
2202          }
2203    
2204          my $root_element; !!!create-element ($root_element, 'html');
2205          $self->{document}->append_child ($root_element);
2206          push @{$self->{open_elements}}, [$root_element, 'html'];
2207          ## reprocess
2208          #redo B;
2209          return; ## Go to the main phase.
2210      } # B
2211    } # _tree_construction_root_element
2212    
2213    sub _reset_insertion_mode ($) {
2214      my $self = shift;
2215    
2216        ## Step 1
2217        my $last;
2218        
2219        ## Step 2
2220        my $i = -1;
2221        my $node = $self->{open_elements}->[$i];
2222        
2223        ## Step 3
2224        S3: {
2225          ## ISSUE: Oops! "If node is the first node in the stack of open
2226          ## elements, then set last to true. If the context element of the
2227          ## HTML fragment parsing algorithm is neither a td element nor a
2228          ## th element, then set node to the context element. (fragment case)":
2229          ## The second "if" is in the scope of the first "if"!?
2230          if ($self->{open_elements}->[0]->[0] eq $node->[0]) {
2231            $last = 1;
2232            if (defined $self->{inner_html_node}) {
2233              if ($self->{inner_html_node}->[1] eq 'td' or
2234                  $self->{inner_html_node}->[1] eq 'th') {
2235                #
2236              } else {
2237                $node = $self->{inner_html_node};
2238              }
2239            }
2240          }
2241        
2242          ## Step 4..13
2243          my $new_mode = {
2244                          select => IN_SELECT_IM,
2245                          td => IN_CELL_IM,
2246                          th => IN_CELL_IM,
2247                          tr => IN_ROW_IM,
2248                          tbody => IN_TABLE_BODY_IM,
2249                          thead => IN_TABLE_BODY_IM,
2250                          tfoot => IN_TABLE_BODY_IM,
2251                          caption => IN_CAPTION_IM,
2252                          colgroup => IN_COLUMN_GROUP_IM,
2253                          table => IN_TABLE_IM,
2254                          head => IN_BODY_IM, # not in head!
2255                          body => IN_BODY_IM,
2256                          frameset => IN_FRAMESET_IM,
2257                         }->{$node->[1]};
2258          $self->{insertion_mode} = $new_mode and return if defined $new_mode;
2259          
2260          ## Step 14
2261          if ($node->[1] eq 'html') {
2262            unless (defined $self->{head_element}) {
2263              $self->{insertion_mode} = BEFORE_HEAD_IM;
2264            } else {
2265              $self->{insertion_mode} = AFTER_HEAD_IM;
2266            }
2267            return;
2268          }
2269          
2270          ## Step 15
2271          $self->{insertion_mode} = IN_BODY_IM and return if $last;
2272          
2273          ## Step 16
2274          $i--;
2275          $node = $self->{open_elements}->[$i];
2276          
2277          ## Step 17
2278          redo S3;
2279        } # S3
2280    } # _reset_insertion_mode
2281    
2282    sub _tree_construction_main ($) {
2283      my $self = shift;
2284    
   my $open_elements = [];  
2285    my $active_formatting_elements = [];    my $active_formatting_elements = [];
   my $head_element;  
   my $form_element;  
   my $insertion_mode = 'before head';  
2286    
2287    my $reconstruct_active_formatting_elements = sub { # MUST    my $reconstruct_active_formatting_elements = sub { # MUST
2288      my $insert = shift;      my $insert = shift;
# Line 1621  sub _construct_tree ($) { Line 2296  sub _construct_tree ($) {
2296    
2297      ## Step 2      ## Step 2
2298      return if $entry->[0] eq '#marker';      return if $entry->[0] eq '#marker';
2299      for (@$open_elements) {      for (@{$self->{open_elements}}) {
2300        if ($entry->[0] eq $_->[0]) {        if ($entry->[0] eq $_->[0]) {
2301          return;          return;
2302        }        }
# Line 1640  sub _construct_tree ($) { Line 2315  sub _construct_tree ($) {
2315          #          #
2316        } else {        } else {
2317          my $in_open_elements;          my $in_open_elements;
2318          OE: for (@$open_elements) {          OE: for (@{$self->{open_elements}}) {
2319            if ($entry->[0] eq $_->[0]) {            if ($entry->[0] eq $_->[0]) {
2320              $in_open_elements = 1;              $in_open_elements = 1;
2321              last OE;              last OE;
# Line 1664  sub _construct_tree ($) { Line 2339  sub _construct_tree ($) {
2339            
2340        ## Step 9        ## Step 9
2341        $insert->($clone->[0]);        $insert->($clone->[0]);
2342        push @$open_elements, $clone;        push @{$self->{open_elements}}, $clone;
2343                
2344        ## Step 10        ## Step 10
2345        $active_formatting_elements->[$i] = $open_elements->[-1];        $active_formatting_elements->[$i] = $self->{open_elements}->[-1];
2346    
2347        ## Step 11        ## Step 11
2348        unless ($clone->[0] eq $active_formatting_elements->[-1]->[0]) {        unless ($clone->[0] eq $active_formatting_elements->[-1]->[0]) {
# Line 1689  sub _construct_tree ($) { Line 2364  sub _construct_tree ($) {