/[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.153 by wakaba, Fri Aug 15 08:32:41 2008 UTC revision 1.180 by wakaba, Sun Sep 14 14:35:43 2008 UTC
# Line 354  sub parse_byte_string ($$$$;$) { Line 354  sub parse_byte_string ($$$$;$) {
354    return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);    return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);
355  } # parse_byte_string  } # parse_byte_string
356    
357  sub parse_byte_stream ($$$$;$) {  sub parse_byte_stream ($$$$;$$) {
358      # my ($self, $charset_name, $byte_stream, $doc, $onerror, $get_wrapper) = @_;
359    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
360    my $charset_name = shift;    my $charset_name = shift;
361    my $byte_stream = $_[0];    my $byte_stream = $_[0];
# Line 365  sub parse_byte_stream ($$$$;$) { Line 366  sub parse_byte_stream ($$$$;$) {
366    };    };
367    $self->{parse_error} = $onerror; # updated later by parse_char_string    $self->{parse_error} = $onerror; # updated later by parse_char_string
368    
369      my $get_wrapper = $_[3] || sub ($) {
370        return $_[0]; # $_[0] = byte stream handle, returned = arg to char handle
371      };
372    
373    ## HTML5 encoding sniffing algorithm    ## HTML5 encoding sniffing algorithm
374    require Message::Charset::Info;    require Message::Charset::Info;
375    my $charset;    my $charset;
# Line 372  sub parse_byte_stream ($$$$;$) { Line 377  sub parse_byte_stream ($$$$;$) {
377    my ($char_stream, $e_status);    my ($char_stream, $e_status);
378    
379    SNIFFING: {    SNIFFING: {
380        ## NOTE: By setting |allow_fallback| option true when the
381        ## |get_decode_handle| method is invoked, we ignore what the HTML5
382        ## spec requires, i.e. unsupported encoding should be ignored.
383          ## TODO: We should not do this unless the parser is invoked
384          ## in the conformance checking mode, in which this behavior
385          ## would be useful.
386    
387      ## Step 1      ## Step 1
388      if (defined $charset_name) {      if (defined $charset_name) {
389        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
390              ## TODO: Is this ok?  Transfer protocol's parameter should be
391              ## interpreted in its semantics?
392    
393        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
394        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
# Line 399  sub parse_byte_stream ($$$$;$) { Line 412  sub parse_byte_stream ($$$$;$) {
412    
413      ## Step 3      ## Step 3
414      if ($byte_buffer =~ /^\xFE\xFF/) {      if ($byte_buffer =~ /^\xFE\xFF/) {
415        $charset = Message::Charset::Info->get_by_iana_name ('utf-16be');        $charset = Message::Charset::Info->get_by_html_name ('utf-16be');
416        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
417            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
418             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
419        $self->{confident} = 1;        $self->{confident} = 1;
420        last SNIFFING;        last SNIFFING;
421      } elsif ($byte_buffer =~ /^\xFF\xFE/) {      } elsif ($byte_buffer =~ /^\xFF\xFE/) {
422        $charset = Message::Charset::Info->get_by_iana_name ('utf-16le');        $charset = Message::Charset::Info->get_by_html_name ('utf-16le');
423        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
424            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
425             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
426        $self->{confident} = 1;        $self->{confident} = 1;
427        last SNIFFING;        last SNIFFING;
428      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {
429        $charset = Message::Charset::Info->get_by_iana_name ('utf-8');        $charset = Message::Charset::Info->get_by_html_name ('utf-8');
430        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
431            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
432             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
# Line 432  sub parse_byte_stream ($$$$;$) { Line 445  sub parse_byte_stream ($$$$;$) {
445      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string
446          ($byte_buffer);          ($byte_buffer);
447      if (defined $charset_name) {      if (defined $charset_name) {
448        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
449    
450        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
451        require Whatpm::Charset::DecodeHandle;        require Whatpm::Charset::DecodeHandle;
# Line 455  sub parse_byte_stream ($$$$;$) { Line 468  sub parse_byte_stream ($$$$;$) {
468    
469      ## Step 7: default      ## Step 7: default
470      ## TODO: Make this configurable.      ## TODO: Make this configurable.
471      $charset = Message::Charset::Info->get_by_iana_name ('windows-1252');      $charset = Message::Charset::Info->get_by_html_name ('windows-1252');
472          ## NOTE: We choose |windows-1252| here, since |utf-8| should be          ## NOTE: We choose |windows-1252| here, since |utf-8| should be
473          ## detectable in the step 6.          ## detectable in the step 6.
474      require Whatpm::Charset::DecodeHandle;      require Whatpm::Charset::DecodeHandle;
# Line 475  sub parse_byte_stream ($$$$;$) { Line 488  sub parse_byte_stream ($$$$;$) {
488      $self->{confident} = 0;      $self->{confident} = 0;
489    } # SNIFFING    } # SNIFFING
490    
   $self->{input_encoding} = $charset->get_iana_name;  
491    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
492        $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
493      !!!parse-error (type => 'chardecode:fallback',      !!!parse-error (type => 'chardecode:fallback',
494                      text => $self->{input_encoding},                      #text => $self->{input_encoding},
495                      level => $self->{level}->{uncertain},                      level => $self->{level}->{uncertain},
496                      line => 1, column => 1,                      line => 1, column => 1,
497                      layer => 'encode');                      layer => 'encode');
498    } elsif (not ($e_status &    } elsif (not ($e_status &
499                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL ())) {
500        $self->{input_encoding} = $charset->get_iana_name;
501      !!!parse-error (type => 'chardecode:no error',      !!!parse-error (type => 'chardecode:no error',
502                      text => $self->{input_encoding},                      text => $self->{input_encoding},
503                      level => $self->{level}->{uncertain},                      level => $self->{level}->{uncertain},
504                      line => 1, column => 1,                      line => 1, column => 1,
505                      layer => 'encode');                      layer => 'encode');
506      } else {
507        $self->{input_encoding} = $charset->get_iana_name;
508    }    }
509    
510    $self->{change_encoding} = sub {    $self->{change_encoding} = sub {
# Line 496  sub parse_byte_stream ($$$$;$) { Line 512  sub parse_byte_stream ($$$$;$) {
512      $charset_name = shift;      $charset_name = shift;
513      my $token = shift;      my $token = shift;
514    
515      $charset = Message::Charset::Info->get_by_iana_name ($charset_name);      $charset = Message::Charset::Info->get_by_html_name ($charset_name);
516      ($char_stream, $e_status) = $charset->get_decode_handle      ($char_stream, $e_status) = $charset->get_decode_handle
517          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,
518           byte_buffer => \ $buffer->{buffer});           byte_buffer => \ $buffer->{buffer});
# Line 507  sub parse_byte_stream ($$$$;$) { Line 523  sub parse_byte_stream ($$$$;$) {
523        ## Step 1            ## Step 1    
524        if ($charset->{category} &        if ($charset->{category} &
525            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {
526          $charset = Message::Charset::Info->get_by_iana_name ('utf-8');          $charset = Message::Charset::Info->get_by_html_name ('utf-8');
527          ($char_stream, $e_status) = $charset->get_decode_handle          ($char_stream, $e_status) = $charset->get_decode_handle
528              ($byte_stream,              ($byte_stream,
529               byte_buffer => \ $buffer->{buffer});               byte_buffer => \ $buffer->{buffer});
# Line 545  sub parse_byte_stream ($$$$;$) { Line 561  sub parse_byte_stream ($$$$;$) {
561    my $char_onerror = sub {    my $char_onerror = sub {
562      my (undef, $type, %opt) = @_;      my (undef, $type, %opt) = @_;
563      !!!parse-error (layer => 'encode',      !!!parse-error (layer => 'encode',
564                      %opt, type => $type,                      line => $self->{line}, column => $self->{column} + 1,
565                      line => $self->{line}, column => $self->{column} + 1);                      %opt, type => $type);
566      if ($opt{octets}) {      if ($opt{octets}) {
567        ${$opt{octets}} = "\x{FFFD}"; # relacement character        ${$opt{octets}} = "\x{FFFD}"; # relacement character
568      }      }
569    };    };
570    $char_stream->onerror ($char_onerror);  
571      my $wrapped_char_stream = $get_wrapper->($char_stream);
572      $wrapped_char_stream->onerror ($char_onerror);
573    
574    my @args = @_; shift @args; # $s    my @args = @_; shift @args; # $s
575    my $return;    my $return;
576    try {    try {
577      $return = $self->parse_char_stream ($char_stream, @args);        $return = $self->parse_char_stream ($wrapped_char_stream, @args);  
578    } catch Whatpm::HTML::RestartParser with {    } catch Whatpm::HTML::RestartParser with {
579      ## NOTE: Invoked after {change_encoding}.      ## NOTE: Invoked after {change_encoding}.
580    
     $self->{input_encoding} = $charset->get_iana_name;  
581      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
582          $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
583        !!!parse-error (type => 'chardecode:fallback',        !!!parse-error (type => 'chardecode:fallback',
                       text => $self->{input_encoding},  
584                        level => $self->{level}->{uncertain},                        level => $self->{level}->{uncertain},
585                          #text => $self->{input_encoding},
586                        line => 1, column => 1,                        line => 1, column => 1,
587                        layer => 'encode');                        layer => 'encode');
588      } elsif (not ($e_status &      } elsif (not ($e_status &
589                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL ())) {
590          $self->{input_encoding} = $charset->get_iana_name;
591        !!!parse-error (type => 'chardecode:no error',        !!!parse-error (type => 'chardecode:no error',
592                        text => $self->{input_encoding},                        text => $self->{input_encoding},
593                        level => $self->{level}->{uncertain},                        level => $self->{level}->{uncertain},
594                        line => 1, column => 1,                        line => 1, column => 1,
595                        layer => 'encode');                        layer => 'encode');
596        } else {
597          $self->{input_encoding} = $charset->get_iana_name;
598      }      }
599      $self->{confident} = 1;      $self->{confident} = 1;
600      $char_stream->onerror ($char_onerror);  
601      $return = $self->parse_char_stream ($char_stream, @args);      $wrapped_char_stream = $get_wrapper->($char_stream);
602        $wrapped_char_stream->onerror ($char_onerror);
603    
604        $return = $self->parse_char_stream ($wrapped_char_stream, @args);
605    };    };
606    return $return;    return $return;
607  } # parse_byte_stream  } # parse_byte_stream
# Line 591  sub parse_byte_stream ($$$$;$) { Line 615  sub parse_byte_stream ($$$$;$) {
615  ## 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
616  ## strip the BOM and never strip any ZWNBSP.  ## strip the BOM and never strip any ZWNBSP.
617    
618  sub parse_char_string ($$$;$) {  sub parse_char_string ($$$;$$) {
619      #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
620    my $self = shift;    my $self = shift;
   require utf8;  
621    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $s = ref $_[0] ? $_[0] : \($_[0]);
622    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;    require Whatpm::Charset::DecodeHandle;
623      my $input = Whatpm::Charset::DecodeHandle::CharString->new ($s);
624      if ($_[3]) {
625        $input = $_[3]->($input);
626      }
627    return $self->parse_char_stream ($input, @_[1..$#_]);    return $self->parse_char_stream ($input, @_[1..$#_]);
628  } # parse_char_string  } # parse_char_string
629  *parse_string = \&parse_char_string;  *parse_string = \&parse_char_string; ## NOTE: Alias for backward compatibility.
630    
631  sub parse_char_stream ($$$;$) {  sub parse_char_stream ($$$;$) {
632    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
# Line 611  sub parse_char_stream ($$$;$) { Line 639  sub parse_char_stream ($$$;$) {
639    $self->{confident} = 1 unless exists $self->{confident};    $self->{confident} = 1 unless exists $self->{confident};
640    $self->{document}->input_encoding ($self->{input_encoding})    $self->{document}->input_encoding ($self->{input_encoding})
641        if defined $self->{input_encoding};        if defined $self->{input_encoding};
642    ## TODO: |{input_encoding}| is needless?
643    
644    my $i = 0;    my $i = 0;
645    $self->{line_prev} = $self->{line} = 1;    $self->{line_prev} = $self->{line} = 1;
646    $self->{column_prev} = $self->{column} = 0;    $self->{column_prev} = -1;
647      $self->{column} = 0;
648    $self->{set_next_char} = sub {    $self->{set_next_char} = sub {
649      my $self = shift;      my $self = shift;
650    
651      pop @{$self->{prev_char}};      my $char = '';
     unshift @{$self->{prev_char}}, $self->{next_char};  
   
     my $char;  
652      if (defined $self->{next_next_char}) {      if (defined $self->{next_next_char}) {
653        $char = $self->{next_next_char};        $char = $self->{next_next_char};
654        delete $self->{next_next_char};        delete $self->{next_next_char};
655          $self->{next_char} = ord $char;
656      } else {      } else {
657        $char = $input->getc;        $self->{char_buffer} = '';
658          $self->{char_buffer_pos} = 0;
659    
660          my $count = $input->manakai_read_until
661             ($self->{char_buffer},
662              qr/(?![\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
663              $self->{char_buffer_pos});
664          if ($count) {
665            $self->{line_prev} = $self->{line};
666            $self->{column_prev} = $self->{column};
667            $self->{column}++;
668            $self->{next_char}
669                = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
670            return;
671          }
672    
673          if ($input->read ($char, 1)) {
674            $self->{next_char} = ord $char;
675          } else {
676            $self->{next_char} = -1;
677            return;
678          }
679      }      }
     $self->{next_char} = -1 and return unless defined $char;  
     $self->{next_char} = ord $char;  
680    
681      ($self->{line_prev}, $self->{column_prev})      ($self->{line_prev}, $self->{column_prev})
682          = ($self->{line}, $self->{column});          = ($self->{line}, $self->{column});
# Line 641  sub parse_char_stream ($$$;$) { Line 688  sub parse_char_stream ($$$;$) {
688        $self->{column} = 0;        $self->{column} = 0;
689      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
690        !!!cp ('j2');        !!!cp ('j2');
691        my $next = $input->getc;  ## TODO: support for abort/streaming
692        if (defined $next and $next ne "\x0A") {        my $next = '';
693          if ($input->read ($next, 1) and $next ne "\x0A") {
694          $self->{next_next_char} = $next;          $self->{next_next_char} = $next;
695        }        }
696        $self->{next_char} = 0x000A; # LF # MUST        $self->{next_char} = 0x000A; # LF # MUST
# Line 660  sub parse_char_stream ($$$;$) { Line 708  sub parse_char_stream ($$$;$) {
708               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or
709               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or
710               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or
711    ## ISSUE: U+FDE0-U+FDEF are not excluded
712               {               {
713                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,
714                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
# Line 681  sub parse_char_stream ($$$;$) { Line 730  sub parse_char_stream ($$$;$) {
730        }        }
731      }      }
732    };    };
733    $self->{prev_char} = [-1, -1, -1];  
734    $self->{next_char} = -1;    $self->{read_until} = sub {
735        #my ($scalar, $specials_range, $offset) = @_;
736        return 0 if defined $self->{next_next_char};
737    
738        my $pattern = qr/(?![$_[1]\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/;
739        my $offset = $_[2] || 0;
740    
741        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
742          pos ($self->{char_buffer}) = $self->{char_buffer_pos};
743          if ($self->{char_buffer} =~ /\G(?>$pattern)+/) {
744            substr ($_[0], $offset)
745                = substr ($self->{char_buffer}, $-[0], $+[0] - $-[0]);
746            my $count = $+[0] - $-[0];
747            if ($count) {
748              $self->{column} += $count;
749              $self->{char_buffer_pos} += $count;
750              $self->{line_prev} = $self->{line};
751              $self->{column_prev} = $self->{column} - 1;
752              $self->{prev_char} = [-1, -1, -1];
753              $self->{next_char} = -1;
754            }
755            return $count;
756          } else {
757            return 0;
758          }
759        } else {
760          my $count = $input->manakai_read_until ($_[0], $pattern, $_[2]);
761          if ($count) {
762            $self->{column} += $count;
763            $self->{line_prev} = $self->{line};
764            $self->{column_prev} = $self->{column} - 1;
765            $self->{prev_char} = [-1, -1, -1];
766            $self->{next_char} = -1;
767          }
768          return $count;
769        }
770      }; # $self->{read_until}
771    
772    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
773      my (%opt) = @_;      my (%opt) = @_;
# Line 708  sub new ($) { Line 793  sub new ($) {
793    my $class = shift;    my $class = shift;
794    my $self = bless {    my $self = bless {
795      level => {must => 'm',      level => {must => 'm',
796                  should => 's',
797                warn => 'w',                warn => 'w',
798                info => 'i',                info => 'i',
799                uncertain => 'u'},                uncertain => 'u'},
# Line 740  sub RCDATA_CONTENT_MODEL () { CM_ENTITY Line 826  sub RCDATA_CONTENT_MODEL () { CM_ENTITY
826  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
827    
828  sub DATA_STATE () { 0 }  sub DATA_STATE () { 0 }
829  sub ENTITY_DATA_STATE () { 1 }  #sub ENTITY_DATA_STATE () { 1 }
830  sub TAG_OPEN_STATE () { 2 }  sub TAG_OPEN_STATE () { 2 }
831  sub CLOSE_TAG_OPEN_STATE () { 3 }  sub CLOSE_TAG_OPEN_STATE () { 3 }
832  sub TAG_NAME_STATE () { 4 }  sub TAG_NAME_STATE () { 4 }
# Line 751  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 Line 837  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8
837  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
838  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
839  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
840  sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }  #sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
841  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
842  sub COMMENT_START_STATE () { 14 }  sub COMMENT_START_STATE () { 14 }
843  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
# Line 774  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT Line 860  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT
860  sub BOGUS_DOCTYPE_STATE () { 32 }  sub BOGUS_DOCTYPE_STATE () { 32 }
861  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }
862  sub SELF_CLOSING_START_TAG_STATE () { 34 }  sub SELF_CLOSING_START_TAG_STATE () { 34 }
863  sub CDATA_BLOCK_STATE () { 35 }  sub CDATA_SECTION_STATE () { 35 }
864    sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec
865    sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec
866    sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec
867    sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec
868    sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec
869    sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
870    sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec
871    sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec
872    ## NOTE: "Entity data state", "entity in attribute value state", and
873    ## "consume a character reference" algorithm are jointly implemented
874    ## using the following six states:
875    sub ENTITY_STATE () { 44 }
876    sub ENTITY_HASH_STATE () { 45 }
877    sub NCR_NUM_STATE () { 46 }
878    sub HEXREF_X_STATE () { 47 }
879    sub HEXREF_HEX_STATE () { 48 }
880    sub ENTITY_NAME_STATE () { 49 }
881    
882  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
883  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 827  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 930  sub IN_COLUMN_GROUP_IM () { 0b10 }
930  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
931    my $self = shift;    my $self = shift;
932    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
933      #$self->{state_keyword}; # initialized when used
934      #$self->{entity__value}; # initialized when used
935      #$self->{entity__match}; # initialized when used
936    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
937    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
938    undef $self->{current_attribute};    undef $self->{current_attribute};
939    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
940    undef $self->{last_attribute_value_state};    #$self->{prev_state}; # initialized when used
941    delete $self->{self_closing};    delete $self->{self_closing};
942    $self->{char} = [];    $self->{char_buffer} = '';
943    # $self->{next_char}    $self->{char_buffer_pos} = 0;
944      $self->{prev_char} = [-1, -1, -1];
945      $self->{next_char} = -1;
946    !!!next-input-character;    !!!next-input-character;
947    $self->{token} = [];    $self->{token} = [];
948    # $self->{escape}    # $self->{escape}
# Line 865  sub _initialize_tokenizer ($) { Line 973  sub _initialize_tokenizer ($) {
973  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
974  ## and removed from the list.  ## and removed from the list.
975    
976  ## NOTE: HTML5 "Writing HTML documents" section, applied to  ## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.)
977  ## 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,  
978    
979  sub _get_next_token ($) {  sub _get_next_token ($) {
980    my $self = shift;    my $self = shift;
# Line 902  sub _get_next_token ($) { Line 998  sub _get_next_token ($) {
998          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA
999              not $self->{escape}) {              not $self->{escape}) {
1000            !!!cp (1);            !!!cp (1);
1001            $self->{state} = ENTITY_DATA_STATE;            ## NOTE: In the spec, the tokenizer is switched to the
1002              ## "entity data state".  In this implementation, the tokenizer
1003              ## is switched to the |ENTITY_STATE|, which is an implementation
1004              ## of the "consume a character reference" algorithm.
1005              $self->{entity_additional} = -1;
1006              $self->{prev_state} = DATA_STATE;
1007              $self->{state} = ENTITY_STATE;
1008            !!!next-input-character;            !!!next-input-character;
1009            redo A;            redo A;
1010          } else {          } else {
# Line 966  sub _get_next_token ($) { Line 1068  sub _get_next_token ($) {
1068                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1069                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1070                    };                    };
1071          $self->{read_until}->($token->{data}, q[-!<>&], length $token->{data});
1072    
1073        ## Stay in the data state        ## Stay in the data state
1074        !!!next-input-character;        !!!next-input-character;
1075    
1076        !!!emit ($token);        !!!emit ($token);
1077    
1078        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;  
1079      } elsif ($self->{state} == TAG_OPEN_STATE) {      } elsif ($self->{state} == TAG_OPEN_STATE) {
1080        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1081          if ($self->{next_char} == 0x002F) { # /          if ($self->{next_char} == 0x002F) { # /
# Line 1089  sub _get_next_token ($) { Line 1172  sub _get_next_token ($) {
1172          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1173        }        }
1174      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1175          ## NOTE: The "close tag open state" in the spec is implemented as
1176          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1177    
1178        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1179        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1180          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1181              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1182            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1183            my @next_char;            ## Reconsume.
1184            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...  
           }  
1185          } else {          } else {
1186            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1187              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1188            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1189            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1190              ## Reconsume.
1191            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1192                      line => $l, column => $c,                      line => $l, column => $c,
1193                     });                     });
1194            redo A;            redo A;
1195          }          }
1196        }        }
1197          
1198        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1199            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1200          !!!cp (29);          !!!cp (29);
# Line 1198  sub _get_next_token ($) { Line 1241  sub _get_next_token ($) {
1241                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1242                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1243                                   };                                   };
1244          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1245          redo A;          ## Although the "anything else" case of the spec not explicitly
1246            ## states that the next input character is to be reconsumed,
1247            ## it will be included to the |data| of the comment token
1248            ## generated from the bogus end tag, as defined in the
1249            ## "bogus comment state" entry.
1250            redo A;
1251          }
1252        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1253          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1254          if (length $ch) {
1255            my $CH = $ch;
1256            $ch =~ tr/a-z/A-Z/;
1257            my $nch = chr $self->{next_char};
1258            if ($nch eq $ch or $nch eq $CH) {
1259              !!!cp (24);
1260              ## Stay in the state.
1261              $self->{state_keyword} .= $nch;
1262              !!!next-input-character;
1263              redo A;
1264            } else {
1265              !!!cp (25);
1266              $self->{state} = DATA_STATE;
1267              ## Reconsume.
1268              !!!emit ({type => CHARACTER_TOKEN,
1269                        data => '</' . $self->{state_keyword},
1270                        line => $self->{line_prev},
1271                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1272                       });
1273              redo A;
1274            }
1275          } else { # after "<{tag-name}"
1276            unless ({
1277                     0x0009 => 1, # HT
1278                     0x000A => 1, # LF
1279                     0x000B => 1, # VT
1280                     0x000C => 1, # FF
1281                     0x0020 => 1, # SP
1282                     0x003E => 1, # >
1283                     0x002F => 1, # /
1284                     -1 => 1, # EOF
1285                    }->{$self->{next_char}}) {
1286              !!!cp (26);
1287              ## Reconsume.
1288              $self->{state} = DATA_STATE;
1289              !!!emit ({type => CHARACTER_TOKEN,
1290                        data => '</' . $self->{state_keyword},
1291                        line => $self->{line_prev},
1292                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1293                       });
1294              redo A;
1295            } else {
1296              !!!cp (27);
1297              $self->{current_token}
1298                  = {type => END_TAG_TOKEN,
1299                     tag_name => $self->{last_emitted_start_tag_name},
1300                     line => $self->{line_prev},
1301                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1302              $self->{state} = TAG_NAME_STATE;
1303              ## Reconsume.
1304              redo A;
1305            }
1306        }        }
1307      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1308        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1540  sub _get_next_token ($) { Line 1643  sub _get_next_token ($) {
1643    
1644          redo A;          redo A;
1645        } else {        } else {
1646          !!!cp (82);          if ($self->{next_char} == 0x0022 or # "
1647                $self->{next_char} == 0x0027) { # '
1648              !!!cp (78);
1649              !!!parse-error (type => 'bad attribute name');
1650            } else {
1651              !!!cp (82);
1652            }
1653          $self->{current_attribute}          $self->{current_attribute}
1654              = {name => chr ($self->{next_char}),              = {name => chr ($self->{next_char}),
1655                 value => '',                 value => '',
# Line 1575  sub _get_next_token ($) { Line 1684  sub _get_next_token ($) {
1684          !!!next-input-character;          !!!next-input-character;
1685          redo A;          redo A;
1686        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
1687            !!!parse-error (type => 'empty unquoted attribute value');
1688          if ($self->{current_token}->{type} == START_TAG_TOKEN) {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1689            !!!cp (87);            !!!cp (87);
1690            $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 1749  sub _get_next_token ($) {
1749          redo A;          redo A;
1750        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1751          !!!cp (96);          !!!cp (96);
1752          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1753          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1754            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1755            ## implementation of the "consume a character reference" algorithm.
1756            $self->{prev_state} = $self->{state};
1757            $self->{entity_additional} = 0x0022; # "
1758            $self->{state} = ENTITY_STATE;
1759          !!!next-input-character;          !!!next-input-character;
1760          redo A;          redo A;
1761        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1669  sub _get_next_token ($) { Line 1784  sub _get_next_token ($) {
1784        } else {        } else {
1785          !!!cp (100);          !!!cp (100);
1786          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1787            $self->{read_until}->($self->{current_attribute}->{value},
1788                                  q["&],
1789                                  length $self->{current_attribute}->{value});
1790    
1791          ## Stay in the state          ## Stay in the state
1792          !!!next-input-character;          !!!next-input-character;
1793          redo A;          redo A;
# Line 1681  sub _get_next_token ($) { Line 1800  sub _get_next_token ($) {
1800          redo A;          redo A;
1801        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1802          !!!cp (102);          !!!cp (102);
1803          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1804          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1805            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1806            ## implementation of the "consume a character reference" algorithm.
1807            $self->{entity_additional} = 0x0027; # '
1808            $self->{prev_state} = $self->{state};
1809            $self->{state} = ENTITY_STATE;
1810          !!!next-input-character;          !!!next-input-character;
1811          redo A;          redo A;
1812        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1711  sub _get_next_token ($) { Line 1835  sub _get_next_token ($) {
1835        } else {        } else {
1836          !!!cp (106);          !!!cp (106);
1837          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1838            $self->{read_until}->($self->{current_attribute}->{value},
1839                                  q['&],
1840                                  length $self->{current_attribute}->{value});
1841    
1842          ## Stay in the state          ## Stay in the state
1843          !!!next-input-character;          !!!next-input-character;
1844          redo A;          redo A;
# Line 1727  sub _get_next_token ($) { Line 1855  sub _get_next_token ($) {
1855          redo A;          redo A;
1856        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1857          !!!cp (108);          !!!cp (108);
1858          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1859          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1860            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1861            ## implementation of the "consume a character reference" algorithm.
1862            $self->{entity_additional} = -1;
1863            $self->{prev_state} = $self->{state};
1864            $self->{state} = ENTITY_STATE;
1865          !!!next-input-character;          !!!next-input-character;
1866          redo A;          redo A;
1867        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
# Line 1788  sub _get_next_token ($) { Line 1921  sub _get_next_token ($) {
1921            !!!cp (116);            !!!cp (116);
1922          }          }
1923          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1924            $self->{read_until}->($self->{current_attribute}->{value},
1925                                  q["'=& >],
1926                                  length $self->{current_attribute}->{value});
1927    
1928          ## Stay in the state          ## Stay in the state
1929          !!!next-input-character;          !!!next-input-character;
1930          redo A;          redo A;
1931        }        }
     } 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;  
1932      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {
1933        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
1934            $self->{next_char} == 0x000A or # LF            $self->{next_char} == 0x000A or # LF
# Line 1933  sub _get_next_token ($) { Line 2048  sub _get_next_token ($) {
2048        }        }
2049      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
2050        ## (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;  
   
           !!!emit ($self->{current_token}); # comment  
2051    
2052            redo A;        ## NOTE: Unlike spec's "bogus comment state", this implementation
2053          } elsif ($self->{next_char} == -1) {        ## consumes characters one-by-one basis.
2054            !!!cp (125);        
2055            $self->{state} = DATA_STATE;        if ($self->{next_char} == 0x003E) { # >
2056            ## reconsume          !!!cp (124);
2057            $self->{state} = DATA_STATE;
2058            !!!next-input-character;
2059    
2060            !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
2061            redo A;
2062          } elsif ($self->{next_char} == -1) {
2063            !!!cp (125);
2064            $self->{state} = DATA_STATE;
2065            ## reconsume
2066    
2067            redo A;          !!!emit ($self->{current_token}); # comment
2068          } else {          redo A;
2069            !!!cp (126);        } else {
2070            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          !!!cp (126);
2071            !!!next-input-character;          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2072            redo BC;          $self->{read_until}->($self->{current_token}->{data},
2073          }                                q[>],
2074        } # BC                                length $self->{current_token}->{data});
2075    
2076        die "$0: _get_next_token: unexpected case [BC]";          ## Stay in the state.
2077            !!!next-input-character;
2078            redo A;
2079          }
2080      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2081        ## (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};  
2082                
2083        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2084            !!!cp (133);
2085            $self->{state} = MD_HYPHEN_STATE;
2086          !!!next-input-character;          !!!next-input-character;
2087          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);  
         }  
2088        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2089                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2090            ## ASCII case-insensitive.
2091            !!!cp (130);
2092            $self->{state} = MD_DOCTYPE_STATE;
2093            $self->{state_keyword} = chr $self->{next_char};
2094          !!!next-input-character;          !!!next-input-character;
2095          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);  
         }  
2096        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2097                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2098                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2099            !!!cp (135.4);                
2100            $self->{state} = MD_CDATA_STATE;
2101            $self->{state_keyword} = '[';
2102          !!!next-input-character;          !!!next-input-character;
2103          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);  
         }  
2104        } else {        } else {
2105          !!!cp (136);          !!!cp (136);
2106        }        }
2107    
2108        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2109        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2110        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2111          ## Reconsume.
2112        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2113        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2114                                  line => $l, column => $c,                                  line => $self->{line_prev},
2115                                    column => $self->{column_prev} - 1,
2116                                 };                                 };
2117        redo A;        redo A;
2118              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2119        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2120        ## 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);
2121            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2122                                      line => $self->{line_prev},
2123                                      column => $self->{column_prev} - 2,
2124                                     };
2125            $self->{state} = COMMENT_START_STATE;
2126            !!!next-input-character;
2127            redo A;
2128          } else {
2129            !!!cp (128);
2130            !!!parse-error (type => 'bogus comment',
2131                            line => $self->{line_prev},
2132                            column => $self->{column_prev} - 2);
2133            $self->{state} = BOGUS_COMMENT_STATE;
2134            ## Reconsume.
2135            $self->{current_token} = {type => COMMENT_TOKEN,
2136                                      data => '-',
2137                                      line => $self->{line_prev},
2138                                      column => $self->{column_prev} - 2,
2139                                     };
2140            redo A;
2141          }
2142        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2143          ## ASCII case-insensitive.
2144          if ($self->{next_char} == [
2145                undef,
2146                0x004F, # O
2147                0x0043, # C
2148                0x0054, # T
2149                0x0059, # Y
2150                0x0050, # P
2151              ]->[length $self->{state_keyword}] or
2152              $self->{next_char} == [
2153                undef,
2154                0x006F, # o
2155                0x0063, # c
2156                0x0074, # t
2157                0x0079, # y
2158                0x0070, # p
2159              ]->[length $self->{state_keyword}]) {
2160            !!!cp (131);
2161            ## Stay in the state.
2162            $self->{state_keyword} .= chr $self->{next_char};
2163            !!!next-input-character;
2164            redo A;
2165          } elsif ((length $self->{state_keyword}) == 6 and
2166                   ($self->{next_char} == 0x0045 or # E
2167                    $self->{next_char} == 0x0065)) { # e
2168            !!!cp (129);
2169            $self->{state} = DOCTYPE_STATE;
2170            $self->{current_token} = {type => DOCTYPE_TOKEN,
2171                                      quirks => 1,
2172                                      line => $self->{line_prev},
2173                                      column => $self->{column_prev} - 7,
2174                                     };
2175            !!!next-input-character;
2176            redo A;
2177          } else {
2178            !!!cp (132);        
2179            !!!parse-error (type => 'bogus comment',
2180                            line => $self->{line_prev},
2181                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2182            $self->{state} = BOGUS_COMMENT_STATE;
2183            ## Reconsume.
2184            $self->{current_token} = {type => COMMENT_TOKEN,
2185                                      data => $self->{state_keyword},
2186                                      line => $self->{line_prev},
2187                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2188                                     };
2189            redo A;
2190          }
2191        } elsif ($self->{state} == MD_CDATA_STATE) {
2192          if ($self->{next_char} == {
2193                '[' => 0x0043, # C
2194                '[C' => 0x0044, # D
2195                '[CD' => 0x0041, # A
2196                '[CDA' => 0x0054, # T
2197                '[CDAT' => 0x0041, # A
2198              }->{$self->{state_keyword}}) {
2199            !!!cp (135.1);
2200            ## Stay in the state.
2201            $self->{state_keyword} .= chr $self->{next_char};
2202            !!!next-input-character;
2203            redo A;
2204          } elsif ($self->{state_keyword} eq '[CDATA' and
2205                   $self->{next_char} == 0x005B) { # [
2206            !!!cp (135.2);
2207            $self->{current_token} = {type => CHARACTER_TOKEN,
2208                                      data => '',
2209                                      line => $self->{line_prev},
2210                                      column => $self->{column_prev} - 7};
2211            $self->{state} = CDATA_SECTION_STATE;
2212            !!!next-input-character;
2213            redo A;
2214          } else {
2215            !!!cp (135.3);
2216            !!!parse-error (type => 'bogus comment',
2217                            line => $self->{line_prev},
2218                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2219            $self->{state} = BOGUS_COMMENT_STATE;
2220            ## Reconsume.
2221            $self->{current_token} = {type => COMMENT_TOKEN,
2222                                      data => $self->{state_keyword},
2223                                      line => $self->{line_prev},
2224                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2225                                     };
2226            redo A;
2227          }
2228      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2229        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2230          !!!cp (137);          !!!cp (137);
# Line 2178  sub _get_next_token ($) { Line 2307  sub _get_next_token ($) {
2307        } else {        } else {
2308          !!!cp (147);          !!!cp (147);
2309          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2310            $self->{read_until}->($self->{current_token}->{data},
2311                                  q[-],
2312                                  length $self->{current_token}->{data});
2313    
2314          ## Stay in the state          ## Stay in the state
2315          !!!next-input-character;          !!!next-input-character;
2316          redo A;          redo A;
# Line 2362  sub _get_next_token ($) { Line 2495  sub _get_next_token ($) {
2495          redo A;          redo A;
2496        } elsif ($self->{next_char} == 0x0050 or # P        } elsif ($self->{next_char} == 0x0050 or # P
2497                 $self->{next_char} == 0x0070) { # p                 $self->{next_char} == 0x0070) { # p
2498            $self->{state} = PUBLIC_STATE;
2499            $self->{state_keyword} = chr $self->{next_char};
2500          !!!next-input-character;          !!!next-input-character;
2501          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);  
         }  
   
         #  
2502        } elsif ($self->{next_char} == 0x0053 or # S        } elsif ($self->{next_char} == 0x0053 or # S
2503                 $self->{next_char} == 0x0073) { # s                 $self->{next_char} == 0x0073) { # s
2504            $self->{state} = SYSTEM_STATE;
2505            $self->{state_keyword} = chr $self->{next_char};
2506          !!!next-input-character;          !!!next-input-character;
2507          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);  
         }  
   
         #  
2508        } else {        } else {
2509          !!!cp (180);          !!!cp (180);
2510            !!!parse-error (type => 'string after DOCTYPE name');
2511            $self->{current_token}->{quirks} = 1;
2512    
2513            $self->{state} = BOGUS_DOCTYPE_STATE;
2514          !!!next-input-character;          !!!next-input-character;
2515          #          redo A;
2516        }        }
2517        } elsif ($self->{state} == PUBLIC_STATE) {
2518          ## ASCII case-insensitive
2519          if ($self->{next_char} == [
2520                undef,
2521                0x0055, # U
2522                0x0042, # B
2523                0x004C, # L
2524                0x0049, # I
2525              ]->[length $self->{state_keyword}] or
2526              $self->{next_char} == [
2527                undef,
2528                0x0075, # u
2529                0x0062, # b
2530                0x006C, # l
2531                0x0069, # i
2532              ]->[length $self->{state_keyword}]) {
2533            !!!cp (175);
2534            ## Stay in the state.
2535            $self->{state_keyword} .= chr $self->{next_char};
2536            !!!next-input-character;
2537            redo A;
2538          } elsif ((length $self->{state_keyword}) == 5 and
2539                   ($self->{next_char} == 0x0043 or # C
2540                    $self->{next_char} == 0x0063)) { # c
2541            !!!cp (168);
2542            $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
2543            !!!next-input-character;
2544            redo A;
2545          } else {
2546            !!!cp (169);
2547            !!!parse-error (type => 'string after DOCTYPE name',
2548                            line => $self->{line_prev},
2549                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2550            $self->{current_token}->{quirks} = 1;
2551    
2552        !!!parse-error (type => 'string after DOCTYPE name');          $self->{state} = BOGUS_DOCTYPE_STATE;
2553        $self->{current_token}->{quirks} = 1;          ## Reconsume.
2554            redo A;
2555          }
2556        } elsif ($self->{state} == SYSTEM_STATE) {
2557          ## ASCII case-insensitive
2558          if ($self->{next_char} == [
2559                undef,
2560                0x0059, # Y
2561                0x0053, # S
2562                0x0054, # T
2563                0x0045, # E
2564              ]->[length $self->{state_keyword}] or
2565              $self->{next_char} == [
2566                undef,
2567                0x0079, # y
2568                0x0073, # s
2569                0x0074, # t
2570                0x0065, # e
2571              ]->[length $self->{state_keyword}]) {
2572            !!!cp (170);
2573            ## Stay in the state.
2574            $self->{state_keyword} .= chr $self->{next_char};
2575            !!!next-input-character;
2576            redo A;
2577          } elsif ((length $self->{state_keyword}) == 5 and
2578                   ($self->{next_char} == 0x004D or # M
2579                    $self->{next_char} == 0x006D)) { # m
2580            !!!cp (171);
2581            $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
2582            !!!next-input-character;
2583            redo A;
2584          } else {
2585            !!!cp (172);
2586            !!!parse-error (type => 'string after DOCTYPE name',
2587                            line => $self->{line_prev},
2588                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2589            $self->{current_token}->{quirks} = 1;
2590    
2591        $self->{state} = BOGUS_DOCTYPE_STATE;          $self->{state} = BOGUS_DOCTYPE_STATE;
2592        # next-input-character is already done          ## Reconsume.
2593        redo A;          redo A;
2594          }
2595      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
2596        if ({        if ({
2597              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 2676  sub _get_next_token ($) {
2676          !!!cp (190);          !!!cp (190);
2677          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2678              .= chr $self->{next_char};              .= chr $self->{next_char};
2679            $self->{read_until}->($self->{current_token}->{public_identifier},
2680                                  q[">],
2681                                  length $self->{current_token}->{public_identifier});
2682    
2683          ## Stay in the state          ## Stay in the state
2684          !!!next-input-character;          !!!next-input-character;
2685          redo A;          redo A;
# Line 2568  sub _get_next_token ($) { Line 2716  sub _get_next_token ($) {
2716          !!!cp (194);          !!!cp (194);
2717          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2718              .= chr $self->{next_char};              .= chr $self->{next_char};
2719            $self->{read_until}->($self->{current_token}->{public_identifier},
2720                                  q['>],
2721                                  length $self->{current_token}->{public_identifier});
2722    
2723          ## Stay in the state          ## Stay in the state
2724          !!!next-input-character;          !!!next-input-character;
2725          redo A;          redo A;
# Line 2704  sub _get_next_token ($) { Line 2856  sub _get_next_token ($) {
2856          !!!cp (210);          !!!cp (210);
2857          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2858              .= chr $self->{next_char};              .= chr $self->{next_char};
2859            $self->{read_until}->($self->{current_token}->{system_identifier},
2860                                  q[">],
2861                                  length $self->{current_token}->{system_identifier});
2862    
2863          ## Stay in the state          ## Stay in the state
2864          !!!next-input-character;          !!!next-input-character;
2865          redo A;          redo A;
# Line 2740  sub _get_next_token ($) { Line 2896  sub _get_next_token ($) {
2896          !!!cp (214);          !!!cp (214);
2897          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2898              .= chr $self->{next_char};              .= chr $self->{next_char};
2899            $self->{read_until}->($self->{current_token}->{system_identifier},
2900                                  q['>],
2901                                  length $self->{current_token}->{system_identifier});
2902    
2903          ## Stay in the state          ## Stay in the state
2904          !!!next-input-character;          !!!next-input-character;
2905          redo A;          redo A;
# Line 2800  sub _get_next_token ($) { Line 2960  sub _get_next_token ($) {
2960          redo A;          redo A;
2961        } else {        } else {
2962          !!!cp (221);          !!!cp (221);
2963            my $s = '';
2964            $self->{read_until}->($s, q[>], 0);
2965    
2966          ## Stay in the state          ## Stay in the state
2967          !!!next-input-character;          !!!next-input-character;
2968          redo A;          redo A;
2969        }        }
2970      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2971        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2972          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2973          ## and |CDATA_SECTION_MSE2_STATE|.
2974                
2975        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2976            !!!cp (221.1);
2977        CS: while ($self->{next_char} != -1) {          $self->{state} = CDATA_SECTION_MSE1_STATE;
         if ($self->{next_char} == 0x005D) { # ]  
           !!!next-input-character;  
           if ($self->{next_char} == 0x005D) { # ]  
             !!!next-input-character;  
             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};  
2978          !!!next-input-character;          !!!next-input-character;
2979        } # CS          redo A;
2980          } elsif ($self->{next_char} == -1) {
2981            $self->{state} = DATA_STATE;
2982            !!!next-input-character;
2983            if (length $self->{current_token}->{data}) { # character
2984              !!!cp (221.2);
2985              !!!emit ($self->{current_token}); # character
2986            } else {
2987              !!!cp (221.3);
2988              ## No token to emit. $self->{current_token} is discarded.
2989            }        
2990            redo A;
2991          } else {
2992            !!!cp (221.4);
2993            $self->{current_token}->{data} .= chr $self->{next_char};
2994            $self->{read_until}->($self->{current_token}->{data},
2995                                  q<]>,
2996                                  length $self->{current_token}->{data});
2997    
2998        $self->{state} = DATA_STATE;          ## Stay in the state.
2999        ## next-input-character done or EOF, which is reconsumed.          !!!next-input-character;
3000            redo A;
3001          }
3002    
3003        if (length $s) {        ## ISSUE: "text tokens" in spec.
3004        } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
3005          if ($self->{next_char} == 0x005D) { # ]
3006            !!!cp (221.5);
3007            $self->{state} = CDATA_SECTION_MSE2_STATE;
3008            !!!next-input-character;
3009            redo A;
3010          } else {
3011          !!!cp (221.6);          !!!cp (221.6);
3012          !!!emit ({type => CHARACTER_TOKEN, data => $s,          $self->{current_token}->{data} .= ']';
3013                    line => $l, column => $c});          $self->{state} = CDATA_SECTION_STATE;
3014            ## Reconsume.
3015            redo A;
3016          }
3017        } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
3018          if ($self->{next_char} == 0x003E) { # >
3019            $self->{state} = DATA_STATE;
3020            !!!next-input-character;
3021            if (length $self->{current_token}->{data}) { # character
3022              !!!cp (221.7);
3023              !!!emit ($self->{current_token}); # character
3024            } else {
3025              !!!cp (221.8);
3026              ## No token to emit. $self->{current_token} is discarded.
3027            }
3028            redo A;
3029          } elsif ($self->{next_char} == 0x005D) { # ]
3030            !!!cp (221.9); # character
3031            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
3032            ## Stay in the state.
3033            !!!next-input-character;
3034            redo A;
3035        } else {        } else {
3036          !!!cp (221.7);          !!!cp (221.11);
3037            $self->{current_token}->{data} .= ']]'; # character
3038            $self->{state} = CDATA_SECTION_STATE;
3039            ## Reconsume.
3040            redo A;
3041          }
3042        } elsif ($self->{state} == ENTITY_STATE) {
3043          if ({
3044            0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
3045            0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, &
3046            $self->{entity_additional} => 1,
3047          }->{$self->{next_char}}) {
3048            !!!cp (1001);
3049            ## Don't consume
3050            ## No error
3051            ## Return nothing.
3052            #
3053          } elsif ($self->{next_char} == 0x0023) { # #
3054            !!!cp (999);
3055            $self->{state} = ENTITY_HASH_STATE;
3056            $self->{state_keyword} = '#';
3057            !!!next-input-character;
3058            redo A;
3059          } elsif ((0x0041 <= $self->{next_char} and
3060                    $self->{next_char} <= 0x005A) or # A..Z
3061                   (0x0061 <= $self->{next_char} and
3062                    $self->{next_char} <= 0x007A)) { # a..z
3063            !!!cp (998);
3064            require Whatpm::_NamedEntityList;
3065            $self->{state} = ENTITY_NAME_STATE;
3066            $self->{state_keyword} = chr $self->{next_char};
3067            $self->{entity__value} = $self->{state_keyword};
3068            $self->{entity__match} = 0;
3069            !!!next-input-character;
3070            redo A;
3071          } else {
3072            !!!cp (1027);
3073            !!!parse-error (type => 'bare ero');
3074            ## Return nothing.
3075            #
3076        }        }
3077    
3078        redo A;        ## NOTE: No character is consumed by the "consume a character
3079          ## reference" algorithm.  In other word, there is an "&" character
3080        ## ISSUE: "text tokens" in spec.        ## that does not introduce a character reference, which would be
3081        ## TODO: Streaming support        ## appended to the parent element or the attribute value in later
3082      } else {        ## process of the tokenizer.
3083        die "$0: $self->{state}: Unknown state";  
3084      }        if ($self->{prev_state} == DATA_STATE) {
3085    } # A            !!!cp (997);
3086            $self->{state} = $self->{prev_state};
3087    die "$0: _get_next_token: unexpected case";          ## Reconsume.
3088  } # _get_next_token          !!!emit ({type => CHARACTER_TOKEN, data => '&',
3089                      line => $self->{line_prev},
3090  sub _tokenize_attempt_to_consume_an_entity ($$$) {                    column => $self->{column_prev},
3091    my ($self, $in_attr, $additional) = @_;                   });
3092            redo A;
3093    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        } else {
3094            !!!cp (996);
3095            $self->{current_attribute}->{value} .= '&';
3096            $self->{state} = $self->{prev_state};
3097            ## Reconsume.
3098            redo A;
3099          }
3100        } elsif ($self->{state} == ENTITY_HASH_STATE) {
3101          if ($self->{next_char} == 0x0078 or # x
3102              $self->{next_char} == 0x0058) { # X
3103            !!!cp (995);
3104            $self->{state} = HEXREF_X_STATE;
3105            $self->{state_keyword} .= chr $self->{next_char};
3106            !!!next-input-character;
3107            redo A;
3108          } elsif (0x0030 <= $self->{next_char} and
3109                   $self->{next_char} <= 0x0039) { # 0..9
3110            !!!cp (994);
3111            $self->{state} = NCR_NUM_STATE;
3112            $self->{state_keyword} = $self->{next_char} - 0x0030;
3113            !!!next-input-character;
3114            redo A;
3115          } else {
3116            !!!parse-error (type => 'bare nero',
3117                            line => $self->{line_prev},
3118                            column => $self->{column_prev} - 1);
3119    
3120    if ({          ## NOTE: According to the spec algorithm, nothing is returned,
3121         0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,          ## and then "&#" is appended to the parent element or the attribute
3122         0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR          ## value in the later processing.
3123         $additional => 1,  
3124        }->{$self->{next_char}}) {          if ($self->{prev_state} == DATA_STATE) {
3125      !!!cp (1001);            !!!cp (1019);
3126      ## Don't consume            $self->{state} = $self->{prev_state};
3127      ## No error            ## Reconsume.
3128      return undef;            !!!emit ({type => CHARACTER_TOKEN,
3129    } elsif ($self->{next_char} == 0x0023) { # #                      data => '&#',
3130      !!!next-input-character;                      line => $self->{line_prev},
3131      if ($self->{next_char} == 0x0078 or # x                      column => $self->{column_prev} - 1,
3132          $self->{next_char} == 0x0058) { # X                     });
3133        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;  
3134          } else {          } else {
3135            !!!cp (1007);            !!!cp (993);
3136            !!!parse-error (type => 'no refc', line => $l, column => $c);            $self->{current_attribute}->{value} .= '&#';
3137              $self->{state} = $self->{prev_state};
3138              ## Reconsume.
3139              redo A;
3140          }          }
3141          }
3142          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {      } elsif ($self->{state} == NCR_NUM_STATE) {
3143            !!!cp (1008);        if (0x0030 <= $self->{next_char} and
3144            !!!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  
3145          !!!cp (1012);          !!!cp (1012);
3146          $code *= 10;          $self->{state_keyword} *= 10;
3147          $code += $self->{next_char} - 0x0030;          $self->{state_keyword} += $self->{next_char} - 0x0030;
3148                    
3149            ## Stay in the state.
3150          !!!next-input-character;          !!!next-input-character;
3151        }          redo A;
3152          } elsif ($self->{next_char} == 0x003B) { # ;
       if ($self->{next_char} == 0x003B) { # ;  
3153          !!!cp (1013);          !!!cp (1013);
3154          !!!next-input-character;          !!!next-input-character;
3155            #
3156        } else {        } else {
3157          !!!cp (1014);          !!!cp (1014);
3158          !!!parse-error (type => 'no refc', line => $l, column => $c);          !!!parse-error (type => 'no refc');
3159            ## Reconsume.
3160            #
3161        }        }
3162    
3163          my $code = $self->{state_keyword};
3164          my $l = $self->{line_prev};
3165          my $c = $self->{column_prev};
3166        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3167          !!!cp (1015);          !!!cp (1015);
3168          !!!parse-error (type => 'invalid character reference',          !!!parse-error (type => 'invalid character reference',
# Line 2996  sub _tokenize_attempt_to_consume_an_enti Line 3187  sub _tokenize_attempt_to_consume_an_enti
3187                          line => $l, column => $c);                          line => $l, column => $c);
3188          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3189        }        }
3190          
3191        return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        if ($self->{prev_state} == DATA_STATE) {
3192                line => $l, column => $c,          !!!cp (992);
3193               };          $self->{state} = $self->{prev_state};
3194      } else {          ## Reconsume.
3195        !!!cp (1019);          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3196        !!!parse-error (type => 'bare nero', line => $l, column => $c);                    line => $l, column => $c,
3197        !!!back-next-input-character ($self->{next_char});                   });
3198        $self->{next_char} = 0x0023; # #          redo A;
3199        return undef;        } else {
3200      }          !!!cp (991);
3201    } elsif ((0x0041 <= $self->{next_char} and          $self->{current_attribute}->{value} .= chr $code;
3202              $self->{next_char} <= 0x005A) or          $self->{current_attribute}->{has_reference} = 1;
3203             (0x0061 <= $self->{next_char} and          $self->{state} = $self->{prev_state};
3204              $self->{next_char} <= 0x007A)) {          ## Reconsume.
3205      my $entity_name = chr $self->{next_char};          redo A;
3206      !!!next-input-character;        }
3207        } elsif ($self->{state} == HEXREF_X_STATE) {
3208      my $value = $entity_name;        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3209      my $match = 0;            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3210      require Whatpm::_NamedEntityList;            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3211      our $EntityChar;          # 0..9, A..F, a..f
3212            !!!cp (990);
3213      while (length $entity_name < 30 and          $self->{state} = HEXREF_HEX_STATE;
3214             ## NOTE: Some number greater than the maximum length of entity name          $self->{state_keyword} = 0;
3215             ((0x0041 <= $self->{next_char} and # a          ## Reconsume.
3216               $self->{next_char} <= 0x005A) or # x          redo A;
3217              (0x0061 <= $self->{next_char} and # a        } else {
3218               $self->{next_char} <= 0x007A) or # z          !!!parse-error (type => 'bare hcro',
3219              (0x0030 <= $self->{next_char} and # 0                          line => $self->{line_prev},
3220               $self->{next_char} <= 0x0039) or # 9                          column => $self->{column_prev} - 2);
3221              $self->{next_char} == 0x003B)) { # ;  
3222        $entity_name .= chr $self->{next_char};          ## NOTE: According to the spec algorithm, nothing is returned,
3223        if (defined $EntityChar->{$entity_name}) {          ## and then "&#" followed by "X" or "x" is appended to the parent
3224          if ($self->{next_char} == 0x003B) { # ;          ## element or the attribute value in the later processing.
3225            !!!cp (1020);  
3226            $value = $EntityChar->{$entity_name};          if ($self->{prev_state} == DATA_STATE) {
3227            $match = 1;            !!!cp (1005);
3228            !!!next-input-character;            $self->{state} = $self->{prev_state};
3229            last;            ## Reconsume.
3230              !!!emit ({type => CHARACTER_TOKEN,
3231                        data => '&' . $self->{state_keyword},
3232                        line => $self->{line_prev},
3233                        column => $self->{column_prev} - length $self->{state_keyword},
3234                       });
3235              redo A;
3236          } else {          } else {
3237            !!!cp (1021);            !!!cp (989);
3238            $value = $EntityChar->{$entity_name};            $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3239            $match = -1;            $self->{state} = $self->{prev_state};
3240              ## Reconsume.
3241              redo A;
3242            }
3243          }
3244        } elsif ($self->{state} == HEXREF_HEX_STATE) {
3245          if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) {
3246            # 0..9
3247            !!!cp (1002);
3248            $self->{state_keyword} *= 0x10;
3249            $self->{state_keyword} += $self->{next_char} - 0x0030;
3250            ## Stay in the state.
3251            !!!next-input-character;
3252            redo A;
3253          } elsif (0x0061 <= $self->{next_char} and
3254                   $self->{next_char} <= 0x0066) { # a..f
3255            !!!cp (1003);
3256            $self->{state_keyword} *= 0x10;
3257            $self->{state_keyword} += $self->{next_char} - 0x0060 + 9;
3258            ## Stay in the state.
3259            !!!next-input-character;
3260            redo A;
3261          } elsif (0x0041 <= $self->{next_char} and
3262                   $self->{next_char} <= 0x0046) { # A..F
3263            !!!cp (1004);
3264            $self->{state_keyword} *= 0x10;
3265            $self->{state_keyword} += $self->{next_char} - 0x0040 + 9;
3266            ## Stay in the state.
3267            !!!next-input-character;
3268            redo A;
3269          } elsif ($self->{next_char} == 0x003B) { # ;
3270            !!!cp (1006);
3271            !!!next-input-character;
3272            #
3273          } else {
3274            !!!cp (1007);
3275            !!!parse-error (type => 'no refc',
3276                            line => $self->{line},
3277                            column => $self->{column});
3278            ## Reconsume.
3279            #
3280          }
3281    
3282          my $code = $self->{state_keyword};
3283          my $l = $self->{line_prev};
3284          my $c = $self->{column_prev};
3285          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3286            !!!cp (1008);
3287            !!!parse-error (type => 'invalid character reference',
3288                            text => (sprintf 'U+%04X', $code),
3289                            line => $l, column => $c);
3290            $code = 0xFFFD;
3291          } elsif ($code > 0x10FFFF) {
3292            !!!cp (1009);
3293            !!!parse-error (type => 'invalid character reference',
3294                            text => (sprintf 'U-%08X', $code),
3295                            line => $l, column => $c);
3296            $code = 0xFFFD;
3297          } elsif ($code == 0x000D) {
3298            !!!cp (1010);
3299            !!!parse-error (type => 'CR character reference', line => $l, column => $c);
3300            $code = 0x000A;
3301          } elsif (0x80 <= $code and $code <= 0x9F) {
3302            !!!cp (1011);
3303            !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);
3304            $code = $c1_entity_char->{$code};
3305          }
3306    
3307          if ($self->{prev_state} == DATA_STATE) {
3308            !!!cp (988);
3309            $self->{state} = $self->{prev_state};
3310            ## Reconsume.
3311            !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3312                      line => $l, column => $c,
3313                     });
3314            redo A;
3315          } else {
3316            !!!cp (987);
3317            $self->{current_attribute}->{value} .= chr $code;
3318            $self->{current_attribute}->{has_reference} = 1;
3319            $self->{state} = $self->{prev_state};
3320            ## Reconsume.
3321            redo A;
3322          }
3323        } elsif ($self->{state} == ENTITY_NAME_STATE) {
3324          if (length $self->{state_keyword} < 30 and
3325              ## NOTE: Some number greater than the maximum length of entity name
3326              ((0x0041 <= $self->{next_char} and # a
3327                $self->{next_char} <= 0x005A) or # x
3328               (0x0061 <= $self->{next_char} and # a
3329                $self->{next_char} <= 0x007A) or # z
3330               (0x0030 <= $self->{next_char} and # 0
3331                $self->{next_char} <= 0x0039) or # 9
3332               $self->{next_char} == 0x003B)) { # ;
3333            our $EntityChar;
3334            $self->{state_keyword} .= chr $self->{next_char};
3335            if (defined $EntityChar->{$self->{state_keyword}}) {
3336              if ($self->{next_char} == 0x003B) { # ;
3337                !!!cp (1020);
3338                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3339                $self->{entity__match} = 1;
3340                !!!next-input-character;
3341                #
3342              } else {
3343                !!!cp (1021);
3344                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3345                $self->{entity__match} = -1;
3346                ## Stay in the state.
3347                !!!next-input-character;
3348                redo A;
3349              }
3350            } else {
3351              !!!cp (1022);
3352              $self->{entity__value} .= chr $self->{next_char};
3353              $self->{entity__match} *= 2;
3354              ## Stay in the state.
3355            !!!next-input-character;            !!!next-input-character;
3356              redo A;
3357            }
3358          }
3359    
3360          my $data;
3361          my $has_ref;
3362          if ($self->{entity__match} > 0) {
3363            !!!cp (1023);
3364            $data = $self->{entity__value};
3365            $has_ref = 1;
3366            #
3367          } elsif ($self->{entity__match} < 0) {
3368            !!!parse-error (type => 'no refc');
3369            if ($self->{prev_state} != DATA_STATE and # in attribute
3370                $self->{entity__match} < -1) {
3371              !!!cp (1024);
3372              $data = '&' . $self->{state_keyword};
3373              #
3374            } else {
3375              !!!cp (1025);
3376              $data = $self->{entity__value};
3377              $has_ref = 1;
3378              #
3379          }          }
3380        } else {        } else {
3381          !!!cp (1022);          !!!cp (1026);
3382          $value .= chr $self->{next_char};          !!!parse-error (type => 'bare ero',
3383          $match *= 2;                          line => $self->{line_prev},
3384          !!!next-input-character;                          column => $self->{column_prev} - length $self->{state_keyword});
3385            $data = '&' . $self->{state_keyword};
3386            #
3387        }        }
3388      }    
3389              ## NOTE: In these cases, when a character reference is found,
3390      if ($match > 0) {        ## it is consumed and a character token is returned, or, otherwise,
3391        !!!cp (1023);        ## nothing is consumed and returned, according to the spec algorithm.
3392        return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        ## In this implementation, anything that has been examined by the
3393                line => $l, column => $c,        ## tokenizer is appended to the parent element or the attribute value
3394               };        ## as string, either literal string when no character reference or
3395      } elsif ($match < 0) {        ## entity-replaced string otherwise, in this stage, since any characters
3396        !!!parse-error (type => 'no refc', line => $l, column => $c);        ## that would not be consumed are appended in the data state or in an
3397        if ($in_attr and $match < -1) {        ## appropriate attribute value state anyway.
3398          !!!cp (1024);  
3399          return {type => CHARACTER_TOKEN, data => '&'.$entity_name,        if ($self->{prev_state} == DATA_STATE) {
3400                  line => $l, column => $c,          !!!cp (986);
3401                 };          $self->{state} = $self->{prev_state};
3402        } else {          ## Reconsume.
3403          !!!cp (1025);          !!!emit ({type => CHARACTER_TOKEN,
3404          return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,                    data => $data,
3405                  line => $l, column => $c,                    line => $self->{line_prev},
3406                 };                    column => $self->{column_prev} + 1 - length $self->{state_keyword},
3407                     });
3408            redo A;
3409          } else {
3410            !!!cp (985);
3411            $self->{current_attribute}->{value} .= $data;
3412            $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3413            $self->{state} = $self->{prev_state};
3414            ## Reconsume.
3415            redo A;
3416        }        }
3417      } else {      } else {
3418        !!!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,  
              };  
3419      }      }
3420    } else {    } # A  
3421      !!!cp (1027);  
3422      ## no characters are consumed    die "$0: _get_next_token: unexpected case";
3423      !!!parse-error (type => 'bare ero', line => $l, column => $c);  } # _get_next_token
     return undef;  
   }  
 } # _tokenize_attempt_to_consume_an_entity  
3424    
3425  sub _initialize_tree_constructor ($) {  sub _initialize_tree_constructor ($) {
3426    my $self = shift;    my $self = shift;
# Line 3091  sub _initialize_tree_constructor ($) { Line 3429  sub _initialize_tree_constructor ($) {
3429    ## TODO: Turn mutation events off # MUST    ## TODO: Turn mutation events off # MUST
3430    ## TODO: Turn loose Document option (manakai extension) on    ## TODO: Turn loose Document option (manakai extension) on
3431    $self->{document}->manakai_is_html (1); # MUST    $self->{document}->manakai_is_html (1); # MUST
3432      $self->{document}->set_user_data (manakai_source_line => 1);
3433      $self->{document}->set_user_data (manakai_source_column => 1);
3434  } # _initialize_tree_constructor  } # _initialize_tree_constructor
3435    
3436  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 3145  sub _tree_construction_initial ($) { Line 3485  sub _tree_construction_initial ($) {
3485        ## language.        ## language.
3486        my $doctype_name = $token->{name};        my $doctype_name = $token->{name};
3487        $doctype_name = '' unless defined $doctype_name;        $doctype_name = '' unless defined $doctype_name;
3488        $doctype_name =~ tr/a-z/A-Z/;        $doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive
3489        if (not defined $token->{name} or # <!DOCTYPE>        if (not defined $token->{name} or # <!DOCTYPE>
           defined $token->{public_identifier} or  
3490            defined $token->{system_identifier}) {            defined $token->{system_identifier}) {
3491          !!!cp ('t1');          !!!cp ('t1');
3492          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3493        } elsif ($doctype_name ne 'HTML') {        } elsif ($doctype_name ne 'HTML') {
3494          !!!cp ('t2');          !!!cp ('t2');
         ## ISSUE: ASCII case-insensitive? (in fact it does not matter)  
3495          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3496          } elsif (defined $token->{public_identifier}) {
3497            if ($token->{public_identifier} eq 'XSLT-compat') {
3498              !!!cp ('t1.2');
3499              !!!parse-error (type => 'XSLT-compat', token => $token,
3500                              level => $self->{level}->{should});
3501            } else {
3502              !!!parse-error (type => 'not HTML5', token => $token);
3503            }
3504        } else {        } else {
3505          !!!cp ('t3');          !!!cp ('t3');
3506            #
3507        }        }
3508                
3509        my $doctype = $self->{document}->create_document_type_definition        my $doctype = $self->{document}->create_document_type_definition
# Line 4172  sub _tree_construction_main ($) { Line 4519  sub _tree_construction_main ($) {
4519            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4520              !!!cp ('t88.2');              !!!cp ('t88.2');
4521              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4522                #
4523            } else {            } else {
4524              !!!cp ('t88.1');              !!!cp ('t88.1');
4525              ## Ignore the token.              ## Ignore the token.
4526              !!!next-token;              #
             next B;  
4527            }            }
4528            unless (length $token->{data}) {            unless (length $token->{data}) {
4529              !!!cp ('t88');              !!!cp ('t88');
4530              !!!next-token;              !!!next-token;
4531              next B;              next B;
4532            }            }
4533    ## TODO: set $token->{column} appropriately
4534          }          }
4535    
4536          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {
# Line 6292  sub _tree_construction_main ($) { Line 6640  sub _tree_construction_main ($) {
6640            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6641              !!!cp ('t312');              !!!cp ('t312');
6642              !!!parse-error (type => 'after frameset:#text', token => $token);              !!!parse-error (type => 'after frameset:#text', token => $token);
6643            } else { # "after html frameset"            } else { # "after after frameset"
6644              !!!cp ('t313');              !!!cp ('t313');
6645              !!!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);  
6646            }            }
6647                        
6648            ## Ignore the token.            ## Ignore the token.
# Line 6314  sub _tree_construction_main ($) { Line 6658  sub _tree_construction_main ($) {
6658                    
6659          die qq[$0: Character "$token->{data}"];          die qq[$0: Character "$token->{data}"];
6660        } 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');  
         }  
   
6661          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6662              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6663            !!!cp ('t318');            !!!cp ('t318');
# Line 6345  sub _tree_construction_main ($) { Line 6678  sub _tree_construction_main ($) {
6678            ## NOTE: As if in head.            ## NOTE: As if in head.
6679            $parse_rcdata->(CDATA_CONTENT_MODEL);            $parse_rcdata->(CDATA_CONTENT_MODEL);
6680            next B;            next B;
6681    
6682              ## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>|
6683              ## has no parse error.
6684          } else {          } else {
6685            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6686              !!!cp ('t321');              !!!cp ('t321');
6687              !!!parse-error (type => 'in frameset',              !!!parse-error (type => 'in frameset',
6688                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6689            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6690              !!!cp ('t322');              !!!cp ('t322');
6691              !!!parse-error (type => 'after frameset',              !!!parse-error (type => 'after frameset',
6692                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6693              } else { # "after after frameset"
6694                !!!cp ('t322.2');
6695                !!!parse-error (type => 'after after frameset',
6696                                text => $token->{tag_name}, token => $token);
6697            }            }
6698            ## Ignore the token            ## Ignore the token
6699            !!!nack ('t322.1');            !!!nack ('t322.1');
# Line 6361  sub _tree_construction_main ($) { Line 6701  sub _tree_construction_main ($) {
6701            next B;            next B;
6702          }          }
6703        } 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');  
         }  
   
6704          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6705              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6706            if ($self->{open_elements}->[-1]->[1] & HTML_EL and            if ($self->{open_elements}->[-1]->[1] & HTML_EL and
# Line 6406  sub _tree_construction_main ($) { Line 6735  sub _tree_construction_main ($) {
6735              !!!cp ('t330');              !!!cp ('t330');
6736              !!!parse-error (type => 'in frameset:/',              !!!parse-error (type => 'in frameset:/',
6737                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6738            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6739              !!!cp ('t331');              !!!cp ('t330.1');
6740              !!!parse-error (type => 'after frameset:/',              !!!parse-error (type => 'after frameset:/',
6741                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6742              } else { # "after after html"
6743                !!!cp ('t331');
6744                !!!parse-error (type => 'after after frameset:/',
6745                                text => $token->{tag_name}, token => $token);
6746            }            }
6747            ## Ignore the token            ## Ignore the token
6748            !!!next-token;            !!!next-token;
# Line 6946  sub _tree_construction_main ($) { Line 7279  sub _tree_construction_main ($) {
7279                 $token->{tag_name} eq 'svg') {                 $token->{tag_name} eq 'svg') {
7280          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
7281    
7282            ## "Adjust MathML attributes" ('math' only) - done in insert-element-f
7283    
7284          ## "adjust SVG attributes" ('svg' only) - done in insert-element-f          ## "adjust SVG attributes" ('svg' only) - done in insert-element-f
7285    
7286          ## "adjust foreign attributes" - done in insert-element-f          ## "adjust foreign attributes" - done in insert-element-f
# Line 7130  sub _tree_construction_main ($) { Line 7465  sub _tree_construction_main ($) {
7465            !!!cp ('t413');            !!!cp ('t413');
7466            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7467                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7468              ## NOTE: Ignore the token.
7469          } else {          } else {
7470            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7471            while ({            while ({
# Line 7189  sub _tree_construction_main ($) { Line 7525  sub _tree_construction_main ($) {
7525            !!!cp ('t421');            !!!cp ('t421');
7526            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7527                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7528              ## NOTE: Ignore the token.
7529          } else {          } else {
7530            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7531            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7235  sub _tree_construction_main ($) { Line 7572  sub _tree_construction_main ($) {
7572            !!!cp ('t425.1');            !!!cp ('t425.1');
7573            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7574                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7575              ## NOTE: Ignore the token.
7576          } else {          } else {
7577            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7578            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7437  sub _tree_construction_main ($) { Line 7775  sub _tree_construction_main ($) {
7775    ## TODO: script stuffs    ## TODO: script stuffs
7776  } # _tree_construct_main  } # _tree_construct_main
7777    
7778  sub set_inner_html ($$$) {  sub set_inner_html ($$$$;$) {
7779    my $class = shift;    my $class = shift;
7780    my $node = shift;    my $node = shift;
7781    my $s = \$_[0];    #my $s = \$_[0];
7782    my $onerror = $_[1];    my $onerror = $_[1];
7783      my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7784    
7785    ## ISSUE: Should {confident} be true?    ## ISSUE: Should {confident} be true?
7786    
# Line 7460  sub set_inner_html ($$$) { Line 7799  sub set_inner_html ($$$) {
7799      }      }
7800    
7801      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7802      $class->parse_string ($$s => $node, $onerror);      $class->parse_char_string ($_[0] => $node, $onerror, $get_wrapper);
7803    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7804      ## TODO: If non-html element      ## TODO: If non-html element
7805    
7806      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
7807    
7808    ## TODO: Support for $get_wrapper
7809    
7810      ## Step 1 # MUST      ## Step 1 # MUST
7811      my $this_doc = $node->owner_document;      my $this_doc = $node->owner_document;
7812      my $doc = $this_doc->implementation->create_document;      my $doc = $this_doc->implementation->create_document;
# Line 7477  sub set_inner_html ($$$) { Line 7818  sub set_inner_html ($$$) {
7818      my $i = 0;      my $i = 0;
7819      $p->{line_prev} = $p->{line} = 1;      $p->{line_prev} = $p->{line} = 1;
7820      $p->{column_prev} = $p->{column} = 0;      $p->{column_prev} = $p->{column} = 0;
7821        require Whatpm::Charset::DecodeHandle;
7822        my $input = Whatpm::Charset::DecodeHandle::CharString->new (\($_[0]));
7823        $input = $get_wrapper->($input);
7824      $p->{set_next_char} = sub {      $p->{set_next_char} = sub {
7825        my $self = shift;        my $self = shift;
7826    
7827        pop @{$self->{prev_char}};        my $char = '';
7828        unshift @{$self->{prev_char}}, $self->{next_char};        if (defined $self->{next_next_char}) {
7829            $char = $self->{next_next_char};
7830        $self->{next_char} = -1 and return if $i >= length $$s;          delete $self->{next_next_char};
7831        $self->{next_char} = ord substr $$s, $i++, 1;          $self->{next_char} = ord $char;
7832          } else {
7833            $self->{char_buffer} = '';
7834            $self->{char_buffer_pos} = 0;
7835            
7836            my $count = $input->manakai_read_until
7837                ($self->{char_buffer},
7838                 qr/(?![\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
7839                   $self->{char_buffer_pos});
7840            if ($count) {
7841              $self->{line_prev} = $self->{line};
7842              $self->{column_prev} = $self->{column};
7843              $self->{column}++;
7844              $self->{next_char}
7845                  = ord substr ($self->{char_buffer},
7846                                $self->{char_buffer_pos}++, 1);
7847              return;
7848            }
7849            
7850            if ($input->read ($char, 1)) {
7851              $self->{next_char} = ord $char;
7852            } else {
7853              $self->{next_char} = -1;
7854              return;
7855            }
7856          }
7857    
7858        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});
7859        $p->{column}++;        $p->{column}++;
# Line 7494  sub set_inner_html ($$$) { Line 7863  sub set_inner_html ($$$) {
7863          $p->{column} = 0;          $p->{column} = 0;
7864          !!!cp ('i1');          !!!cp ('i1');
7865        } elsif ($self->{next_char} == 0x000D) { # CR        } elsif ($self->{next_char} == 0x000D) { # CR
7866          $i++ if substr ($$s, $i, 1) eq "\x0A";  ## TODO: support for abort/streaming
7867            my $next = '';
7868            if ($input->read ($next, 1) and $next ne "\x0A") {
7869              $self->{next_next_char} = $next;
7870            }
7871          $self->{next_char} = 0x000A; # LF # MUST          $self->{next_char} = 0x000A; # LF # MUST
7872          $p->{line}++;          $p->{line}++;
7873          $p->{column} = 0;          $p->{column} = 0;
# Line 7536  sub set_inner_html ($$$) { Line 7909  sub set_inner_html ($$$) {
7909          }          }
7910        }        }
7911      };      };
7912      $p->{prev_char} = [-1, -1, -1];  
7913      $p->{next_char} = -1;      $p->{read_until} = sub {
7914              #my ($scalar, $specials_range, $offset) = @_;
7915          return 0 if defined $p->{next_next_char};
7916    
7917          my $pattern = qr/(?![$_[1]\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/;
7918          my $offset = $_[2] || 0;
7919          
7920          if ($p->{char_buffer_pos} < length $p->{char_buffer}) {
7921            pos ($p->{char_buffer}) = $p->{char_buffer_pos};
7922            if ($p->{char_buffer} =~ /\G(?>$pattern)+/) {
7923              substr ($_[0], $offset)
7924                  = substr ($p->{char_buffer}, $-[0], $+[0] - $-[0]);
7925              my $count = $+[0] - $-[0];
7926              if ($count) {
7927                $p->{column} += $count;
7928                $p->{char_buffer_pos} += $count;
7929                $p->{line_prev} = $p->{line};
7930                $p->{column_prev} = $p->{column} - 1;
7931                $p->{prev_char} = [-1, -1, -1];
7932                $p->{next_char} = -1;
7933              }
7934              return $count;
7935            } else {
7936              return 0;
7937            }
7938          } else {
7939            my $count = $input->manakai_read_until ($_[0], $pattern, $_[2]);
7940            if ($count) {
7941              $p->{column} += $count;
7942              $p->{column_prev} += $count;
7943              $p->{prev_char} = [-1, -1, -1];
7944              $p->{next_char} = -1;
7945            }
7946            return $count;
7947          }
7948        }; # $p->{read_until}
7949    
7950      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7951        my (%opt) = @_;        my (%opt) = @_;
7952        my $line = $opt{line};        my $line = $opt{line};
# Line 7553  sub set_inner_html ($$$) { Line 7961  sub set_inner_html ($$$) {
7961        $ponerror->(line => $p->{line}, column => $p->{column}, @_);        $ponerror->(line => $p->{line}, column => $p->{column}, @_);
7962      };      };
7963            
7964        my $char_onerror = sub {
7965          my (undef, $type, %opt) = @_;
7966          $ponerror->(layer => 'encode',
7967                      line => $p->{line}, column => $p->{column} + 1,
7968                      %opt, type => $type);
7969        }; # $char_onerror
7970        $input->onerror ($char_onerror);
7971    
7972      $p->_initialize_tokenizer;      $p->_initialize_tokenizer;
7973      $p->_initialize_tree_constructor;      $p->_initialize_tree_constructor;
7974    

Legend:
Removed from v.1.153  
changed lines
  Added in v.1.180

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24