/[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.155 by wakaba, Sat Aug 30 12:57:05 2008 UTC revision 1.182 by wakaba, Mon Sep 15 07:19:03 2008 UTC
# Line 3  use strict; Line 3  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);  use Error qw(:try);
5    
6    ## NOTE: This module don't check all HTML5 parse errors; character
7    ## encoding related parse errors are expected to be handled by relevant
8    ## modules.
9    ## Parse errors for control characters that are not allowed in HTML5
10    ## documents, for surrogate code points, and for noncharacter code
11    ## points, as well as U+FFFD substitions for characters whose code points
12    ## is higher than U+10FFFF may be detected by combining the parser with
13    ## the checker implemented by Whatpm::Charset::UnicodeChecker (for its
14    ## usage example, see |t/HTML-tree.t| in the Whatpm package or the
15    ## WebHACC::Language::HTML module in the WebHACC package).
16    
17  ## ISSUE:  ## ISSUE:
18  ## var doc = implementation.createDocument (null, null, null);  ## var doc = implementation.createDocument (null, null, null);
19  ## doc.write ('');  ## doc.write ('');
# Line 354  sub parse_byte_string ($$$$;$) { Line 365  sub parse_byte_string ($$$$;$) {
365    return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);    return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);
366  } # parse_byte_string  } # parse_byte_string
367    
368  sub parse_byte_stream ($$$$;$) {  sub parse_byte_stream ($$$$;$$) {
369      # my ($self, $charset_name, $byte_stream, $doc, $onerror, $get_wrapper) = @_;
370    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
371    my $charset_name = shift;    my $charset_name = shift;
372    my $byte_stream = $_[0];    my $byte_stream = $_[0];
# Line 365  sub parse_byte_stream ($$$$;$) { Line 377  sub parse_byte_stream ($$$$;$) {
377    };    };
378    $self->{parse_error} = $onerror; # updated later by parse_char_string    $self->{parse_error} = $onerror; # updated later by parse_char_string
379    
380      my $get_wrapper = $_[3] || sub ($) {
381        return $_[0]; # $_[0] = byte stream handle, returned = arg to char handle
382      };
383    
384    ## HTML5 encoding sniffing algorithm    ## HTML5 encoding sniffing algorithm
385    require Message::Charset::Info;    require Message::Charset::Info;
386    my $charset;    my $charset;
# Line 372  sub parse_byte_stream ($$$$;$) { Line 388  sub parse_byte_stream ($$$$;$) {
388    my ($char_stream, $e_status);    my ($char_stream, $e_status);
389    
390    SNIFFING: {    SNIFFING: {
391        ## NOTE: By setting |allow_fallback| option true when the
392        ## |get_decode_handle| method is invoked, we ignore what the HTML5
393        ## spec requires, i.e. unsupported encoding should be ignored.
394          ## TODO: We should not do this unless the parser is invoked
395          ## in the conformance checking mode, in which this behavior
396          ## would be useful.
397    
398      ## Step 1      ## Step 1
399      if (defined $charset_name) {      if (defined $charset_name) {
400        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
401              ## TODO: Is this ok?  Transfer protocol's parameter should be
402              ## interpreted in its semantics?
403    
404        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
405        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
# Line 399  sub parse_byte_stream ($$$$;$) { Line 423  sub parse_byte_stream ($$$$;$) {
423    
424      ## Step 3      ## Step 3
425      if ($byte_buffer =~ /^\xFE\xFF/) {      if ($byte_buffer =~ /^\xFE\xFF/) {
426        $charset = Message::Charset::Info->get_by_iana_name ('utf-16be');        $charset = Message::Charset::Info->get_by_html_name ('utf-16be');
427        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
428            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
429             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
430        $self->{confident} = 1;        $self->{confident} = 1;
431        last SNIFFING;        last SNIFFING;
432      } elsif ($byte_buffer =~ /^\xFF\xFE/) {      } elsif ($byte_buffer =~ /^\xFF\xFE/) {
433        $charset = Message::Charset::Info->get_by_iana_name ('utf-16le');        $charset = Message::Charset::Info->get_by_html_name ('utf-16le');
434        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
435            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
436             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
437        $self->{confident} = 1;        $self->{confident} = 1;
438        last SNIFFING;        last SNIFFING;
439      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {
440        $charset = Message::Charset::Info->get_by_iana_name ('utf-8');        $charset = Message::Charset::Info->get_by_html_name ('utf-8');
441        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
442            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
443             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
# Line 432  sub parse_byte_stream ($$$$;$) { Line 456  sub parse_byte_stream ($$$$;$) {
456      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string
457          ($byte_buffer);          ($byte_buffer);
458      if (defined $charset_name) {      if (defined $charset_name) {
459        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
460    
461        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
462        require Whatpm::Charset::DecodeHandle;        require Whatpm::Charset::DecodeHandle;
# Line 455  sub parse_byte_stream ($$$$;$) { Line 479  sub parse_byte_stream ($$$$;$) {
479    
480      ## Step 7: default      ## Step 7: default
481      ## TODO: Make this configurable.      ## TODO: Make this configurable.
482      $charset = Message::Charset::Info->get_by_iana_name ('windows-1252');      $charset = Message::Charset::Info->get_by_html_name ('windows-1252');
483          ## NOTE: We choose |windows-1252| here, since |utf-8| should be          ## NOTE: We choose |windows-1252| here, since |utf-8| should be
484          ## detectable in the step 6.          ## detectable in the step 6.
485      require Whatpm::Charset::DecodeHandle;      require Whatpm::Charset::DecodeHandle;
# Line 475  sub parse_byte_stream ($$$$;$) { Line 499  sub parse_byte_stream ($$$$;$) {
499      $self->{confident} = 0;      $self->{confident} = 0;
500    } # SNIFFING    } # SNIFFING
501    
   $self->{input_encoding} = $charset->get_iana_name;  
502    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
503        $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
504      !!!parse-error (type => 'chardecode:fallback',      !!!parse-error (type => 'chardecode:fallback',
505                      text => $self->{input_encoding},                      #text => $self->{input_encoding},
506                      level => $self->{level}->{uncertain},                      level => $self->{level}->{uncertain},
507                      line => 1, column => 1,                      line => 1, column => 1,
508                      layer => 'encode');                      layer => 'encode');
509    } elsif (not ($e_status &    } elsif (not ($e_status &
510                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL ())) {
511        $self->{input_encoding} = $charset->get_iana_name;
512      !!!parse-error (type => 'chardecode:no error',      !!!parse-error (type => 'chardecode:no error',
513                      text => $self->{input_encoding},                      text => $self->{input_encoding},
514                      level => $self->{level}->{uncertain},                      level => $self->{level}->{uncertain},
515                      line => 1, column => 1,                      line => 1, column => 1,
516                      layer => 'encode');                      layer => 'encode');
517      } else {
518        $self->{input_encoding} = $charset->get_iana_name;
519    }    }
520    
521    $self->{change_encoding} = sub {    $self->{change_encoding} = sub {
# Line 496  sub parse_byte_stream ($$$$;$) { Line 523  sub parse_byte_stream ($$$$;$) {
523      $charset_name = shift;      $charset_name = shift;
524      my $token = shift;      my $token = shift;
525    
526      $charset = Message::Charset::Info->get_by_iana_name ($charset_name);      $charset = Message::Charset::Info->get_by_html_name ($charset_name);
527      ($char_stream, $e_status) = $charset->get_decode_handle      ($char_stream, $e_status) = $charset->get_decode_handle
528          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,
529           byte_buffer => \ $buffer->{buffer});           byte_buffer => \ $buffer->{buffer});
# Line 507  sub parse_byte_stream ($$$$;$) { Line 534  sub parse_byte_stream ($$$$;$) {
534        ## Step 1            ## Step 1    
535        if ($charset->{category} &        if ($charset->{category} &
536            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {
537          $charset = Message::Charset::Info->get_by_iana_name ('utf-8');          $charset = Message::Charset::Info->get_by_html_name ('utf-8');
538          ($char_stream, $e_status) = $charset->get_decode_handle          ($char_stream, $e_status) = $charset->get_decode_handle
539              ($byte_stream,              ($byte_stream,
540               byte_buffer => \ $buffer->{buffer});               byte_buffer => \ $buffer->{buffer});
# Line 545  sub parse_byte_stream ($$$$;$) { Line 572  sub parse_byte_stream ($$$$;$) {
572    my $char_onerror = sub {    my $char_onerror = sub {
573      my (undef, $type, %opt) = @_;      my (undef, $type, %opt) = @_;
574      !!!parse-error (layer => 'encode',      !!!parse-error (layer => 'encode',
575                      %opt, type => $type,                      line => $self->{line}, column => $self->{column} + 1,
576                      line => $self->{line}, column => $self->{column} + 1);                      %opt, type => $type);
577      if ($opt{octets}) {      if ($opt{octets}) {
578        ${$opt{octets}} = "\x{FFFD}"; # relacement character        ${$opt{octets}} = "\x{FFFD}"; # relacement character
579      }      }
580    };    };
   $char_stream->onerror ($char_onerror);  
581    
582    my @args = @_; shift @args; # $s    my $wrapped_char_stream = $get_wrapper->($char_stream);
583      $wrapped_char_stream->onerror ($char_onerror);
584    
585      my @args = ($_[1], $_[2]); # $doc, $onerror - $get_wrapper = undef;
586    my $return;    my $return;
587    try {    try {
588      $return = $self->parse_char_stream ($char_stream, @args);        $return = $self->parse_char_stream ($wrapped_char_stream, @args);  
589    } catch Whatpm::HTML::RestartParser with {    } catch Whatpm::HTML::RestartParser with {
590      ## NOTE: Invoked after {change_encoding}.      ## NOTE: Invoked after {change_encoding}.
591    
     $self->{input_encoding} = $charset->get_iana_name;  
592      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
593          $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
594        !!!parse-error (type => 'chardecode:fallback',        !!!parse-error (type => 'chardecode:fallback',
                       text => $self->{input_encoding},  
595                        level => $self->{level}->{uncertain},                        level => $self->{level}->{uncertain},
596                          #text => $self->{input_encoding},
597                        line => 1, column => 1,                        line => 1, column => 1,
598                        layer => 'encode');                        layer => 'encode');
599      } elsif (not ($e_status &      } elsif (not ($e_status &
600                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL ())) {
601          $self->{input_encoding} = $charset->get_iana_name;
602        !!!parse-error (type => 'chardecode:no error',        !!!parse-error (type => 'chardecode:no error',
603                        text => $self->{input_encoding},                        text => $self->{input_encoding},
604                        level => $self->{level}->{uncertain},                        level => $self->{level}->{uncertain},
605                        line => 1, column => 1,                        line => 1, column => 1,
606                        layer => 'encode');                        layer => 'encode');
607        } else {
608          $self->{input_encoding} = $charset->get_iana_name;
609      }      }
610      $self->{confident} = 1;      $self->{confident} = 1;
611      $char_stream->onerror ($char_onerror);  
612      $return = $self->parse_char_stream ($char_stream, @args);      $wrapped_char_stream = $get_wrapper->($char_stream);
613        $wrapped_char_stream->onerror ($char_onerror);
614    
615        $return = $self->parse_char_stream ($wrapped_char_stream, @args);
616    };    };
617    return $return;    return $return;
618  } # parse_byte_stream  } # parse_byte_stream
# Line 591  sub parse_byte_stream ($$$$;$) { Line 626  sub parse_byte_stream ($$$$;$) {
626  ## such as |parse_byte_string| in this module, must ensure that it does  ## such as |parse_byte_string| in this module, must ensure that it does
627  ## strip the BOM and never strip any ZWNBSP.  ## strip the BOM and never strip any ZWNBSP.
628    
629  sub parse_char_string ($$$;$) {  sub parse_char_string ($$$;$$) {
630      #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
631    my $self = shift;    my $self = shift;
   require utf8;  
632    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $s = ref $_[0] ? $_[0] : \($_[0]);
633    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;    require Whatpm::Charset::DecodeHandle;
634      my $input = Whatpm::Charset::DecodeHandle::CharString->new ($s);
635    return $self->parse_char_stream ($input, @_[1..$#_]);    return $self->parse_char_stream ($input, @_[1..$#_]);
636  } # parse_char_string  } # parse_char_string
637  *parse_string = \&parse_char_string;  *parse_string = \&parse_char_string; ## NOTE: Alias for backward compatibility.
638    
639  sub parse_char_stream ($$$;$) {  sub parse_char_stream ($$$;$$) {
640    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
641    my $input = $_[0];    my $input = $_[0];
642    $self->{document} = $_[1];    $self->{document} = $_[1];
# Line 611  sub parse_char_stream ($$$;$) { Line 647  sub parse_char_stream ($$$;$) {
647    $self->{confident} = 1 unless exists $self->{confident};    $self->{confident} = 1 unless exists $self->{confident};
648    $self->{document}->input_encoding ($self->{input_encoding})    $self->{document}->input_encoding ($self->{input_encoding})
649        if defined $self->{input_encoding};        if defined $self->{input_encoding};
650    ## TODO: |{input_encoding}| is needless?
651    
   my $i = 0;  
652    $self->{line_prev} = $self->{line} = 1;    $self->{line_prev} = $self->{line} = 1;
653    $self->{column_prev} = $self->{column} = 0;    $self->{column_prev} = -1;
654      $self->{column} = 0;
655    $self->{set_next_char} = sub {    $self->{set_next_char} = sub {
656      my $self = shift;      my $self = shift;
657    
658      pop @{$self->{prev_char}};      my $char = '';
     unshift @{$self->{prev_char}}, $self->{next_char};  
   
     my $char;  
659      if (defined $self->{next_next_char}) {      if (defined $self->{next_next_char}) {
660        $char = $self->{next_next_char};        $char = $self->{next_next_char};
661        delete $self->{next_next_char};        delete $self->{next_next_char};
662          $self->{next_char} = ord $char;
663      } else {      } else {
664        $char = $input->getc;        $self->{char_buffer} = '';
665          $self->{char_buffer_pos} = 0;
666    
667          my $count = $input->manakai_read_until
668             ($self->{char_buffer}, qr/[^\x00\x0A\x0D]/, $self->{char_buffer_pos});
669          if ($count) {
670            $self->{line_prev} = $self->{line};
671            $self->{column_prev} = $self->{column};
672            $self->{column}++;
673            $self->{next_char}
674                = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
675            return;
676          }
677    
678          if ($input->read ($char, 1)) {
679            $self->{next_char} = ord $char;
680          } else {
681            $self->{next_char} = -1;
682            return;
683          }
684      }      }
     $self->{next_char} = -1 and return unless defined $char;  
     $self->{next_char} = ord $char;  
685    
686      ($self->{line_prev}, $self->{column_prev})      ($self->{line_prev}, $self->{column_prev})
687          = ($self->{line}, $self->{column});          = ($self->{line}, $self->{column});
# Line 641  sub parse_char_stream ($$$;$) { Line 693  sub parse_char_stream ($$$;$) {
693        $self->{column} = 0;        $self->{column} = 0;
694      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
695        !!!cp ('j2');        !!!cp ('j2');
696        my $next = $input->getc;  ## TODO: support for abort/streaming
697        if (defined $next and $next ne "\x0A") {        my $next = '';
698          if ($input->read ($next, 1) and $next ne "\x0A") {
699          $self->{next_next_char} = $next;          $self->{next_next_char} = $next;
700        }        }
701        $self->{next_char} = 0x000A; # LF # MUST        $self->{next_char} = 0x000A; # LF # MUST
702        $self->{line}++;        $self->{line}++;
703        $self->{column} = 0;        $self->{column} = 0;
     } elsif ($self->{next_char} > 0x10FFFF) {  
       !!!cp ('j3');  
       $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST  
704      } elsif ($self->{next_char} == 0x0000) { # NULL      } elsif ($self->{next_char} == 0x0000) { # NULL
705        !!!cp ('j4');        !!!cp ('j4');
706        !!!parse-error (type => 'NULL');        !!!parse-error (type => 'NULL');
707        $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
708      } elsif ($self->{next_char} <= 0x0008 or      }
709               (0x000E <= $self->{next_char} and $self->{next_char} <= 0x001F) or    };
710               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or  
711               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or    $self->{read_until} = sub {
712               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or      #my ($scalar, $specials_range, $offset) = @_;
713               {      return 0 if defined $self->{next_next_char};
714                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,  
715                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,      my $pattern = qr/[^$_[1]\x00\x0A\x0D]/;
716                0x4FFFE => 1, 0x4FFFF => 1, 0x5FFFE => 1, 0x5FFFF => 1,      my $offset = $_[2] || 0;
717                0x6FFFE => 1, 0x6FFFF => 1, 0x7FFFE => 1, 0x7FFFF => 1,  
718                0x8FFFE => 1, 0x8FFFF => 1, 0x9FFFE => 1, 0x9FFFF => 1,      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
719                0xAFFFE => 1, 0xAFFFF => 1, 0xBFFFE => 1, 0xBFFFF => 1,        pos ($self->{char_buffer}) = $self->{char_buffer_pos};
720                0xCFFFE => 1, 0xCFFFF => 1, 0xDFFFE => 1, 0xDFFFF => 1,        if ($self->{char_buffer} =~ /\G(?>$pattern)+/) {
721                0xEFFFE => 1, 0xEFFFF => 1, 0xFFFFE => 1, 0xFFFFF => 1,          substr ($_[0], $offset)
722                0x10FFFE => 1, 0x10FFFF => 1,              = substr ($self->{char_buffer}, $-[0], $+[0] - $-[0]);
723               }->{$self->{next_char}}) {          my $count = $+[0] - $-[0];
724        !!!cp ('j5');          if ($count) {
725        if ($self->{next_char} < 0x10000) {            $self->{column} += $count;
726          !!!parse-error (type => 'control char',            $self->{char_buffer_pos} += $count;
727                          text => (sprintf 'U+%04X', $self->{next_char}));            $self->{line_prev} = $self->{line};
728              $self->{column_prev} = $self->{column} - 1;
729              $self->{prev_char} = [-1, -1, -1];
730              $self->{next_char} = -1;
731            }
732            return $count;
733        } else {        } else {
734          !!!parse-error (type => 'control char',          return 0;
735                          text => (sprintf 'U-%08X', $self->{next_char}));        }
736        } else {
737          my $count = $input->manakai_read_until ($_[0], $pattern, $_[2]);
738          if ($count) {
739            $self->{column} += $count;
740            $self->{line_prev} = $self->{line};
741            $self->{column_prev} = $self->{column} - 1;
742            $self->{prev_char} = [-1, -1, -1];
743            $self->{next_char} = -1;
744        }        }
745          return $count;
746      }      }
747    };    }; # $self->{read_until}
   $self->{prev_char} = [-1, -1, -1];  
   $self->{next_char} = -1;  
748    
749    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
750      my (%opt) = @_;      my (%opt) = @_;
# Line 694  sub parse_char_stream ($$$;$) { Line 756  sub parse_char_stream ($$$;$) {
756      $onerror->(line => $self->{line}, column => $self->{column}, @_);      $onerror->(line => $self->{line}, column => $self->{column}, @_);
757    };    };
758    
759      my $char_onerror = sub {
760        my (undef, $type, %opt) = @_;
761        !!!parse-error (layer => 'encode',
762                        line => $self->{line}, column => $self->{column} + 1,
763                        %opt, type => $type);
764      }; # $char_onerror
765    
766      if ($_[3]) {
767        $input = $_[3]->($input);
768        $input->onerror ($char_onerror);
769      } else {
770        $input->onerror ($char_onerror) unless defined $input->onerror;
771      }
772    
773    $self->_initialize_tokenizer;    $self->_initialize_tokenizer;
774    $self->_initialize_tree_constructor;    $self->_initialize_tree_constructor;
775    $self->_construct_tree;    $self->_construct_tree;
# Line 708  sub new ($) { Line 784  sub new ($) {
784    my $class = shift;    my $class = shift;
785    my $self = bless {    my $self = bless {
786      level => {must => 'm',      level => {must => 'm',
787                  should => 's',
788                warn => 'w',                warn => 'w',
789                info => 'i',                info => 'i',
790                uncertain => 'u'},                uncertain => 'u'},
# Line 740  sub RCDATA_CONTENT_MODEL () { CM_ENTITY Line 817  sub RCDATA_CONTENT_MODEL () { CM_ENTITY
817  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
818    
819  sub DATA_STATE () { 0 }  sub DATA_STATE () { 0 }
820  sub ENTITY_DATA_STATE () { 1 }  #sub ENTITY_DATA_STATE () { 1 }
821  sub TAG_OPEN_STATE () { 2 }  sub TAG_OPEN_STATE () { 2 }
822  sub CLOSE_TAG_OPEN_STATE () { 3 }  sub CLOSE_TAG_OPEN_STATE () { 3 }
823  sub TAG_NAME_STATE () { 4 }  sub TAG_NAME_STATE () { 4 }
# Line 751  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 Line 828  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8
828  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
829  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
830  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
831  sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }  #sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
832  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
833  sub COMMENT_START_STATE () { 14 }  sub COMMENT_START_STATE () { 14 }
834  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
# Line 774  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT Line 851  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT
851  sub BOGUS_DOCTYPE_STATE () { 32 }  sub BOGUS_DOCTYPE_STATE () { 32 }
852  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }
853  sub SELF_CLOSING_START_TAG_STATE () { 34 }  sub SELF_CLOSING_START_TAG_STATE () { 34 }
854  sub CDATA_BLOCK_STATE () { 35 }  sub CDATA_SECTION_STATE () { 35 }
855    sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec
856    sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec
857    sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec
858    sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec
859    sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec
860    sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
861    sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec
862    sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec
863    ## NOTE: "Entity data state", "entity in attribute value state", and
864    ## "consume a character reference" algorithm are jointly implemented
865    ## using the following six states:
866    sub ENTITY_STATE () { 44 }
867    sub ENTITY_HASH_STATE () { 45 }
868    sub NCR_NUM_STATE () { 46 }
869    sub HEXREF_X_STATE () { 47 }
870    sub HEXREF_HEX_STATE () { 48 }
871    sub ENTITY_NAME_STATE () { 49 }
872    
873  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
874  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 827  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 921  sub IN_COLUMN_GROUP_IM () { 0b10 }
921  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
922    my $self = shift;    my $self = shift;
923    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
924      #$self->{state_keyword}; # initialized when used
925      #$self->{entity__value}; # initialized when used
926      #$self->{entity__match}; # initialized when used
927    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
928    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
929    undef $self->{current_attribute};    undef $self->{current_attribute};
930    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
931    undef $self->{last_attribute_value_state};    #$self->{prev_state}; # initialized when used
932    delete $self->{self_closing};    delete $self->{self_closing};
933    $self->{char} = [];    $self->{char_buffer} = '';
934    # $self->{next_char}    $self->{char_buffer_pos} = 0;
935      $self->{prev_char} = [-1, -1, -1];
936      $self->{next_char} = -1;
937    !!!next-input-character;    !!!next-input-character;
938    $self->{token} = [];    $self->{token} = [];
939    # $self->{escape}    # $self->{escape}
# Line 865  sub _initialize_tokenizer ($) { Line 964  sub _initialize_tokenizer ($) {
964  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
965  ## and removed from the list.  ## and removed from the list.
966    
967  ## NOTE: HTML5 "Writing HTML documents" section, applied to  ## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.)
968  ## documents and not to user agents and conformance checkers,  ## (This requirement was dropped from HTML5 spec, unfortunately.)
 ## contains some requirements that are not detected by the  
 ## parsing algorithm:  
 ## - Some requirements on character encoding declarations. ## TODO  
 ## - "Elements MUST NOT contain content that their content model disallows."  
 ##   ... Some are parse error, some are not (will be reported by c.c.).  
 ## - Polytheistic slash SHOULD NOT be used. (Applied only to atheists.) ## TODO  
 ## - Text (in elements, attributes, and comments) SHOULD NOT contain  
 ##   control characters other than space characters. ## TODO: (what is control character? C0, C1 and DEL?  Unicode control character?)  
   
 ## TODO: HTML5 poses authors two SHOULD-level requirements that cannot  
 ## be detected by the HTML5 parsing algorithm:  
 ## - Text,  
969    
970  sub _get_next_token ($) {  sub _get_next_token ($) {
971    my $self = shift;    my $self = shift;
# Line 902  sub _get_next_token ($) { Line 989  sub _get_next_token ($) {
989          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA
990              not $self->{escape}) {              not $self->{escape}) {
991            !!!cp (1);            !!!cp (1);
992            $self->{state} = ENTITY_DATA_STATE;            ## NOTE: In the spec, the tokenizer is switched to the
993              ## "entity data state".  In this implementation, the tokenizer
994              ## is switched to the |ENTITY_STATE|, which is an implementation
995              ## of the "consume a character reference" algorithm.
996              $self->{entity_additional} = -1;
997              $self->{prev_state} = DATA_STATE;
998              $self->{state} = ENTITY_STATE;
999            !!!next-input-character;            !!!next-input-character;
1000            redo A;            redo A;
1001          } else {          } else {
# Line 966  sub _get_next_token ($) { Line 1059  sub _get_next_token ($) {
1059                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1060                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1061                    };                    };
1062          $self->{read_until}->($token->{data}, q[-!<>&], length $token->{data});
1063    
1064        ## Stay in the data state        ## Stay in the data state
1065        !!!next-input-character;        !!!next-input-character;
1066    
1067        !!!emit ($token);        !!!emit ($token);
1068    
1069        redo A;        redo A;
     } elsif ($self->{state} == ENTITY_DATA_STATE) {  
       ## (cannot happen in CDATA state)  
   
       my ($l, $c) = ($self->{line_prev}, $self->{column_prev});  
         
       my $token = $self->_tokenize_attempt_to_consume_an_entity (0, -1);  
   
       $self->{state} = DATA_STATE;  
       # next-input-character is already done  
   
       unless (defined $token) {  
         !!!cp (13);  
         !!!emit ({type => CHARACTER_TOKEN, data => '&',  
                   line => $l, column => $c,  
                  });  
       } else {  
         !!!cp (14);  
         !!!emit ($token);  
       }  
   
       redo A;  
1070      } elsif ($self->{state} == TAG_OPEN_STATE) {      } elsif ($self->{state} == TAG_OPEN_STATE) {
1071        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1072          if ($self->{next_char} == 0x002F) { # /          if ($self->{next_char} == 0x002F) { # /
# Line 1089  sub _get_next_token ($) { Line 1163  sub _get_next_token ($) {
1163          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1164        }        }
1165      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1166          ## NOTE: The "close tag open state" in the spec is implemented as
1167          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1168    
1169        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1170        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1171          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1172              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1173            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1174            my @next_char;            ## Reconsume.
1175            TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {            redo A;
             push @next_char, $self->{next_char};  
             my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);  
             my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;  
             if ($self->{next_char} == $c or $self->{next_char} == $C) {  
               !!!cp (24);  
               !!!next-input-character;  
               next TAGNAME;  
             } else {  
               !!!cp (25);  
               $self->{next_char} = shift @next_char; # reconsume  
               !!!back-next-input-character (@next_char);  
               $self->{state} = DATA_STATE;  
   
               !!!emit ({type => CHARACTER_TOKEN, data => '</',  
                         line => $l, column => $c,  
                        });  
     
               redo A;  
             }  
           }  
           push @next_char, $self->{next_char};  
         
           unless ($self->{next_char} == 0x0009 or # HT  
                   $self->{next_char} == 0x000A or # LF  
                   $self->{next_char} == 0x000B or # VT  
                   $self->{next_char} == 0x000C or # FF  
                   $self->{next_char} == 0x0020 or # SP  
                   $self->{next_char} == 0x003E or # >  
                   $self->{next_char} == 0x002F or # /  
                   $self->{next_char} == -1) {  
             !!!cp (26);  
             $self->{next_char} = shift @next_char; # reconsume  
             !!!back-next-input-character (@next_char);  
             $self->{state} = DATA_STATE;  
             !!!emit ({type => CHARACTER_TOKEN, data => '</',  
                       line => $l, column => $c,  
                      });  
             redo A;  
           } else {  
             !!!cp (27);  
             $self->{next_char} = shift @next_char;  
             !!!back-next-input-character (@next_char);  
             # and consume...  
           }  
1176          } else {          } else {
1177            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1178              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1179            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1180            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1181              ## Reconsume.
1182            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1183                      line => $l, column => $c,                      line => $l, column => $c,
1184                     });                     });
1185            redo A;            redo A;
1186          }          }
1187        }        }
1188          
1189        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1190            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1191          !!!cp (29);          !!!cp (29);
# Line 1198  sub _get_next_token ($) { Line 1232  sub _get_next_token ($) {
1232                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1233                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1234                                   };                                   };
1235          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1236          redo A;          ## Although the "anything else" case of the spec not explicitly
1237            ## states that the next input character is to be reconsumed,
1238            ## it will be included to the |data| of the comment token
1239            ## generated from the bogus end tag, as defined in the
1240            ## "bogus comment state" entry.
1241            redo A;
1242          }
1243        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1244          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1245          if (length $ch) {
1246            my $CH = $ch;
1247            $ch =~ tr/a-z/A-Z/;
1248            my $nch = chr $self->{next_char};
1249            if ($nch eq $ch or $nch eq $CH) {
1250              !!!cp (24);
1251              ## Stay in the state.
1252              $self->{state_keyword} .= $nch;
1253              !!!next-input-character;
1254              redo A;
1255            } else {
1256              !!!cp (25);
1257              $self->{state} = DATA_STATE;
1258              ## Reconsume.
1259              !!!emit ({type => CHARACTER_TOKEN,
1260                        data => '</' . $self->{state_keyword},
1261                        line => $self->{line_prev},
1262                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1263                       });
1264              redo A;
1265            }
1266          } else { # after "<{tag-name}"
1267            unless ({
1268                     0x0009 => 1, # HT
1269                     0x000A => 1, # LF
1270                     0x000B => 1, # VT
1271                     0x000C => 1, # FF
1272                     0x0020 => 1, # SP
1273                     0x003E => 1, # >
1274                     0x002F => 1, # /
1275                     -1 => 1, # EOF
1276                    }->{$self->{next_char}}) {
1277              !!!cp (26);
1278              ## Reconsume.
1279              $self->{state} = DATA_STATE;
1280              !!!emit ({type => CHARACTER_TOKEN,
1281                        data => '</' . $self->{state_keyword},
1282                        line => $self->{line_prev},
1283                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1284                       });
1285              redo A;
1286            } else {
1287              !!!cp (27);
1288              $self->{current_token}
1289                  = {type => END_TAG_TOKEN,
1290                     tag_name => $self->{last_emitted_start_tag_name},
1291                     line => $self->{line_prev},
1292                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1293              $self->{state} = TAG_NAME_STATE;
1294              ## Reconsume.
1295              redo A;
1296            }
1297        }        }
1298      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1299        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1540  sub _get_next_token ($) { Line 1634  sub _get_next_token ($) {
1634    
1635          redo A;          redo A;
1636        } else {        } else {
1637          !!!cp (82);          if ($self->{next_char} == 0x0022 or # "
1638                $self->{next_char} == 0x0027) { # '
1639              !!!cp (78);
1640              !!!parse-error (type => 'bad attribute name');
1641            } else {
1642              !!!cp (82);
1643            }
1644          $self->{current_attribute}          $self->{current_attribute}
1645              = {name => chr ($self->{next_char}),              = {name => chr ($self->{next_char}),
1646                 value => '',                 value => '',
# Line 1575  sub _get_next_token ($) { Line 1675  sub _get_next_token ($) {
1675          !!!next-input-character;          !!!next-input-character;
1676          redo A;          redo A;
1677        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
1678            !!!parse-error (type => 'empty unquoted attribute value');
1679          if ($self->{current_token}->{type} == START_TAG_TOKEN) {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1680            !!!cp (87);            !!!cp (87);
1681            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 1639  sub _get_next_token ($) { Line 1740  sub _get_next_token ($) {
1740          redo A;          redo A;
1741        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1742          !!!cp (96);          !!!cp (96);
1743          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1744          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1745            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1746            ## implementation of the "consume a character reference" algorithm.
1747            $self->{prev_state} = $self->{state};
1748            $self->{entity_additional} = 0x0022; # "
1749            $self->{state} = ENTITY_STATE;
1750          !!!next-input-character;          !!!next-input-character;
1751          redo A;          redo A;
1752        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1669  sub _get_next_token ($) { Line 1775  sub _get_next_token ($) {
1775        } else {        } else {
1776          !!!cp (100);          !!!cp (100);
1777          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1778            $self->{read_until}->($self->{current_attribute}->{value},
1779                                  q["&],
1780                                  length $self->{current_attribute}->{value});
1781    
1782          ## Stay in the state          ## Stay in the state
1783          !!!next-input-character;          !!!next-input-character;
1784          redo A;          redo A;
# Line 1681  sub _get_next_token ($) { Line 1791  sub _get_next_token ($) {
1791          redo A;          redo A;
1792        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1793          !!!cp (102);          !!!cp (102);
1794          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1795          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1796            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1797            ## implementation of the "consume a character reference" algorithm.
1798            $self->{entity_additional} = 0x0027; # '
1799            $self->{prev_state} = $self->{state};
1800            $self->{state} = ENTITY_STATE;
1801          !!!next-input-character;          !!!next-input-character;
1802          redo A;          redo A;
1803        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1711  sub _get_next_token ($) { Line 1826  sub _get_next_token ($) {
1826        } else {        } else {
1827          !!!cp (106);          !!!cp (106);
1828          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1829            $self->{read_until}->($self->{current_attribute}->{value},
1830                                  q['&],
1831                                  length $self->{current_attribute}->{value});
1832    
1833          ## Stay in the state          ## Stay in the state
1834          !!!next-input-character;          !!!next-input-character;
1835          redo A;          redo A;
# Line 1727  sub _get_next_token ($) { Line 1846  sub _get_next_token ($) {
1846          redo A;          redo A;
1847        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1848          !!!cp (108);          !!!cp (108);
1849          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1850          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1851            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1852            ## implementation of the "consume a character reference" algorithm.
1853            $self->{entity_additional} = -1;
1854            $self->{prev_state} = $self->{state};
1855            $self->{state} = ENTITY_STATE;
1856          !!!next-input-character;          !!!next-input-character;
1857          redo A;          redo A;
1858        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
# Line 1788  sub _get_next_token ($) { Line 1912  sub _get_next_token ($) {
1912            !!!cp (116);            !!!cp (116);
1913          }          }
1914          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1915            $self->{read_until}->($self->{current_attribute}->{value},
1916                                  q["'=& >],
1917                                  length $self->{current_attribute}->{value});
1918    
1919          ## Stay in the state          ## Stay in the state
1920          !!!next-input-character;          !!!next-input-character;
1921          redo A;          redo A;
1922        }        }
     } elsif ($self->{state} == ENTITY_IN_ATTRIBUTE_VALUE_STATE) {  
       my $token = $self->_tokenize_attempt_to_consume_an_entity  
           (1,  
            $self->{last_attribute_value_state}  
              == ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE ? 0x0022 : # "  
            $self->{last_attribute_value_state}  
              == ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE ? 0x0027 : # '  
            -1);  
   
       unless (defined $token) {  
         !!!cp (117);  
         $self->{current_attribute}->{value} .= '&';  
       } else {  
         !!!cp (118);  
         $self->{current_attribute}->{value} .= $token->{data};  
         $self->{current_attribute}->{has_reference} = $token->{has_reference};  
         ## ISSUE: spec says "append the returned character token to the current attribute's value"  
       }  
   
       $self->{state} = $self->{last_attribute_value_state};  
       # next-input-character is already done  
       redo A;  
1923      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {
1924        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
1925            $self->{next_char} == 0x000A or # LF            $self->{next_char} == 0x000A or # LF
# Line 1933  sub _get_next_token ($) { Line 2039  sub _get_next_token ($) {
2039        }        }
2040      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
2041        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
         
       ## NOTE: Set by the previous state  
       #my $token = {type => COMMENT_TOKEN, data => ''};  
   
       BC: {  
         if ($self->{next_char} == 0x003E) { # >  
           !!!cp (124);  
           $self->{state} = DATA_STATE;  
           !!!next-input-character;  
2042    
2043            !!!emit ($self->{current_token}); # comment        ## NOTE: Unlike spec's "bogus comment state", this implementation
2044          ## consumes characters one-by-one basis.
2045            redo A;        
2046          } elsif ($self->{next_char} == -1) {        if ($self->{next_char} == 0x003E) { # >
2047            !!!cp (125);          !!!cp (124);
2048            $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2049            ## reconsume          !!!next-input-character;
2050    
2051            !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
2052            redo A;
2053          } elsif ($self->{next_char} == -1) {
2054            !!!cp (125);
2055            $self->{state} = DATA_STATE;
2056            ## reconsume
2057    
2058            redo A;          !!!emit ($self->{current_token}); # comment
2059          } else {          redo A;
2060            !!!cp (126);        } else {
2061            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          !!!cp (126);
2062            !!!next-input-character;          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2063            redo BC;          $self->{read_until}->($self->{current_token}->{data},
2064          }                                q[>],
2065        } # BC                                length $self->{current_token}->{data});
2066    
2067        die "$0: _get_next_token: unexpected case [BC]";          ## Stay in the state.
2068            !!!next-input-character;
2069            redo A;
2070          }
2071      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2072        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
   
       my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1);  
   
       my @next_char;  
       push @next_char, $self->{next_char};  
2073                
2074        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2075            !!!cp (133);
2076            $self->{state} = MD_HYPHEN_STATE;
2077          !!!next-input-character;          !!!next-input-character;
2078          push @next_char, $self->{next_char};          redo A;
         if ($self->{next_char} == 0x002D) { # -  
           !!!cp (127);  
           $self->{current_token} = {type => COMMENT_TOKEN, data => '',  
                                     line => $l, column => $c,  
                                    };  
           $self->{state} = COMMENT_START_STATE;  
           !!!next-input-character;  
           redo A;  
         } else {  
           !!!cp (128);  
         }  
2079        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2080                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2081            ## ASCII case-insensitive.
2082            !!!cp (130);
2083            $self->{state} = MD_DOCTYPE_STATE;
2084            $self->{state_keyword} = chr $self->{next_char};
2085          !!!next-input-character;          !!!next-input-character;
2086          push @next_char, $self->{next_char};          redo A;
         if ($self->{next_char} == 0x004F or # O  
             $self->{next_char} == 0x006F) { # o  
           !!!next-input-character;  
           push @next_char, $self->{next_char};  
           if ($self->{next_char} == 0x0043 or # C  
               $self->{next_char} == 0x0063) { # c  
             !!!next-input-character;  
             push @next_char, $self->{next_char};  
             if ($self->{next_char} == 0x0054 or # T  
                 $self->{next_char} == 0x0074) { # t  
               !!!next-input-character;  
               push @next_char, $self->{next_char};  
               if ($self->{next_char} == 0x0059 or # Y  
                   $self->{next_char} == 0x0079) { # y  
                 !!!next-input-character;  
                 push @next_char, $self->{next_char};  
                 if ($self->{next_char} == 0x0050 or # P  
                     $self->{next_char} == 0x0070) { # p  
                   !!!next-input-character;  
                   push @next_char, $self->{next_char};  
                   if ($self->{next_char} == 0x0045 or # E  
                       $self->{next_char} == 0x0065) { # e  
                     !!!cp (129);  
                     ## TODO: What a stupid code this is!  
                     $self->{state} = DOCTYPE_STATE;  
                     $self->{current_token} = {type => DOCTYPE_TOKEN,  
                                               quirks => 1,  
                                               line => $l, column => $c,  
                                              };  
                     !!!next-input-character;  
                     redo A;  
                   } else {  
                     !!!cp (130);  
                   }  
                 } else {  
                   !!!cp (131);  
                 }  
               } else {  
                 !!!cp (132);  
               }  
             } else {  
               !!!cp (133);  
             }  
           } else {  
             !!!cp (134);  
           }  
         } else {  
           !!!cp (135);  
         }  
2087        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2088                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2089                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2090            !!!cp (135.4);                
2091            $self->{state} = MD_CDATA_STATE;
2092            $self->{state_keyword} = '[';
2093          !!!next-input-character;          !!!next-input-character;
2094          push @next_char, $self->{next_char};          redo A;
         if ($self->{next_char} == 0x0043) { # C  
           !!!next-input-character;  
           push @next_char, $self->{next_char};  
           if ($self->{next_char} == 0x0044) { # D  
             !!!next-input-character;  
             push @next_char, $self->{next_char};  
             if ($self->{next_char} == 0x0041) { # A  
               !!!next-input-character;  
               push @next_char, $self->{next_char};  
               if ($self->{next_char} == 0x0054) { # T  
                 !!!next-input-character;  
                 push @next_char, $self->{next_char};  
                 if ($self->{next_char} == 0x0041) { # A  
                   !!!next-input-character;  
                   push @next_char, $self->{next_char};  
                   if ($self->{next_char} == 0x005B) { # [  
                     !!!cp (135.1);  
                     $self->{state} = CDATA_BLOCK_STATE;  
                     !!!next-input-character;  
                     redo A;  
                   } else {  
                     !!!cp (135.2);  
                   }  
                 } else {  
                   !!!cp (135.3);  
                 }  
               } else {  
                 !!!cp (135.4);                  
               }  
             } else {  
               !!!cp (135.5);  
             }  
           } else {  
             !!!cp (135.6);  
           }  
         } else {  
           !!!cp (135.7);  
         }  
2095        } else {        } else {
2096          !!!cp (136);          !!!cp (136);
2097        }        }
2098    
2099        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2100        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2101        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2102          ## Reconsume.
2103        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2104        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2105                                  line => $l, column => $c,                                  line => $self->{line_prev},
2106                                    column => $self->{column_prev} - 1,
2107                                 };                                 };
2108        redo A;        redo A;
2109              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2110        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2111        ## 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?          !!!cp (127);
2112            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2113                                      line => $self->{line_prev},
2114                                      column => $self->{column_prev} - 2,
2115                                     };
2116            $self->{state} = COMMENT_START_STATE;
2117            !!!next-input-character;
2118            redo A;
2119          } else {
2120            !!!cp (128);
2121            !!!parse-error (type => 'bogus comment',
2122                            line => $self->{line_prev},
2123                            column => $self->{column_prev} - 2);
2124            $self->{state} = BOGUS_COMMENT_STATE;
2125            ## Reconsume.
2126            $self->{current_token} = {type => COMMENT_TOKEN,
2127                                      data => '-',
2128                                      line => $self->{line_prev},
2129                                      column => $self->{column_prev} - 2,
2130                                     };
2131            redo A;
2132          }
2133        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2134          ## ASCII case-insensitive.
2135          if ($self->{next_char} == [
2136                undef,
2137                0x004F, # O
2138                0x0043, # C
2139                0x0054, # T
2140                0x0059, # Y
2141                0x0050, # P
2142              ]->[length $self->{state_keyword}] or
2143              $self->{next_char} == [
2144                undef,
2145                0x006F, # o
2146                0x0063, # c
2147                0x0074, # t
2148                0x0079, # y
2149                0x0070, # p
2150              ]->[length $self->{state_keyword}]) {
2151            !!!cp (131);
2152            ## Stay in the state.
2153            $self->{state_keyword} .= chr $self->{next_char};
2154            !!!next-input-character;
2155            redo A;
2156          } elsif ((length $self->{state_keyword}) == 6 and
2157                   ($self->{next_char} == 0x0045 or # E
2158                    $self->{next_char} == 0x0065)) { # e
2159            !!!cp (129);
2160            $self->{state} = DOCTYPE_STATE;
2161            $self->{current_token} = {type => DOCTYPE_TOKEN,
2162                                      quirks => 1,
2163                                      line => $self->{line_prev},
2164                                      column => $self->{column_prev} - 7,
2165                                     };
2166            !!!next-input-character;
2167            redo A;
2168          } else {
2169            !!!cp (132);        
2170            !!!parse-error (type => 'bogus comment',
2171                            line => $self->{line_prev},
2172                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2173            $self->{state} = BOGUS_COMMENT_STATE;
2174            ## Reconsume.
2175            $self->{current_token} = {type => COMMENT_TOKEN,
2176                                      data => $self->{state_keyword},
2177                                      line => $self->{line_prev},
2178                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2179                                     };
2180            redo A;
2181          }
2182        } elsif ($self->{state} == MD_CDATA_STATE) {
2183          if ($self->{next_char} == {
2184                '[' => 0x0043, # C
2185                '[C' => 0x0044, # D
2186                '[CD' => 0x0041, # A
2187                '[CDA' => 0x0054, # T
2188                '[CDAT' => 0x0041, # A
2189              }->{$self->{state_keyword}}) {
2190            !!!cp (135.1);
2191            ## Stay in the state.
2192            $self->{state_keyword} .= chr $self->{next_char};
2193            !!!next-input-character;
2194            redo A;
2195          } elsif ($self->{state_keyword} eq '[CDATA' and
2196                   $self->{next_char} == 0x005B) { # [
2197            !!!cp (135.2);
2198            $self->{current_token} = {type => CHARACTER_TOKEN,
2199                                      data => '',
2200                                      line => $self->{line_prev},
2201                                      column => $self->{column_prev} - 7};
2202            $self->{state} = CDATA_SECTION_STATE;
2203            !!!next-input-character;
2204            redo A;
2205          } else {
2206            !!!cp (135.3);
2207            !!!parse-error (type => 'bogus comment',
2208                            line => $self->{line_prev},
2209                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2210            $self->{state} = BOGUS_COMMENT_STATE;
2211            ## Reconsume.
2212            $self->{current_token} = {type => COMMENT_TOKEN,
2213                                      data => $self->{state_keyword},
2214                                      line => $self->{line_prev},
2215                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2216                                     };
2217            redo A;
2218          }
2219      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2220        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2221          !!!cp (137);          !!!cp (137);
# Line 2178  sub _get_next_token ($) { Line 2298  sub _get_next_token ($) {
2298        } else {        } else {
2299          !!!cp (147);          !!!cp (147);
2300          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2301            $self->{read_until}->($self->{current_token}->{data},
2302                                  q[-],
2303                                  length $self->{current_token}->{data});
2304    
2305          ## Stay in the state          ## Stay in the state
2306          !!!next-input-character;          !!!next-input-character;
2307          redo A;          redo A;
# Line 2362  sub _get_next_token ($) { Line 2486  sub _get_next_token ($) {
2486          redo A;          redo A;
2487        } elsif ($self->{next_char} == 0x0050 or # P        } elsif ($self->{next_char} == 0x0050 or # P
2488                 $self->{next_char} == 0x0070) { # p                 $self->{next_char} == 0x0070) { # p
2489            $self->{state} = PUBLIC_STATE;
2490            $self->{state_keyword} = chr $self->{next_char};
2491          !!!next-input-character;          !!!next-input-character;
2492          if ($self->{next_char} == 0x0055 or # U          redo A;
             $self->{next_char} == 0x0075) { # u  
           !!!next-input-character;  
           if ($self->{next_char} == 0x0042 or # B  
               $self->{next_char} == 0x0062) { # b  
             !!!next-input-character;  
             if ($self->{next_char} == 0x004C or # L  
                 $self->{next_char} == 0x006C) { # l  
               !!!next-input-character;  
               if ($self->{next_char} == 0x0049 or # I  
                   $self->{next_char} == 0x0069) { # i  
                 !!!next-input-character;  
                 if ($self->{next_char} == 0x0043 or # C  
                     $self->{next_char} == 0x0063) { # c  
                   !!!cp (168);  
                   $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;  
                   !!!next-input-character;  
                   redo A;  
                 } else {  
                   !!!cp (169);  
                 }  
               } else {  
                 !!!cp (170);  
               }  
             } else {  
               !!!cp (171);  
             }  
           } else {  
             !!!cp (172);  
           }  
         } else {  
           !!!cp (173);  
         }  
   
         #  
2493        } elsif ($self->{next_char} == 0x0053 or # S        } elsif ($self->{next_char} == 0x0053 or # S
2494                 $self->{next_char} == 0x0073) { # s                 $self->{next_char} == 0x0073) { # s
2495            $self->{state} = SYSTEM_STATE;
2496            $self->{state_keyword} = chr $self->{next_char};
2497          !!!next-input-character;          !!!next-input-character;
2498          if ($self->{next_char} == 0x0059 or # Y          redo A;
             $self->{next_char} == 0x0079) { # y  
           !!!next-input-character;  
           if ($self->{next_char} == 0x0053 or # S  
               $self->{next_char} == 0x0073) { # s  
             !!!next-input-character;  
             if ($self->{next_char} == 0x0054 or # T  
                 $self->{next_char} == 0x0074) { # t  
               !!!next-input-character;  
               if ($self->{next_char} == 0x0045 or # E  
                   $self->{next_char} == 0x0065) { # e  
                 !!!next-input-character;  
                 if ($self->{next_char} == 0x004D or # M  
                     $self->{next_char} == 0x006D) { # m  
                   !!!cp (174);  
                   $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;  
                   !!!next-input-character;  
                   redo A;  
                 } else {  
                   !!!cp (175);  
                 }  
               } else {  
                 !!!cp (176);  
               }  
             } else {  
               !!!cp (177);  
             }  
           } else {  
             !!!cp (178);  
           }  
         } else {  
           !!!cp (179);  
         }  
   
         #  
2499        } else {        } else {
2500          !!!cp (180);          !!!cp (180);
2501            !!!parse-error (type => 'string after DOCTYPE name');
2502            $self->{current_token}->{quirks} = 1;
2503    
2504            $self->{state} = BOGUS_DOCTYPE_STATE;
2505          !!!next-input-character;          !!!next-input-character;
2506          #          redo A;
2507        }        }
2508        } elsif ($self->{state} == PUBLIC_STATE) {
2509          ## ASCII case-insensitive
2510          if ($self->{next_char} == [
2511                undef,
2512                0x0055, # U
2513                0x0042, # B
2514                0x004C, # L
2515                0x0049, # I
2516              ]->[length $self->{state_keyword}] or
2517              $self->{next_char} == [
2518                undef,
2519                0x0075, # u
2520                0x0062, # b
2521                0x006C, # l
2522                0x0069, # i
2523              ]->[length $self->{state_keyword}]) {
2524            !!!cp (175);
2525            ## Stay in the state.
2526            $self->{state_keyword} .= chr $self->{next_char};
2527            !!!next-input-character;
2528            redo A;
2529          } elsif ((length $self->{state_keyword}) == 5 and
2530                   ($self->{next_char} == 0x0043 or # C
2531                    $self->{next_char} == 0x0063)) { # c
2532            !!!cp (168);
2533            $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
2534            !!!next-input-character;
2535            redo A;
2536          } else {
2537            !!!cp (169);
2538            !!!parse-error (type => 'string after DOCTYPE name',
2539                            line => $self->{line_prev},
2540                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2541            $self->{current_token}->{quirks} = 1;
2542    
2543        !!!parse-error (type => 'string after DOCTYPE name');          $self->{state} = BOGUS_DOCTYPE_STATE;
2544        $self->{current_token}->{quirks} = 1;          ## Reconsume.
2545            redo A;
2546          }
2547        } elsif ($self->{state} == SYSTEM_STATE) {
2548          ## ASCII case-insensitive
2549          if ($self->{next_char} == [
2550                undef,
2551                0x0059, # Y
2552                0x0053, # S
2553                0x0054, # T
2554                0x0045, # E
2555              ]->[length $self->{state_keyword}] or
2556              $self->{next_char} == [
2557                undef,
2558                0x0079, # y
2559                0x0073, # s
2560                0x0074, # t
2561                0x0065, # e
2562              ]->[length $self->{state_keyword}]) {
2563            !!!cp (170);
2564            ## Stay in the state.
2565            $self->{state_keyword} .= chr $self->{next_char};
2566            !!!next-input-character;
2567            redo A;
2568          } elsif ((length $self->{state_keyword}) == 5 and
2569                   ($self->{next_char} == 0x004D or # M
2570                    $self->{next_char} == 0x006D)) { # m
2571            !!!cp (171);
2572            $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
2573            !!!next-input-character;
2574            redo A;
2575          } else {
2576            !!!cp (172);
2577            !!!parse-error (type => 'string after DOCTYPE name',
2578                            line => $self->{line_prev},
2579                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2580            $self->{current_token}->{quirks} = 1;
2581    
2582        $self->{state} = BOGUS_DOCTYPE_STATE;          $self->{state} = BOGUS_DOCTYPE_STATE;
2583        # next-input-character is already done          ## Reconsume.
2584        redo A;          redo A;
2585          }
2586      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
2587        if ({        if ({
2588              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
# Line 2532  sub _get_next_token ($) { Line 2667  sub _get_next_token ($) {
2667          !!!cp (190);          !!!cp (190);
2668          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2669              .= chr $self->{next_char};              .= chr $self->{next_char};
2670            $self->{read_until}->($self->{current_token}->{public_identifier},
2671                                  q[">],
2672                                  length $self->{current_token}->{public_identifier});
2673    
2674          ## Stay in the state          ## Stay in the state
2675          !!!next-input-character;          !!!next-input-character;
2676          redo A;          redo A;
# Line 2568  sub _get_next_token ($) { Line 2707  sub _get_next_token ($) {
2707          !!!cp (194);          !!!cp (194);
2708          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2709              .= chr $self->{next_char};              .= chr $self->{next_char};
2710            $self->{read_until}->($self->{current_token}->{public_identifier},
2711                                  q['>],
2712                                  length $self->{current_token}->{public_identifier});
2713    
2714          ## Stay in the state          ## Stay in the state
2715          !!!next-input-character;          !!!next-input-character;
2716          redo A;          redo A;
# Line 2704  sub _get_next_token ($) { Line 2847  sub _get_next_token ($) {
2847          !!!cp (210);          !!!cp (210);
2848          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2849              .= chr $self->{next_char};              .= chr $self->{next_char};
2850            $self->{read_until}->($self->{current_token}->{system_identifier},
2851                                  q[">],
2852                                  length $self->{current_token}->{system_identifier});
2853    
2854          ## Stay in the state          ## Stay in the state
2855          !!!next-input-character;          !!!next-input-character;
2856          redo A;          redo A;
# Line 2740  sub _get_next_token ($) { Line 2887  sub _get_next_token ($) {
2887          !!!cp (214);          !!!cp (214);
2888          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2889              .= chr $self->{next_char};              .= chr $self->{next_char};
2890            $self->{read_until}->($self->{current_token}->{system_identifier},
2891                                  q['>],
2892                                  length $self->{current_token}->{system_identifier});
2893    
2894          ## Stay in the state          ## Stay in the state
2895          !!!next-input-character;          !!!next-input-character;
2896          redo A;          redo A;
# Line 2800  sub _get_next_token ($) { Line 2951  sub _get_next_token ($) {
2951          redo A;          redo A;
2952        } else {        } else {
2953          !!!cp (221);          !!!cp (221);
2954            my $s = '';
2955            $self->{read_until}->($s, q[>], 0);
2956    
2957          ## Stay in the state          ## Stay in the state
2958          !!!next-input-character;          !!!next-input-character;
2959          redo A;          redo A;
2960        }        }
2961      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2962        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2963          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2964          ## and |CDATA_SECTION_MSE2_STATE|.
2965                
2966        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2967            !!!cp (221.1);
2968        CS: while ($self->{next_char} != -1) {          $self->{state} = CDATA_SECTION_MSE1_STATE;
2969          if ($self->{next_char} == 0x005D) { # ]          !!!next-input-character;
2970            !!!next-input-character;          redo A;
2971            if ($self->{next_char} == 0x005D) { # ]        } elsif ($self->{next_char} == -1) {
2972              !!!next-input-character;          $self->{state} = DATA_STATE;
             MDC: {  
               if ($self->{next_char} == 0x003E) { # >  
                 !!!cp (221.1);  
                 !!!next-input-character;  
                 last CS;  
               } elsif ($self->{next_char} == 0x005D) { # ]  
                 !!!cp (221.2);  
                 $s .= ']';  
                 !!!next-input-character;  
                 redo MDC;  
               } else {  
                 !!!cp (221.3);  
                 $s .= ']]';  
                 #  
               }  
             } # MDC  
           } else {  
             !!!cp (221.4);  
             $s .= ']';  
             #  
           }  
         } else {  
           !!!cp (221.5);  
           #  
         }  
         $s .= chr $self->{next_char};  
2973          !!!next-input-character;          !!!next-input-character;
2974        } # CS          if (length $self->{current_token}->{data}) { # character
2975              !!!cp (221.2);
2976              !!!emit ($self->{current_token}); # character
2977            } else {
2978              !!!cp (221.3);
2979              ## No token to emit. $self->{current_token} is discarded.
2980            }        
2981            redo A;
2982          } else {
2983            !!!cp (221.4);
2984            $self->{current_token}->{data} .= chr $self->{next_char};
2985            $self->{read_until}->($self->{current_token}->{data},
2986                                  q<]>,
2987                                  length $self->{current_token}->{data});
2988    
2989        $self->{state} = DATA_STATE;          ## Stay in the state.
2990        ## next-input-character done or EOF, which is reconsumed.          !!!next-input-character;
2991            redo A;
2992          }
2993    
2994        if (length $s) {        ## ISSUE: "text tokens" in spec.
2995        } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
2996          if ($self->{next_char} == 0x005D) { # ]
2997            !!!cp (221.5);
2998            $self->{state} = CDATA_SECTION_MSE2_STATE;
2999            !!!next-input-character;
3000            redo A;
3001          } else {
3002          !!!cp (221.6);          !!!cp (221.6);
3003          !!!emit ({type => CHARACTER_TOKEN, data => $s,          $self->{current_token}->{data} .= ']';
3004                    line => $l, column => $c});          $self->{state} = CDATA_SECTION_STATE;
3005            ## Reconsume.
3006            redo A;
3007          }
3008        } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
3009          if ($self->{next_char} == 0x003E) { # >
3010            $self->{state} = DATA_STATE;
3011            !!!next-input-character;
3012            if (length $self->{current_token}->{data}) { # character
3013              !!!cp (221.7);
3014              !!!emit ($self->{current_token}); # character
3015            } else {
3016              !!!cp (221.8);
3017              ## No token to emit. $self->{current_token} is discarded.
3018            }
3019            redo A;
3020          } elsif ($self->{next_char} == 0x005D) { # ]
3021            !!!cp (221.9); # character
3022            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
3023            ## Stay in the state.
3024            !!!next-input-character;
3025            redo A;
3026        } else {        } else {
3027          !!!cp (221.7);          !!!cp (221.11);
3028            $self->{current_token}->{data} .= ']]'; # character
3029            $self->{state} = CDATA_SECTION_STATE;
3030            ## Reconsume.
3031            redo A;
3032          }
3033        } elsif ($self->{state} == ENTITY_STATE) {
3034          if ({
3035            0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
3036            0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, &
3037            $self->{entity_additional} => 1,
3038          }->{$self->{next_char}}) {
3039            !!!cp (1001);
3040            ## Don't consume
3041            ## No error
3042            ## Return nothing.
3043            #
3044          } elsif ($self->{next_char} == 0x0023) { # #
3045            !!!cp (999);
3046            $self->{state} = ENTITY_HASH_STATE;
3047            $self->{state_keyword} = '#';
3048            !!!next-input-character;
3049            redo A;
3050          } elsif ((0x0041 <= $self->{next_char} and
3051                    $self->{next_char} <= 0x005A) or # A..Z
3052                   (0x0061 <= $self->{next_char} and
3053                    $self->{next_char} <= 0x007A)) { # a..z
3054            !!!cp (998);
3055            require Whatpm::_NamedEntityList;
3056            $self->{state} = ENTITY_NAME_STATE;
3057            $self->{state_keyword} = chr $self->{next_char};
3058            $self->{entity__value} = $self->{state_keyword};
3059            $self->{entity__match} = 0;
3060            !!!next-input-character;
3061            redo A;
3062          } else {
3063            !!!cp (1027);
3064            !!!parse-error (type => 'bare ero');
3065            ## Return nothing.
3066            #
3067        }        }
3068    
3069        redo A;        ## NOTE: No character is consumed by the "consume a character
3070          ## reference" algorithm.  In other word, there is an "&" character
3071        ## ISSUE: "text tokens" in spec.        ## that does not introduce a character reference, which would be
3072        ## TODO: Streaming support        ## appended to the parent element or the attribute value in later
3073      } else {        ## process of the tokenizer.
3074        die "$0: $self->{state}: Unknown state";  
3075      }        if ($self->{prev_state} == DATA_STATE) {
3076    } # A            !!!cp (997);
3077            $self->{state} = $self->{prev_state};
3078    die "$0: _get_next_token: unexpected case";          ## Reconsume.
3079  } # _get_next_token          !!!emit ({type => CHARACTER_TOKEN, data => '&',
3080                      line => $self->{line_prev},
3081  sub _tokenize_attempt_to_consume_an_entity ($$$) {                    column => $self->{column_prev},
3082    my ($self, $in_attr, $additional) = @_;                   });
3083            redo A;
3084    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        } else {
3085            !!!cp (996);
3086            $self->{current_attribute}->{value} .= '&';
3087            $self->{state} = $self->{prev_state};
3088            ## Reconsume.
3089            redo A;
3090          }
3091        } elsif ($self->{state} == ENTITY_HASH_STATE) {
3092          if ($self->{next_char} == 0x0078 or # x
3093              $self->{next_char} == 0x0058) { # X
3094            !!!cp (995);
3095            $self->{state} = HEXREF_X_STATE;
3096            $self->{state_keyword} .= chr $self->{next_char};
3097            !!!next-input-character;
3098            redo A;
3099          } elsif (0x0030 <= $self->{next_char} and
3100                   $self->{next_char} <= 0x0039) { # 0..9
3101            !!!cp (994);
3102            $self->{state} = NCR_NUM_STATE;
3103            $self->{state_keyword} = $self->{next_char} - 0x0030;
3104            !!!next-input-character;
3105            redo A;
3106          } else {
3107            !!!parse-error (type => 'bare nero',
3108                            line => $self->{line_prev},
3109                            column => $self->{column_prev} - 1);
3110    
3111    if ({          ## NOTE: According to the spec algorithm, nothing is returned,
3112         0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,          ## and then "&#" is appended to the parent element or the attribute
3113         0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR          ## value in the later processing.
3114         $additional => 1,  
3115        }->{$self->{next_char}}) {          if ($self->{prev_state} == DATA_STATE) {
3116      !!!cp (1001);            !!!cp (1019);
3117      ## Don't consume            $self->{state} = $self->{prev_state};
3118      ## No error            ## Reconsume.
3119      return undef;            !!!emit ({type => CHARACTER_TOKEN,
3120    } elsif ($self->{next_char} == 0x0023) { # #                      data => '&#',
3121      !!!next-input-character;                      line => $self->{line_prev},
3122      if ($self->{next_char} == 0x0078 or # x                      column => $self->{column_prev} - 1,
3123          $self->{next_char} == 0x0058) { # X                     });
3124        my $code;            redo A;
       X: {  
         my $x_char = $self->{next_char};  
         !!!next-input-character;  
         if (0x0030 <= $self->{next_char} and  
             $self->{next_char} <= 0x0039) { # 0..9  
           !!!cp (1002);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0030;  
           redo X;  
         } elsif (0x0061 <= $self->{next_char} and  
                  $self->{next_char} <= 0x0066) { # a..f  
           !!!cp (1003);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0060 + 9;  
           redo X;  
         } elsif (0x0041 <= $self->{next_char} and  
                  $self->{next_char} <= 0x0046) { # A..F  
           !!!cp (1004);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0040 + 9;  
           redo X;  
         } elsif (not defined $code) { # no hexadecimal digit  
           !!!cp (1005);  
           !!!parse-error (type => 'bare hcro', line => $l, column => $c);  
           !!!back-next-input-character ($x_char, $self->{next_char});  
           $self->{next_char} = 0x0023; # #  
           return undef;  
         } elsif ($self->{next_char} == 0x003B) { # ;  
           !!!cp (1006);  
           !!!next-input-character;  
3125          } else {          } else {
3126            !!!cp (1007);            !!!cp (993);
3127            !!!parse-error (type => 'no refc', line => $l, column => $c);            $self->{current_attribute}->{value} .= '&#';
3128              $self->{state} = $self->{prev_state};
3129              ## Reconsume.
3130              redo A;
3131          }          }
3132          }
3133          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {      } elsif ($self->{state} == NCR_NUM_STATE) {
3134            !!!cp (1008);        if (0x0030 <= $self->{next_char} and
3135            !!!parse-error (type => 'invalid character reference',            $self->{next_char} <= 0x0039) { # 0..9
                           text => (sprintf 'U+%04X', $code),  
                           line => $l, column => $c);  
           $code = 0xFFFD;  
         } elsif ($code > 0x10FFFF) {  
           !!!cp (1009);  
           !!!parse-error (type => 'invalid character reference',  
                           text => (sprintf 'U-%08X', $code),  
                           line => $l, column => $c);  
           $code = 0xFFFD;  
         } elsif ($code == 0x000D) {  
           !!!cp (1010);  
           !!!parse-error (type => 'CR character reference', line => $l, column => $c);  
           $code = 0x000A;  
         } elsif (0x80 <= $code and $code <= 0x9F) {  
           !!!cp (1011);  
           !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);  
           $code = $c1_entity_char->{$code};  
         }  
   
         return {type => CHARACTER_TOKEN, data => chr $code,  
                 has_reference => 1,  
                 line => $l, column => $c,  
                };  
       } # X  
     } elsif (0x0030 <= $self->{next_char} and  
              $self->{next_char} <= 0x0039) { # 0..9  
       my $code = $self->{next_char} - 0x0030;  
       !!!next-input-character;  
         
       while (0x0030 <= $self->{next_char} and  
                 $self->{next_char} <= 0x0039) { # 0..9  
3136          !!!cp (1012);          !!!cp (1012);
3137          $code *= 10;          $self->{state_keyword} *= 10;
3138          $code += $self->{next_char} - 0x0030;          $self->{state_keyword} += $self->{next_char} - 0x0030;
3139                    
3140            ## Stay in the state.
3141          !!!next-input-character;          !!!next-input-character;
3142        }          redo A;
3143          } elsif ($self->{next_char} == 0x003B) { # ;
       if ($self->{next_char} == 0x003B) { # ;  
3144          !!!cp (1013);          !!!cp (1013);
3145          !!!next-input-character;          !!!next-input-character;
3146            #
3147        } else {        } else {
3148          !!!cp (1014);          !!!cp (1014);
3149          !!!parse-error (type => 'no refc', line => $l, column => $c);          !!!parse-error (type => 'no refc');
3150            ## Reconsume.
3151            #
3152        }        }
3153    
3154          my $code = $self->{state_keyword};
3155          my $l = $self->{line_prev};
3156          my $c = $self->{column_prev};
3157        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3158          !!!cp (1015);          !!!cp (1015);
3159          !!!parse-error (type => 'invalid character reference',          !!!parse-error (type => 'invalid character reference',
# Line 2996  sub _tokenize_attempt_to_consume_an_enti Line 3178  sub _tokenize_attempt_to_consume_an_enti
3178                          line => $l, column => $c);                          line => $l, column => $c);
3179          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3180        }        }
3181          
3182        return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        if ($self->{prev_state} == DATA_STATE) {
3183                line => $l, column => $c,          !!!cp (992);
3184               };          $self->{state} = $self->{prev_state};
3185      } else {          ## Reconsume.
3186        !!!cp (1019);          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3187        !!!parse-error (type => 'bare nero', line => $l, column => $c);                    line => $l, column => $c,
3188        !!!back-next-input-character ($self->{next_char});                   });
3189        $self->{next_char} = 0x0023; # #          redo A;
3190        return undef;        } else {
3191      }          !!!cp (991);
3192    } elsif ((0x0041 <= $self->{next_char} and          $self->{current_attribute}->{value} .= chr $code;
3193              $self->{next_char} <= 0x005A) or          $self->{current_attribute}->{has_reference} = 1;
3194             (0x0061 <= $self->{next_char} and          $self->{state} = $self->{prev_state};
3195              $self->{next_char} <= 0x007A)) {          ## Reconsume.
3196      my $entity_name = chr $self->{next_char};          redo A;
3197      !!!next-input-character;        }
3198        } elsif ($self->{state} == HEXREF_X_STATE) {
3199      my $value = $entity_name;        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3200      my $match = 0;            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3201      require Whatpm::_NamedEntityList;            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3202      our $EntityChar;          # 0..9, A..F, a..f
3203            !!!cp (990);
3204      while (length $entity_name < 30 and          $self->{state} = HEXREF_HEX_STATE;
3205             ## NOTE: Some number greater than the maximum length of entity name          $self->{state_keyword} = 0;
3206             ((0x0041 <= $self->{next_char} and # a          ## Reconsume.
3207               $self->{next_char} <= 0x005A) or # x          redo A;
3208              (0x0061 <= $self->{next_char} and # a        } else {
3209               $self->{next_char} <= 0x007A) or # z          !!!parse-error (type => 'bare hcro',
3210              (0x0030 <= $self->{next_char} and # 0                          line => $self->{line_prev},
3211               $self->{next_char} <= 0x0039) or # 9                          column => $self->{column_prev} - 2);
3212              $self->{next_char} == 0x003B)) { # ;  
3213        $entity_name .= chr $self->{next_char};          ## NOTE: According to the spec algorithm, nothing is returned,
3214        if (defined $EntityChar->{$entity_name}) {          ## and then "&#" followed by "X" or "x" is appended to the parent
3215          if ($self->{next_char} == 0x003B) { # ;          ## element or the attribute value in the later processing.
3216            !!!cp (1020);  
3217            $value = $EntityChar->{$entity_name};          if ($self->{prev_state} == DATA_STATE) {
3218            $match = 1;            !!!cp (1005);
3219            !!!next-input-character;            $self->{state} = $self->{prev_state};
3220            last;            ## Reconsume.
3221              !!!emit ({type => CHARACTER_TOKEN,
3222                        data => '&' . $self->{state_keyword},
3223                        line => $self->{line_prev},
3224                        column => $self->{column_prev} - length $self->{state_keyword},
3225                       });
3226              redo A;
3227            } else {
3228              !!!cp (989);
3229              $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3230              $self->{state} = $self->{prev_state};
3231              ## Reconsume.
3232              redo A;
3233            }
3234          }
3235        } elsif ($self->{state} == HEXREF_HEX_STATE) {
3236          if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) {
3237            # 0..9
3238            !!!cp (1002);
3239            $self->{state_keyword} *= 0x10;
3240            $self->{state_keyword} += $self->{next_char} - 0x0030;
3241            ## Stay in the state.
3242            !!!next-input-character;
3243            redo A;
3244          } elsif (0x0061 <= $self->{next_char} and
3245                   $self->{next_char} <= 0x0066) { # a..f
3246            !!!cp (1003);
3247            $self->{state_keyword} *= 0x10;
3248            $self->{state_keyword} += $self->{next_char} - 0x0060 + 9;
3249            ## Stay in the state.
3250            !!!next-input-character;
3251            redo A;
3252          } elsif (0x0041 <= $self->{next_char} and
3253                   $self->{next_char} <= 0x0046) { # A..F
3254            !!!cp (1004);
3255            $self->{state_keyword} *= 0x10;
3256            $self->{state_keyword} += $self->{next_char} - 0x0040 + 9;
3257            ## Stay in the state.
3258            !!!next-input-character;
3259            redo A;
3260          } elsif ($self->{next_char} == 0x003B) { # ;
3261            !!!cp (1006);
3262            !!!next-input-character;
3263            #
3264          } else {
3265            !!!cp (1007);
3266            !!!parse-error (type => 'no refc',
3267                            line => $self->{line},
3268                            column => $self->{column});
3269            ## Reconsume.
3270            #
3271          }
3272    
3273          my $code = $self->{state_keyword};
3274          my $l = $self->{line_prev};
3275          my $c = $self->{column_prev};
3276          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3277            !!!cp (1008);
3278            !!!parse-error (type => 'invalid character reference',
3279                            text => (sprintf 'U+%04X', $code),
3280                            line => $l, column => $c);
3281            $code = 0xFFFD;
3282          } elsif ($code > 0x10FFFF) {
3283            !!!cp (1009);
3284            !!!parse-error (type => 'invalid character reference',
3285                            text => (sprintf 'U-%08X', $code),
3286                            line => $l, column => $c);
3287            $code = 0xFFFD;
3288          } elsif ($code == 0x000D) {
3289            !!!cp (1010);
3290            !!!parse-error (type => 'CR character reference', line => $l, column => $c);
3291            $code = 0x000A;
3292          } elsif (0x80 <= $code and $code <= 0x9F) {
3293            !!!cp (1011);
3294            !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);
3295            $code = $c1_entity_char->{$code};
3296          }
3297    
3298          if ($self->{prev_state} == DATA_STATE) {
3299            !!!cp (988);
3300            $self->{state} = $self->{prev_state};
3301            ## Reconsume.
3302            !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3303                      line => $l, column => $c,
3304                     });
3305            redo A;
3306          } else {
3307            !!!cp (987);
3308            $self->{current_attribute}->{value} .= chr $code;
3309            $self->{current_attribute}->{has_reference} = 1;
3310            $self->{state} = $self->{prev_state};
3311            ## Reconsume.
3312            redo A;
3313          }
3314        } elsif ($self->{state} == ENTITY_NAME_STATE) {
3315          if (length $self->{state_keyword} < 30 and
3316              ## NOTE: Some number greater than the maximum length of entity name
3317              ((0x0041 <= $self->{next_char} and # a
3318                $self->{next_char} <= 0x005A) or # x
3319               (0x0061 <= $self->{next_char} and # a
3320                $self->{next_char} <= 0x007A) or # z
3321               (0x0030 <= $self->{next_char} and # 0
3322                $self->{next_char} <= 0x0039) or # 9
3323               $self->{next_char} == 0x003B)) { # ;
3324            our $EntityChar;
3325            $self->{state_keyword} .= chr $self->{next_char};
3326            if (defined $EntityChar->{$self->{state_keyword}}) {
3327              if ($self->{next_char} == 0x003B) { # ;
3328                !!!cp (1020);
3329                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3330                $self->{entity__match} = 1;
3331                !!!next-input-character;
3332                #
3333              } else {
3334                !!!cp (1021);
3335                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3336                $self->{entity__match} = -1;
3337                ## Stay in the state.
3338                !!!next-input-character;
3339                redo A;
3340              }
3341          } else {          } else {
3342            !!!cp (1021);            !!!cp (1022);
3343            $value = $EntityChar->{$entity_name};            $self->{entity__value} .= chr $self->{next_char};
3344            $match = -1;            $self->{entity__match} *= 2;
3345              ## Stay in the state.
3346            !!!next-input-character;            !!!next-input-character;
3347              redo A;
3348            }
3349          }
3350    
3351          my $data;
3352          my $has_ref;
3353          if ($self->{entity__match} > 0) {
3354            !!!cp (1023);
3355            $data = $self->{entity__value};
3356            $has_ref = 1;
3357            #
3358          } elsif ($self->{entity__match} < 0) {
3359            !!!parse-error (type => 'no refc');
3360            if ($self->{prev_state} != DATA_STATE and # in attribute
3361                $self->{entity__match} < -1) {
3362              !!!cp (1024);
3363              $data = '&' . $self->{state_keyword};
3364              #
3365            } else {
3366              !!!cp (1025);
3367              $data = $self->{entity__value};
3368              $has_ref = 1;
3369              #
3370          }          }
3371        } else {        } else {
3372          !!!cp (1022);          !!!cp (1026);
3373          $value .= chr $self->{next_char};          !!!parse-error (type => 'bare ero',
3374          $match *= 2;                          line => $self->{line_prev},
3375          !!!next-input-character;                          column => $self->{column_prev} - length $self->{state_keyword});
3376            $data = '&' . $self->{state_keyword};
3377            #
3378        }        }
3379      }    
3380              ## NOTE: In these cases, when a character reference is found,
3381      if ($match > 0) {        ## it is consumed and a character token is returned, or, otherwise,
3382        !!!cp (1023);        ## nothing is consumed and returned, according to the spec algorithm.
3383        return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        ## In this implementation, anything that has been examined by the
3384                line => $l, column => $c,        ## tokenizer is appended to the parent element or the attribute value
3385               };        ## as string, either literal string when no character reference or
3386      } elsif ($match < 0) {        ## entity-replaced string otherwise, in this stage, since any characters
3387        !!!parse-error (type => 'no refc', line => $l, column => $c);        ## that would not be consumed are appended in the data state or in an
3388        if ($in_attr and $match < -1) {        ## appropriate attribute value state anyway.
3389          !!!cp (1024);  
3390          return {type => CHARACTER_TOKEN, data => '&'.$entity_name,        if ($self->{prev_state} == DATA_STATE) {
3391                  line => $l, column => $c,          !!!cp (986);
3392                 };          $self->{state} = $self->{prev_state};
3393        } else {          ## Reconsume.
3394          !!!cp (1025);          !!!emit ({type => CHARACTER_TOKEN,
3395          return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,                    data => $data,
3396                  line => $l, column => $c,                    line => $self->{line_prev},
3397                 };                    column => $self->{column_prev} + 1 - length $self->{state_keyword},
3398                     });
3399            redo A;
3400          } else {
3401            !!!cp (985);
3402            $self->{current_attribute}->{value} .= $data;
3403            $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3404            $self->{state} = $self->{prev_state};
3405            ## Reconsume.
3406            redo A;
3407        }        }
3408      } else {      } else {
3409        !!!cp (1026);        die "$0: $self->{state}: Unknown state";
       !!!parse-error (type => 'bare ero', line => $l, column => $c);  
       ## NOTE: "No characters are consumed" in the spec.  
       return {type => CHARACTER_TOKEN, data => '&'.$value,  
               line => $l, column => $c,  
              };  
3410      }      }
3411    } else {    } # A  
3412      !!!cp (1027);  
3413      ## no characters are consumed    die "$0: _get_next_token: unexpected case";
3414      !!!parse-error (type => 'bare ero', line => $l, column => $c);  } # _get_next_token
     return undef;  
   }  
 } # _tokenize_attempt_to_consume_an_entity  
3415    
3416  sub _initialize_tree_constructor ($) {  sub _initialize_tree_constructor ($) {
3417    my $self = shift;    my $self = shift;
# Line 3147  sub _tree_construction_initial ($) { Line 3476  sub _tree_construction_initial ($) {
3476        ## language.        ## language.
3477        my $doctype_name = $token->{name};        my $doctype_name = $token->{name};
3478        $doctype_name = '' unless defined $doctype_name;        $doctype_name = '' unless defined $doctype_name;
3479        $doctype_name =~ tr/a-z/A-Z/;        $doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive
3480        if (not defined $token->{name} or # <!DOCTYPE>        if (not defined $token->{name} or # <!DOCTYPE>
           defined $token->{public_identifier} or  
3481            defined $token->{system_identifier}) {            defined $token->{system_identifier}) {
3482          !!!cp ('t1');          !!!cp ('t1');
3483          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3484        } elsif ($doctype_name ne 'HTML') {        } elsif ($doctype_name ne 'HTML') {
3485          !!!cp ('t2');          !!!cp ('t2');
         ## ISSUE: ASCII case-insensitive? (in fact it does not matter)  
3486          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3487          } elsif (defined $token->{public_identifier}) {
3488            if ($token->{public_identifier} eq 'XSLT-compat') {
3489              !!!cp ('t1.2');
3490              !!!parse-error (type => 'XSLT-compat', token => $token,
3491                              level => $self->{level}->{should});
3492            } else {
3493              !!!parse-error (type => 'not HTML5', token => $token);
3494            }
3495        } else {        } else {
3496          !!!cp ('t3');          !!!cp ('t3');
3497            #
3498        }        }
3499                
3500        my $doctype = $self->{document}->create_document_type_definition        my $doctype = $self->{document}->create_document_type_definition
# Line 4174  sub _tree_construction_main ($) { Line 4510  sub _tree_construction_main ($) {
4510            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4511              !!!cp ('t88.2');              !!!cp ('t88.2');
4512              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4513                #
4514            } else {            } else {
4515              !!!cp ('t88.1');              !!!cp ('t88.1');
4516              ## Ignore the token.              ## Ignore the token.
4517              !!!next-token;              #
             next B;  
4518            }            }
4519            unless (length $token->{data}) {            unless (length $token->{data}) {
4520              !!!cp ('t88');              !!!cp ('t88');
4521              !!!next-token;              !!!next-token;
4522              next B;              next B;
4523            }            }
4524    ## TODO: set $token->{column} appropriately
4525          }          }
4526    
4527          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {
# Line 6294  sub _tree_construction_main ($) { Line 6631  sub _tree_construction_main ($) {
6631            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6632              !!!cp ('t312');              !!!cp ('t312');
6633              !!!parse-error (type => 'after frameset:#text', token => $token);              !!!parse-error (type => 'after frameset:#text', token => $token);
6634            } else { # "after html frameset"            } else { # "after after frameset"
6635              !!!cp ('t313');              !!!cp ('t313');
6636              !!!parse-error (type => 'after html:#text', token => $token);              !!!parse-error (type => 'after html:#text', token => $token);
   
             $self->{insertion_mode} = AFTER_FRAMESET_IM;  
             ## Reprocess in the "after frameset" insertion mode.  
             !!!parse-error (type => 'after frameset:#text', token => $token);  
6637            }            }
6638                        
6639            ## Ignore the token.            ## Ignore the token.
# Line 6316  sub _tree_construction_main ($) { Line 6649  sub _tree_construction_main ($) {
6649                    
6650          die qq[$0: Character "$token->{data}"];          die qq[$0: Character "$token->{data}"];
6651        } elsif ($token->{type} == START_TAG_TOKEN) {        } elsif ($token->{type} == START_TAG_TOKEN) {
         if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {  
           !!!cp ('t316');  
           !!!parse-error (type => 'after html',  
                           text => $token->{tag_name}, token => $token);  
   
           $self->{insertion_mode} = AFTER_FRAMESET_IM;  
           ## Process in the "after frameset" insertion mode.  
         } else {  
           !!!cp ('t317');  
         }  
   
6652          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6653              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6654            !!!cp ('t318');            !!!cp ('t318');
# Line 6347  sub _tree_construction_main ($) { Line 6669  sub _tree_construction_main ($) {
6669            ## NOTE: As if in head.            ## NOTE: As if in head.
6670            $parse_rcdata->(CDATA_CONTENT_MODEL);            $parse_rcdata->(CDATA_CONTENT_MODEL);
6671            next B;            next B;
6672    
6673              ## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>|
6674              ## has no parse error.
6675          } else {          } else {
6676            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6677              !!!cp ('t321');              !!!cp ('t321');
6678              !!!parse-error (type => 'in frameset',              !!!parse-error (type => 'in frameset',
6679                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6680            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6681              !!!cp ('t322');              !!!cp ('t322');
6682              !!!parse-error (type => 'after frameset',              !!!parse-error (type => 'after frameset',
6683                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6684              } else { # "after after frameset"
6685                !!!cp ('t322.2');
6686                !!!parse-error (type => 'after after frameset',
6687                                text => $token->{tag_name}, token => $token);
6688            }            }
6689            ## Ignore the token            ## Ignore the token
6690            !!!nack ('t322.1');            !!!nack ('t322.1');
# Line 6363  sub _tree_construction_main ($) { Line 6692  sub _tree_construction_main ($) {
6692            next B;            next B;
6693          }          }
6694        } elsif ($token->{type} == END_TAG_TOKEN) {        } elsif ($token->{type} == END_TAG_TOKEN) {
         if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {  
           !!!cp ('t323');  
           !!!parse-error (type => 'after html:/',  
                           text => $token->{tag_name}, token => $token);  
   
           $self->{insertion_mode} = AFTER_FRAMESET_IM;  
           ## Process in the "after frameset" insertion mode.  
         } else {  
           !!!cp ('t324');  
         }  
   
6695          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6696              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6697            if ($self->{open_elements}->[-1]->[1] & HTML_EL and            if ($self->{open_elements}->[-1]->[1] & HTML_EL and
# Line 6408  sub _tree_construction_main ($) { Line 6726  sub _tree_construction_main ($) {
6726              !!!cp ('t330');              !!!cp ('t330');
6727              !!!parse-error (type => 'in frameset:/',              !!!parse-error (type => 'in frameset:/',
6728                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6729            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6730              !!!cp ('t331');              !!!cp ('t330.1');
6731              !!!parse-error (type => 'after frameset:/',              !!!parse-error (type => 'after frameset:/',
6732                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6733              } else { # "after after html"
6734                !!!cp ('t331');
6735                !!!parse-error (type => 'after after frameset:/',
6736                                text => $token->{tag_name}, token => $token);
6737            }            }
6738            ## Ignore the token            ## Ignore the token
6739            !!!next-token;            !!!next-token;
# Line 7134  sub _tree_construction_main ($) { Line 7456  sub _tree_construction_main ($) {
7456            !!!cp ('t413');            !!!cp ('t413');
7457            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7458                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7459              ## NOTE: Ignore the token.
7460          } else {          } else {
7461            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7462            while ({            while ({
# Line 7193  sub _tree_construction_main ($) { Line 7516  sub _tree_construction_main ($) {
7516            !!!cp ('t421');            !!!cp ('t421');
7517            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7518                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7519              ## NOTE: Ignore the token.
7520          } else {          } else {
7521            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7522            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7239  sub _tree_construction_main ($) { Line 7563  sub _tree_construction_main ($) {
7563            !!!cp ('t425.1');            !!!cp ('t425.1');
7564            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7565                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7566              ## NOTE: Ignore the token.
7567          } else {          } else {
7568            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7569            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7441  sub _tree_construction_main ($) { Line 7766  sub _tree_construction_main ($) {
7766    ## TODO: script stuffs    ## TODO: script stuffs
7767  } # _tree_construct_main  } # _tree_construct_main
7768    
7769  sub set_inner_html ($$$) {  sub set_inner_html ($$$$;$) {
7770    my $class = shift;    my $class = shift;
7771    my $node = shift;    my $node = shift;
7772    my $s = \$_[0];    #my $s = \$_[0];
7773    my $onerror = $_[1];    my $onerror = $_[1];
7774      my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7775    
7776    ## ISSUE: Should {confident} be true?    ## ISSUE: Should {confident} be true?
7777    
# Line 7464  sub set_inner_html ($$$) { Line 7790  sub set_inner_html ($$$) {
7790      }      }
7791    
7792      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7793      $class->parse_string ($$s => $node, $onerror);      $class->parse_char_string ($_[0] => $node, $onerror, $get_wrapper);
7794    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7795      ## TODO: If non-html element      ## TODO: If non-html element
7796    
7797      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
7798    
7799    ## TODO: Support for $get_wrapper
7800    
7801      ## Step 1 # MUST      ## Step 1 # MUST
7802      my $this_doc = $node->owner_document;      my $this_doc = $node->owner_document;
7803      my $doc = $this_doc->implementation->create_document;      my $doc = $this_doc->implementation->create_document;
# Line 7481  sub set_inner_html ($$$) { Line 7809  sub set_inner_html ($$$) {
7809      my $i = 0;      my $i = 0;
7810      $p->{line_prev} = $p->{line} = 1;      $p->{line_prev} = $p->{line} = 1;
7811      $p->{column_prev} = $p->{column} = 0;      $p->{column_prev} = $p->{column} = 0;
7812        require Whatpm::Charset::DecodeHandle;
7813        my $input = Whatpm::Charset::DecodeHandle::CharString->new (\($_[0]));
7814        $input = $get_wrapper->($input);
7815      $p->{set_next_char} = sub {      $p->{set_next_char} = sub {
7816        my $self = shift;        my $self = shift;
7817    
7818        pop @{$self->{prev_char}};        my $char = '';
7819        unshift @{$self->{prev_char}}, $self->{next_char};        if (defined $self->{next_next_char}) {
7820            $char = $self->{next_next_char};
7821        $self->{next_char} = -1 and return if $i >= length $$s;          delete $self->{next_next_char};
7822        $self->{next_char} = ord substr $$s, $i++, 1;          $self->{next_char} = ord $char;
7823          } else {
7824            $self->{char_buffer} = '';
7825            $self->{char_buffer_pos} = 0;
7826            
7827            my $count = $input->manakai_read_until
7828                ($self->{char_buffer}, qr/[^\x00\x0A\x0D]/,
7829                 $self->{char_buffer_pos});
7830            if ($count) {
7831              $self->{line_prev} = $self->{line};
7832              $self->{column_prev} = $self->{column};
7833              $self->{column}++;
7834              $self->{next_char}
7835                  = ord substr ($self->{char_buffer},
7836                                $self->{char_buffer_pos}++, 1);
7837              return;
7838            }
7839            
7840            if ($input->read ($char, 1)) {
7841              $self->{next_char} = ord $char;
7842            } else {
7843              $self->{next_char} = -1;
7844              return;
7845            }
7846          }
7847    
7848        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});
7849        $p->{column}++;        $p->{column}++;
# Line 7498  sub set_inner_html ($$$) { Line 7853  sub set_inner_html ($$$) {
7853          $p->{column} = 0;          $p->{column} = 0;
7854          !!!cp ('i1');          !!!cp ('i1');
7855        } elsif ($self->{next_char} == 0x000D) { # CR        } elsif ($self->{next_char} == 0x000D) { # CR
7856          $i++ if substr ($$s, $i, 1) eq "\x0A";  ## TODO: support for abort/streaming
7857            my $next = '';
7858            if ($input->read ($next, 1) and $next ne "\x0A") {
7859              $self->{next_next_char} = $next;
7860            }
7861          $self->{next_char} = 0x000A; # LF # MUST          $self->{next_char} = 0x000A; # LF # MUST
7862          $p->{line}++;          $p->{line}++;
7863          $p->{column} = 0;          $p->{column} = 0;
7864          !!!cp ('i2');          !!!cp ('i2');
       } elsif ($self->{next_char} > 0x10FFFF) {  
         $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST  
         !!!cp ('i3');  
7865        } elsif ($self->{next_char} == 0x0000) { # NULL        } elsif ($self->{next_char} == 0x0000) { # NULL
7866          !!!cp ('i4');          !!!cp ('i4');
7867          !!!parse-error (type => 'NULL');          !!!parse-error (type => 'NULL');
7868          $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST          $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
       } elsif ($self->{next_char} <= 0x0008 or  
                (0x000E <= $self->{next_char} and  
                 $self->{next_char} <= 0x001F) or  
                (0x007F <= $self->{next_char} and  
                 $self->{next_char} <= 0x009F) or  
                (0xD800 <= $self->{next_char} and  
                 $self->{next_char} <= 0xDFFF) or  
                (0xFDD0 <= $self->{next_char} and  
                 $self->{next_char} <= 0xFDDF) or  
                {  
                 0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,  
                 0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,  
                 0x4FFFE => 1, 0x4FFFF => 1, 0x5FFFE => 1, 0x5FFFF => 1,  
                 0x6FFFE => 1, 0x6FFFF => 1, 0x7FFFE => 1, 0x7FFFF => 1,  
                 0x8FFFE => 1, 0x8FFFF => 1, 0x9FFFE => 1, 0x9FFFF => 1,  
                 0xAFFFE => 1, 0xAFFFF => 1, 0xBFFFE => 1, 0xBFFFF => 1,  
                 0xCFFFE => 1, 0xCFFFF => 1, 0xDFFFE => 1, 0xDFFFF => 1,  
                 0xEFFFE => 1, 0xEFFFF => 1, 0xFFFFE => 1, 0xFFFFF => 1,  
                 0x10FFFE => 1, 0x10FFFF => 1,  
                }->{$self->{next_char}}) {  
         !!!cp ('i4.1');  
         if ($self->{next_char} < 0x10000) {  
           !!!parse-error (type => 'control char',  
                           text => (sprintf 'U+%04X', $self->{next_char}));  
         } else {  
           !!!parse-error (type => 'control char',  
                           text => (sprintf 'U-%08X', $self->{next_char}));  
         }  
7869        }        }
7870      };      };
7871      $p->{prev_char} = [-1, -1, -1];  
7872      $p->{next_char} = -1;      $p->{read_until} = sub {
7873              #my ($scalar, $specials_range, $offset) = @_;
7874          return 0 if defined $p->{next_next_char};
7875    
7876          my $pattern = qr/[^$_[1]\x00\x0A\x0D]/;
7877          my $offset = $_[2] || 0;
7878          
7879          if ($p->{char_buffer_pos} < length $p->{char_buffer}) {
7880            pos ($p->{char_buffer}) = $p->{char_buffer_pos};
7881            if ($p->{char_buffer} =~ /\G(?>$pattern)+/) {
7882              substr ($_[0], $offset)
7883                  = substr ($p->{char_buffer}, $-[0], $+[0] - $-[0]);
7884              my $count = $+[0] - $-[0];
7885              if ($count) {
7886                $p->{column} += $count;
7887                $p->{char_buffer_pos} += $count;
7888                $p->{line_prev} = $p->{line};
7889                $p->{column_prev} = $p->{column} - 1;
7890                $p->{prev_char} = [-1, -1, -1];
7891                $p->{next_char} = -1;
7892              }
7893              return $count;
7894            } else {
7895              return 0;
7896            }
7897          } else {
7898            my $count = $input->manakai_read_until ($_[0], $pattern, $_[2]);
7899            if ($count) {
7900              $p->{column} += $count;
7901              $p->{column_prev} += $count;
7902              $p->{prev_char} = [-1, -1, -1];
7903              $p->{next_char} = -1;
7904            }
7905            return $count;
7906          }
7907        }; # $p->{read_until}
7908    
7909      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7910        my (%opt) = @_;        my (%opt) = @_;
7911        my $line = $opt{line};        my $line = $opt{line};
# Line 7557  sub set_inner_html ($$$) { Line 7920  sub set_inner_html ($$$) {
7920        $ponerror->(line => $p->{line}, column => $p->{column}, @_);        $ponerror->(line => $p->{line}, column => $p->{column}, @_);
7921      };      };
7922            
7923        my $char_onerror = sub {
7924          my (undef, $type, %opt) = @_;
7925          $ponerror->(layer => 'encode',
7926                      line => $p->{line}, column => $p->{column} + 1,
7927                      %opt, type => $type);
7928        }; # $char_onerror
7929        $input->onerror ($char_onerror);
7930    
7931      $p->_initialize_tokenizer;      $p->_initialize_tokenizer;
7932      $p->_initialize_tree_constructor;      $p->_initialize_tree_constructor;
7933    

Legend:
Removed from v.1.155  
changed lines
  Added in v.1.182

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24