/[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.158 by wakaba, Sun Aug 31 12:11:42 2008 UTC revision 1.171 by wakaba, Sun Sep 14 01:51:08 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 551  sub parse_byte_stream ($$$$;$) { Line 567  sub parse_byte_stream ($$$$;$) {
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 641  sub parse_char_stream ($$$;$) { Line 669  sub parse_char_stream ($$$;$) {
669        $self->{column} = 0;        $self->{column} = 0;
670      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
671        !!!cp ('j2');        !!!cp ('j2');
672    ## TODO: support for abort/streaming
673        my $next = $input->getc;        my $next = $input->getc;
674        if (defined $next and $next ne "\x0A") {        if (defined $next and $next ne "\x0A") {
675          $self->{next_next_char} = $next;          $self->{next_next_char} = $next;
# Line 660  sub parse_char_stream ($$$;$) { Line 689  sub parse_char_stream ($$$;$) {
689               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or
690               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or
691               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or
692    ## ISSUE: U+FDE0-U+FDEF are not excluded
693               {               {
694                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,
695                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
# Line 684  sub parse_char_stream ($$$;$) { Line 714  sub parse_char_stream ($$$;$) {
714    $self->{prev_char} = [-1, -1, -1];    $self->{prev_char} = [-1, -1, -1];
715    $self->{next_char} = -1;    $self->{next_char} = -1;
716    
717      $self->{getc_until} = sub { return undef };
718    #  if ($input->can ('manakai_getc_until')) {
719        $self->{getc_until} = sub {
720          my $special_range = shift;
721          return undef if defined $self->{next_next_char};
722          my $s = $input->manakai_getc_until
723              (qr/(?![$special_range\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}]/);
724          if ($s) {
725            $self->{column} += length $$s;
726            $self->{column_prev} += length $$s;
727            $self->{prev_char} = [-1, -1, -1];
728            $self->{next_char} = -1;
729          }
730          return $s;
731        }; # $self->{getc_until}
732    #  } else {
733    #    $self->{getc_until} = sub {
734    #      my $special_range = shift;
735    #      return undef if defined $self->{next_next_char};
736    #      my $c = $input->getc;
737    #      if ($c =~ /^(?![$special_range\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}]/) {
738    #        $self->{column}++;
739    #        $self->{column_prev}++;
740    #        $self->{prev_char} = [-1, -1, -1];
741    #        $self->{next_char} = -1;
742    #        return \$c;
743    #      } elsif (defined $c) {
744    #        #$input->ungetc (ord $c);
745    #        $self->{next_next_char} = $c;
746    #        return undef;
747    #      } else {
748    #        return undef;
749    #      }
750    #    }; # $self->{getc_until}
751    #  }
752    
753    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
754      my (%opt) = @_;      my (%opt) = @_;
755      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};
# Line 708  sub new ($) { Line 774  sub new ($) {
774    my $class = shift;    my $class = shift;
775    my $self = bless {    my $self = bless {
776      level => {must => 'm',      level => {must => 'm',
777                  should => 's',
778                warn => 'w',                warn => 'w',
779                info => 'i',                info => 'i',
780                uncertain => 'u'},                uncertain => 'u'},
# Line 740  sub RCDATA_CONTENT_MODEL () { CM_ENTITY Line 807  sub RCDATA_CONTENT_MODEL () { CM_ENTITY
807  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
808    
809  sub DATA_STATE () { 0 }  sub DATA_STATE () { 0 }
810  sub ENTITY_DATA_STATE () { 1 }  #sub ENTITY_DATA_STATE () { 1 }
811  sub TAG_OPEN_STATE () { 2 }  sub TAG_OPEN_STATE () { 2 }
812  sub CLOSE_TAG_OPEN_STATE () { 3 }  sub CLOSE_TAG_OPEN_STATE () { 3 }
813  sub TAG_NAME_STATE () { 4 }  sub TAG_NAME_STATE () { 4 }
# Line 751  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 Line 818  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8
818  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
819  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
820  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
821  sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }  #sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
822  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
823  sub COMMENT_START_STATE () { 14 }  sub COMMENT_START_STATE () { 14 }
824  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
# Line 774  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT Line 841  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT
841  sub BOGUS_DOCTYPE_STATE () { 32 }  sub BOGUS_DOCTYPE_STATE () { 32 }
842  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }
843  sub SELF_CLOSING_START_TAG_STATE () { 34 }  sub SELF_CLOSING_START_TAG_STATE () { 34 }
844  sub CDATA_BLOCK_STATE () { 35 }  sub CDATA_SECTION_STATE () { 35 }
845    sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec
846    sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec
847    sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec
848    sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec
849    sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec
850    sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
851    sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec
852    sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec
853    ## NOTE: "Entity data state", "entity in attribute value state", and
854    ## "consume a character reference" algorithm are jointly implemented
855    ## using the following six states:
856    sub ENTITY_STATE () { 44 }
857    sub ENTITY_HASH_STATE () { 45 }
858    sub NCR_NUM_STATE () { 46 }
859    sub HEXREF_X_STATE () { 47 }
860    sub HEXREF_HEX_STATE () { 48 }
861    sub ENTITY_NAME_STATE () { 49 }
862    
863  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
864  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 827  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 911  sub IN_COLUMN_GROUP_IM () { 0b10 }
911  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
912    my $self = shift;    my $self = shift;
913    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
914      #$self->{state_keyword}; # initialized when used
915      #$self->{entity__value}; # initialized when used
916      #$self->{entity__match}; # initialized when used
917    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
918    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
919    undef $self->{current_attribute};    undef $self->{current_attribute};
920    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
921    undef $self->{last_attribute_value_state};    #$self->{prev_state}; # initialized when used
922    delete $self->{self_closing};    delete $self->{self_closing};
   $self->{char} = [];  
923    # $self->{next_char}    # $self->{next_char}
924    !!!next-input-character;    !!!next-input-character;
925    $self->{token} = [];    $self->{token} = [];
# Line 865  sub _initialize_tokenizer ($) { Line 951  sub _initialize_tokenizer ($) {
951  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
952  ## and removed from the list.  ## and removed from the list.
953    
954  ## NOTE: HTML5 "Writing HTML documents" section, applied to  ## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.)
955  ## 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,  
956    
957  sub _get_next_token ($) {  sub _get_next_token ($) {
958    my $self = shift;    my $self = shift;
# Line 902  sub _get_next_token ($) { Line 976  sub _get_next_token ($) {
976          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA
977              not $self->{escape}) {              not $self->{escape}) {
978            !!!cp (1);            !!!cp (1);
979            $self->{state} = ENTITY_DATA_STATE;            ## NOTE: In the spec, the tokenizer is switched to the
980              ## "entity data state".  In this implementation, the tokenizer
981              ## is switched to the |ENTITY_STATE|, which is an implementation
982              ## of the "consume a character reference" algorithm.
983              $self->{entity_additional} = -1;
984              $self->{prev_state} = DATA_STATE;
985              $self->{state} = ENTITY_STATE;
986            !!!next-input-character;            !!!next-input-character;
987            redo A;            redo A;
988          } else {          } else {
# Line 966  sub _get_next_token ($) { Line 1046  sub _get_next_token ($) {
1046                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1047                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1048                    };                    };
1049    
1050          my $s = $self->{getc_until}->(q[-!<>&]);
1051          if ($s) {
1052            $token->{data} .= $$s;
1053          }
1054    
1055        ## Stay in the data state        ## Stay in the data state
1056        !!!next-input-character;        !!!next-input-character;
1057    
1058        !!!emit ($token);        !!!emit ($token);
1059    
1060        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;  
1061      } elsif ($self->{state} == TAG_OPEN_STATE) {      } elsif ($self->{state} == TAG_OPEN_STATE) {
1062        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1063          if ($self->{next_char} == 0x002F) { # /          if ($self->{next_char} == 0x002F) { # /
# Line 1089  sub _get_next_token ($) { Line 1154  sub _get_next_token ($) {
1154          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1155        }        }
1156      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1157          ## NOTE: The "close tag open state" in the spec is implemented as
1158          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1159    
1160        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1161        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1162          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1163              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1164            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1165            my @next_char;            ## Reconsume.
1166            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...  
           }  
1167          } else {          } else {
1168            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1169              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1170            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1171            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1172              ## Reconsume.
1173            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1174                      line => $l, column => $c,                      line => $l, column => $c,
1175                     });                     });
1176            redo A;            redo A;
1177          }          }
1178        }        }
1179          
1180        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1181            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1182          !!!cp (29);          !!!cp (29);
# Line 1198  sub _get_next_token ($) { Line 1223  sub _get_next_token ($) {
1223                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1224                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1225                                   };                                   };
1226          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1227          redo A;          ## Although the "anything else" case of the spec not explicitly
1228            ## states that the next input character is to be reconsumed,
1229            ## it will be included to the |data| of the comment token
1230            ## generated from the bogus end tag, as defined in the
1231            ## "bogus comment state" entry.
1232            redo A;
1233          }
1234        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1235          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1236          if (length $ch) {
1237            my $CH = $ch;
1238            $ch =~ tr/a-z/A-Z/;
1239            my $nch = chr $self->{next_char};
1240            if ($nch eq $ch or $nch eq $CH) {
1241              !!!cp (24);
1242              ## Stay in the state.
1243              $self->{state_keyword} .= $nch;
1244              !!!next-input-character;
1245              redo A;
1246            } else {
1247              !!!cp (25);
1248              $self->{state} = DATA_STATE;
1249              ## Reconsume.
1250              !!!emit ({type => CHARACTER_TOKEN,
1251                        data => '</' . $self->{state_keyword},
1252                        line => $self->{line_prev},
1253                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1254                       });
1255              redo A;
1256            }
1257          } else { # after "<{tag-name}"
1258            unless ({
1259                     0x0009 => 1, # HT
1260                     0x000A => 1, # LF
1261                     0x000B => 1, # VT
1262                     0x000C => 1, # FF
1263                     0x0020 => 1, # SP
1264                     0x003E => 1, # >
1265                     0x002F => 1, # /
1266                     -1 => 1, # EOF
1267                    }->{$self->{next_char}}) {
1268              !!!cp (26);
1269              ## Reconsume.
1270              $self->{state} = DATA_STATE;
1271              !!!emit ({type => CHARACTER_TOKEN,
1272                        data => '</' . $self->{state_keyword},
1273                        line => $self->{line_prev},
1274                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1275                       });
1276              redo A;
1277            } else {
1278              !!!cp (27);
1279              $self->{current_token}
1280                  = {type => END_TAG_TOKEN,
1281                     tag_name => $self->{last_emitted_start_tag_name},
1282                     line => $self->{line_prev},
1283                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1284              $self->{state} = TAG_NAME_STATE;
1285              ## Reconsume.
1286              redo A;
1287            }
1288        }        }
1289      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1290        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1646  sub _get_next_token ($) { Line 1731  sub _get_next_token ($) {
1731          redo A;          redo A;
1732        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1733          !!!cp (96);          !!!cp (96);
1734          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1735          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1736            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1737            ## implementation of the "consume a character reference" algorithm.
1738            $self->{prev_state} = $self->{state};
1739            $self->{entity_additional} = 0x0022; # "
1740            $self->{state} = ENTITY_STATE;
1741          !!!next-input-character;          !!!next-input-character;
1742          redo A;          redo A;
1743        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1688  sub _get_next_token ($) { Line 1778  sub _get_next_token ($) {
1778          redo A;          redo A;
1779        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1780          !!!cp (102);          !!!cp (102);
1781          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1782          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1783            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1784            ## implementation of the "consume a character reference" algorithm.
1785            $self->{entity_additional} = 0x0027; # '
1786            $self->{prev_state} = $self->{state};
1787            $self->{state} = ENTITY_STATE;
1788          !!!next-input-character;          !!!next-input-character;
1789          redo A;          redo A;
1790        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1734  sub _get_next_token ($) { Line 1829  sub _get_next_token ($) {
1829          redo A;          redo A;
1830        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1831          !!!cp (108);          !!!cp (108);
1832          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1833          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1834            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1835            ## implementation of the "consume a character reference" algorithm.
1836            $self->{entity_additional} = -1;
1837            $self->{prev_state} = $self->{state};
1838            $self->{state} = ENTITY_STATE;
1839          !!!next-input-character;          !!!next-input-character;
1840          redo A;          redo A;
1841        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
# Line 1799  sub _get_next_token ($) { Line 1899  sub _get_next_token ($) {
1899          !!!next-input-character;          !!!next-input-character;
1900          redo A;          redo A;
1901        }        }
     } 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;  
1902      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {
1903        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
1904            $self->{next_char} == 0x000A or # LF            $self->{next_char} == 0x000A or # LF
# Line 1940  sub _get_next_token ($) { Line 2018  sub _get_next_token ($) {
2018        }        }
2019      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
2020        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
         
       ## NOTE: Set by the previous state  
       #my $token = {type => COMMENT_TOKEN, data => ''};  
2021    
2022        BC: {        ## NOTE: Unlike spec's "bogus comment state", this implementation
2023          if ($self->{next_char} == 0x003E) { # >        ## consumes characters one-by-one basis.
2024            !!!cp (124);        
2025            $self->{state} = DATA_STATE;        if ($self->{next_char} == 0x003E) { # >
2026            !!!next-input-character;          !!!cp (124);
2027            $self->{state} = DATA_STATE;
2028            !!!emit ($self->{current_token}); # comment          !!!next-input-character;
   
           redo A;  
         } elsif ($self->{next_char} == -1) {  
           !!!cp (125);  
           $self->{state} = DATA_STATE;  
           ## reconsume  
   
           !!!emit ($self->{current_token}); # comment  
2029    
2030            redo A;          !!!emit ($self->{current_token}); # comment
2031          } else {          redo A;
2032            !!!cp (126);        } elsif ($self->{next_char} == -1) {
2033            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          !!!cp (125);
2034            !!!next-input-character;          $self->{state} = DATA_STATE;
2035            redo BC;          ## reconsume
         }  
       } # BC  
2036    
2037        die "$0: _get_next_token: unexpected case [BC]";          !!!emit ($self->{current_token}); # comment
2038            redo A;
2039          } else {
2040            !!!cp (126);
2041            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2042            ## Stay in the state.
2043            !!!next-input-character;
2044            redo A;
2045          }
2046      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2047        ## (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};  
2048                
2049        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2050            !!!cp (133);
2051            $self->{state} = MD_HYPHEN_STATE;
2052          !!!next-input-character;          !!!next-input-character;
2053          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);  
         }  
2054        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2055                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2056            ## ASCII case-insensitive.
2057            !!!cp (130);
2058            $self->{state} = MD_DOCTYPE_STATE;
2059            $self->{state_keyword} = chr $self->{next_char};
2060          !!!next-input-character;          !!!next-input-character;
2061          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);  
         }  
2062        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2063                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2064                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2065            !!!cp (135.4);                
2066            $self->{state} = MD_CDATA_STATE;
2067            $self->{state_keyword} = '[';
2068          !!!next-input-character;          !!!next-input-character;
2069          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);  
         }  
2070        } else {        } else {
2071          !!!cp (136);          !!!cp (136);
2072        }        }
2073    
2074        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2075        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2076        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2077          ## Reconsume.
2078        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2079        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2080                                  line => $l, column => $c,                                  line => $self->{line_prev},
2081                                    column => $self->{column_prev} - 1,
2082                                 };                                 };
2083        redo A;        redo A;
2084              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2085        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2086        ## 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);
2087            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2088                                      line => $self->{line_prev},
2089                                      column => $self->{column_prev} - 2,
2090                                     };
2091            $self->{state} = COMMENT_START_STATE;
2092            !!!next-input-character;
2093            redo A;
2094          } else {
2095            !!!cp (128);
2096            !!!parse-error (type => 'bogus comment',
2097                            line => $self->{line_prev},
2098                            column => $self->{column_prev} - 2);
2099            $self->{state} = BOGUS_COMMENT_STATE;
2100            ## Reconsume.
2101            $self->{current_token} = {type => COMMENT_TOKEN,
2102                                      data => '-',
2103                                      line => $self->{line_prev},
2104                                      column => $self->{column_prev} - 2,
2105                                     };
2106            redo A;
2107          }
2108        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2109          ## ASCII case-insensitive.
2110          if ($self->{next_char} == [
2111                undef,
2112                0x004F, # O
2113                0x0043, # C
2114                0x0054, # T
2115                0x0059, # Y
2116                0x0050, # P
2117              ]->[length $self->{state_keyword}] or
2118              $self->{next_char} == [
2119                undef,
2120                0x006F, # o
2121                0x0063, # c
2122                0x0074, # t
2123                0x0079, # y
2124                0x0070, # p
2125              ]->[length $self->{state_keyword}]) {
2126            !!!cp (131);
2127            ## Stay in the state.
2128            $self->{state_keyword} .= chr $self->{next_char};
2129            !!!next-input-character;
2130            redo A;
2131          } elsif ((length $self->{state_keyword}) == 6 and
2132                   ($self->{next_char} == 0x0045 or # E
2133                    $self->{next_char} == 0x0065)) { # e
2134            !!!cp (129);
2135            $self->{state} = DOCTYPE_STATE;
2136            $self->{current_token} = {type => DOCTYPE_TOKEN,
2137                                      quirks => 1,
2138                                      line => $self->{line_prev},
2139                                      column => $self->{column_prev} - 7,
2140                                     };
2141            !!!next-input-character;
2142            redo A;
2143          } else {
2144            !!!cp (132);        
2145            !!!parse-error (type => 'bogus comment',
2146                            line => $self->{line_prev},
2147                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2148            $self->{state} = BOGUS_COMMENT_STATE;
2149            ## Reconsume.
2150            $self->{current_token} = {type => COMMENT_TOKEN,
2151                                      data => $self->{state_keyword},
2152                                      line => $self->{line_prev},
2153                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2154                                     };
2155            redo A;
2156          }
2157        } elsif ($self->{state} == MD_CDATA_STATE) {
2158          if ($self->{next_char} == {
2159                '[' => 0x0043, # C
2160                '[C' => 0x0044, # D
2161                '[CD' => 0x0041, # A
2162                '[CDA' => 0x0054, # T
2163                '[CDAT' => 0x0041, # A
2164              }->{$self->{state_keyword}}) {
2165            !!!cp (135.1);
2166            ## Stay in the state.
2167            $self->{state_keyword} .= chr $self->{next_char};
2168            !!!next-input-character;
2169            redo A;
2170          } elsif ($self->{state_keyword} eq '[CDATA' and
2171                   $self->{next_char} == 0x005B) { # [
2172            !!!cp (135.2);
2173            $self->{current_token} = {type => CHARACTER_TOKEN,
2174                                      data => '',
2175                                      line => $self->{line_prev},
2176                                      column => $self->{column_prev} - 7};
2177            $self->{state} = CDATA_SECTION_STATE;
2178            !!!next-input-character;
2179            redo A;
2180          } else {
2181            !!!cp (135.3);
2182            !!!parse-error (type => 'bogus comment',
2183                            line => $self->{line_prev},
2184                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2185            $self->{state} = BOGUS_COMMENT_STATE;
2186            ## Reconsume.
2187            $self->{current_token} = {type => COMMENT_TOKEN,
2188                                      data => $self->{state_keyword},
2189                                      line => $self->{line_prev},
2190                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2191                                     };
2192            redo A;
2193          }
2194      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2195        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2196          !!!cp (137);          !!!cp (137);
# Line 2369  sub _get_next_token ($) { Line 2457  sub _get_next_token ($) {
2457          redo A;          redo A;
2458        } elsif ($self->{next_char} == 0x0050 or # P        } elsif ($self->{next_char} == 0x0050 or # P
2459                 $self->{next_char} == 0x0070) { # p                 $self->{next_char} == 0x0070) { # p
2460            $self->{state} = PUBLIC_STATE;
2461            $self->{state_keyword} = chr $self->{next_char};
2462          !!!next-input-character;          !!!next-input-character;
2463          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);  
         }  
   
         #  
2464        } elsif ($self->{next_char} == 0x0053 or # S        } elsif ($self->{next_char} == 0x0053 or # S
2465                 $self->{next_char} == 0x0073) { # s                 $self->{next_char} == 0x0073) { # s
2466            $self->{state} = SYSTEM_STATE;
2467            $self->{state_keyword} = chr $self->{next_char};
2468          !!!next-input-character;          !!!next-input-character;
2469          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);  
         }  
   
         #  
2470        } else {        } else {
2471          !!!cp (180);          !!!cp (180);
2472            !!!parse-error (type => 'string after DOCTYPE name');
2473            $self->{current_token}->{quirks} = 1;
2474    
2475            $self->{state} = BOGUS_DOCTYPE_STATE;
2476          !!!next-input-character;          !!!next-input-character;
2477          #          redo A;
2478        }        }
2479        } elsif ($self->{state} == PUBLIC_STATE) {
2480          ## ASCII case-insensitive
2481          if ($self->{next_char} == [
2482                undef,
2483                0x0055, # U
2484                0x0042, # B
2485                0x004C, # L
2486                0x0049, # I
2487              ]->[length $self->{state_keyword}] or
2488              $self->{next_char} == [
2489                undef,
2490                0x0075, # u
2491                0x0062, # b
2492                0x006C, # l
2493                0x0069, # i
2494              ]->[length $self->{state_keyword}]) {
2495            !!!cp (175);
2496            ## Stay in the state.
2497            $self->{state_keyword} .= chr $self->{next_char};
2498            !!!next-input-character;
2499            redo A;
2500          } elsif ((length $self->{state_keyword}) == 5 and
2501                   ($self->{next_char} == 0x0043 or # C
2502                    $self->{next_char} == 0x0063)) { # c
2503            !!!cp (168);
2504            $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
2505            !!!next-input-character;
2506            redo A;
2507          } else {
2508            !!!cp (169);
2509            !!!parse-error (type => 'string after DOCTYPE name',
2510                            line => $self->{line_prev},
2511                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2512            $self->{current_token}->{quirks} = 1;
2513    
2514        !!!parse-error (type => 'string after DOCTYPE name');          $self->{state} = BOGUS_DOCTYPE_STATE;
2515        $self->{current_token}->{quirks} = 1;          ## Reconsume.
2516            redo A;
2517          }
2518        } elsif ($self->{state} == SYSTEM_STATE) {
2519          ## ASCII case-insensitive
2520          if ($self->{next_char} == [
2521                undef,
2522                0x0059, # Y
2523                0x0053, # S
2524                0x0054, # T
2525                0x0045, # E
2526              ]->[length $self->{state_keyword}] or
2527              $self->{next_char} == [
2528                undef,
2529                0x0079, # y
2530                0x0073, # s
2531                0x0074, # t
2532                0x0065, # e
2533              ]->[length $self->{state_keyword}]) {
2534            !!!cp (170);
2535            ## Stay in the state.
2536            $self->{state_keyword} .= chr $self->{next_char};
2537            !!!next-input-character;
2538            redo A;
2539          } elsif ((length $self->{state_keyword}) == 5 and
2540                   ($self->{next_char} == 0x004D or # M
2541                    $self->{next_char} == 0x006D)) { # m
2542            !!!cp (171);
2543            $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
2544            !!!next-input-character;
2545            redo A;
2546          } else {
2547            !!!cp (172);
2548            !!!parse-error (type => 'string after DOCTYPE name',
2549                            line => $self->{line_prev},
2550                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2551            $self->{current_token}->{quirks} = 1;
2552    
2553        $self->{state} = BOGUS_DOCTYPE_STATE;          $self->{state} = BOGUS_DOCTYPE_STATE;
2554        # next-input-character is already done          ## Reconsume.
2555        redo A;          redo A;
2556          }
2557      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
2558        if ({        if ({
2559              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
# Line 2811  sub _get_next_token ($) { Line 2910  sub _get_next_token ($) {
2910          !!!next-input-character;          !!!next-input-character;
2911          redo A;          redo A;
2912        }        }
2913      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2914        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2915          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2916          ## and |CDATA_SECTION_MSE2_STATE|.
2917                
2918        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2919            !!!cp (221.1);
2920            $self->{state} = CDATA_SECTION_MSE1_STATE;
2921            !!!next-input-character;
2922            redo A;
2923          } elsif ($self->{next_char} == -1) {
2924            $self->{state} = DATA_STATE;
2925            !!!next-input-character;
2926            if (length $self->{current_token}->{data}) { # character
2927              !!!cp (221.2);
2928              !!!emit ($self->{current_token}); # character
2929            } else {
2930              !!!cp (221.3);
2931              ## No token to emit. $self->{current_token} is discarded.
2932            }        
2933            redo A;
2934          } else {
2935            !!!cp (221.4);
2936            $self->{current_token}->{data} .= chr $self->{next_char};
2937            ## Stay in the state.
2938            !!!next-input-character;
2939            redo A;
2940          }
2941    
2942        CS: while ($self->{next_char} != -1) {        ## ISSUE: "text tokens" in spec.
2943          if ($self->{next_char} == 0x005D) { # ]      } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
2944            !!!next-input-character;        if ($self->{next_char} == 0x005D) { # ]
2945            if ($self->{next_char} == 0x005D) { # ]          !!!cp (221.5);
2946              !!!next-input-character;          $self->{state} = CDATA_SECTION_MSE2_STATE;
2947              MDC: {          !!!next-input-character;
2948                if ($self->{next_char} == 0x003E) { # >          redo A;
2949                  !!!cp (221.1);        } else {
2950                  !!!next-input-character;          !!!cp (221.6);
2951                  last CS;          $self->{current_token}->{data} .= ']';
2952                } elsif ($self->{next_char} == 0x005D) { # ]          $self->{state} = CDATA_SECTION_STATE;
2953                  !!!cp (221.2);          ## Reconsume.
2954                  $s .= ']';          redo A;
2955                  !!!next-input-character;        }
2956                  redo MDC;      } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
2957                } else {        if ($self->{next_char} == 0x003E) { # >
2958                  !!!cp (221.3);          $self->{state} = DATA_STATE;
2959                  $s .= ']]';          !!!next-input-character;
2960                  #          if (length $self->{current_token}->{data}) { # character
2961                }            !!!cp (221.7);
2962              } # MDC            !!!emit ($self->{current_token}); # character
           } else {  
             !!!cp (221.4);  
             $s .= ']';  
             #  
           }  
2963          } else {          } else {
2964            !!!cp (221.5);            !!!cp (221.8);
2965            #            ## No token to emit. $self->{current_token} is discarded.
2966          }          }
2967          $s .= chr $self->{next_char};          redo A;
2968          } elsif ($self->{next_char} == 0x005D) { # ]
2969            !!!cp (221.9); # character
2970            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
2971            ## Stay in the state.
2972          !!!next-input-character;          !!!next-input-character;
2973        } # CS          redo A;
   
       $self->{state} = DATA_STATE;  
       ## next-input-character done or EOF, which is reconsumed.  
   
       if (length $s) {  
         !!!cp (221.6);  
         !!!emit ({type => CHARACTER_TOKEN, data => $s,  
                   line => $l, column => $c});  
2974        } else {        } else {
2975          !!!cp (221.7);          !!!cp (221.11);
2976            $self->{current_token}->{data} .= ']]'; # character
2977            $self->{state} = CDATA_SECTION_STATE;
2978            ## Reconsume.
2979            redo A;
2980          }
2981        } elsif ($self->{state} == ENTITY_STATE) {
2982          if ({
2983            0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
2984            0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, &
2985            $self->{entity_additional} => 1,
2986          }->{$self->{next_char}}) {
2987            !!!cp (1001);
2988            ## Don't consume
2989            ## No error
2990            ## Return nothing.
2991            #
2992          } elsif ($self->{next_char} == 0x0023) { # #
2993            !!!cp (999);
2994            $self->{state} = ENTITY_HASH_STATE;
2995            $self->{state_keyword} = '#';
2996            !!!next-input-character;
2997            redo A;
2998          } elsif ((0x0041 <= $self->{next_char} and
2999                    $self->{next_char} <= 0x005A) or # A..Z
3000                   (0x0061 <= $self->{next_char} and
3001                    $self->{next_char} <= 0x007A)) { # a..z
3002            !!!cp (998);
3003            require Whatpm::_NamedEntityList;
3004            $self->{state} = ENTITY_NAME_STATE;
3005            $self->{state_keyword} = chr $self->{next_char};
3006            $self->{entity__value} = $self->{state_keyword};
3007            $self->{entity__match} = 0;
3008            !!!next-input-character;
3009            redo A;
3010          } else {
3011            !!!cp (1027);
3012            !!!parse-error (type => 'bare ero');
3013            ## Return nothing.
3014            #
3015        }        }
3016    
3017        redo A;        ## NOTE: No character is consumed by the "consume a character
3018          ## reference" algorithm.  In other word, there is an "&" character
3019        ## ISSUE: "text tokens" in spec.        ## that does not introduce a character reference, which would be
3020        ## TODO: Streaming support        ## appended to the parent element or the attribute value in later
3021      } else {        ## process of the tokenizer.
3022        die "$0: $self->{state}: Unknown state";  
3023      }        if ($self->{prev_state} == DATA_STATE) {
3024    } # A            !!!cp (997);
3025            $self->{state} = $self->{prev_state};
3026    die "$0: _get_next_token: unexpected case";          ## Reconsume.
3027  } # _get_next_token          !!!emit ({type => CHARACTER_TOKEN, data => '&',
3028                      line => $self->{line_prev},
3029  sub _tokenize_attempt_to_consume_an_entity ($$$) {                    column => $self->{column_prev},
3030    my ($self, $in_attr, $additional) = @_;                   });
3031            redo A;
3032    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        } else {
3033            !!!cp (996);
3034            $self->{current_attribute}->{value} .= '&';
3035            $self->{state} = $self->{prev_state};
3036            ## Reconsume.
3037            redo A;
3038          }
3039        } elsif ($self->{state} == ENTITY_HASH_STATE) {
3040          if ($self->{next_char} == 0x0078 or # x
3041              $self->{next_char} == 0x0058) { # X
3042            !!!cp (995);
3043            $self->{state} = HEXREF_X_STATE;
3044            $self->{state_keyword} .= chr $self->{next_char};
3045            !!!next-input-character;
3046            redo A;
3047          } elsif (0x0030 <= $self->{next_char} and
3048                   $self->{next_char} <= 0x0039) { # 0..9
3049            !!!cp (994);
3050            $self->{state} = NCR_NUM_STATE;
3051            $self->{state_keyword} = $self->{next_char} - 0x0030;
3052            !!!next-input-character;
3053            redo A;
3054          } else {
3055            !!!parse-error (type => 'bare nero',
3056                            line => $self->{line_prev},
3057                            column => $self->{column_prev} - 1);
3058    
3059    if ({          ## NOTE: According to the spec algorithm, nothing is returned,
3060         0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,          ## and then "&#" is appended to the parent element or the attribute
3061         0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR          ## value in the later processing.
3062         $additional => 1,  
3063        }->{$self->{next_char}}) {          if ($self->{prev_state} == DATA_STATE) {
3064      !!!cp (1001);            !!!cp (1019);
3065      ## Don't consume            $self->{state} = $self->{prev_state};
3066      ## No error            ## Reconsume.
3067      return undef;            !!!emit ({type => CHARACTER_TOKEN,
3068    } elsif ($self->{next_char} == 0x0023) { # #                      data => '&#',
3069      !!!next-input-character;                      line => $self->{line_prev},
3070      if ($self->{next_char} == 0x0078 or # x                      column => $self->{column_prev} - 1,
3071          $self->{next_char} == 0x0058) { # X                     });
3072        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;  
3073          } else {          } else {
3074            !!!cp (1007);            !!!cp (993);
3075            !!!parse-error (type => 'no refc', line => $l, column => $c);            $self->{current_attribute}->{value} .= '&#';
3076              $self->{state} = $self->{prev_state};
3077              ## Reconsume.
3078              redo A;
3079          }          }
3080          }
3081          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {      } elsif ($self->{state} == NCR_NUM_STATE) {
3082            !!!cp (1008);        if (0x0030 <= $self->{next_char} and
3083            !!!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  
3084          !!!cp (1012);          !!!cp (1012);
3085          $code *= 10;          $self->{state_keyword} *= 10;
3086          $code += $self->{next_char} - 0x0030;          $self->{state_keyword} += $self->{next_char} - 0x0030;
3087                    
3088            ## Stay in the state.
3089          !!!next-input-character;          !!!next-input-character;
3090        }          redo A;
3091          } elsif ($self->{next_char} == 0x003B) { # ;
       if ($self->{next_char} == 0x003B) { # ;  
3092          !!!cp (1013);          !!!cp (1013);
3093          !!!next-input-character;          !!!next-input-character;
3094            #
3095        } else {        } else {
3096          !!!cp (1014);          !!!cp (1014);
3097          !!!parse-error (type => 'no refc', line => $l, column => $c);          !!!parse-error (type => 'no refc');
3098            ## Reconsume.
3099            #
3100        }        }
3101    
3102          my $code = $self->{state_keyword};
3103          my $l = $self->{line_prev};
3104          my $c = $self->{column_prev};
3105        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3106          !!!cp (1015);          !!!cp (1015);
3107          !!!parse-error (type => 'invalid character reference',          !!!parse-error (type => 'invalid character reference',
# Line 3003  sub _tokenize_attempt_to_consume_an_enti Line 3126  sub _tokenize_attempt_to_consume_an_enti
3126                          line => $l, column => $c);                          line => $l, column => $c);
3127          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3128        }        }
3129          
3130        return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        if ($self->{prev_state} == DATA_STATE) {
3131                line => $l, column => $c,          !!!cp (992);
3132               };          $self->{state} = $self->{prev_state};
3133      } else {          ## Reconsume.
3134        !!!cp (1019);          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3135        !!!parse-error (type => 'bare nero', line => $l, column => $c);                    line => $l, column => $c,
3136        !!!back-next-input-character ($self->{next_char});                   });
3137        $self->{next_char} = 0x0023; # #          redo A;
3138        return undef;        } else {
3139      }          !!!cp (991);
3140    } elsif ((0x0041 <= $self->{next_char} and          $self->{current_attribute}->{value} .= chr $code;
3141              $self->{next_char} <= 0x005A) or          $self->{current_attribute}->{has_reference} = 1;
3142             (0x0061 <= $self->{next_char} and          $self->{state} = $self->{prev_state};
3143              $self->{next_char} <= 0x007A)) {          ## Reconsume.
3144      my $entity_name = chr $self->{next_char};          redo A;
3145      !!!next-input-character;        }
3146        } elsif ($self->{state} == HEXREF_X_STATE) {
3147      my $value = $entity_name;        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3148      my $match = 0;            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3149      require Whatpm::_NamedEntityList;            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3150      our $EntityChar;          # 0..9, A..F, a..f
3151            !!!cp (990);
3152      while (length $entity_name < 30 and          $self->{state} = HEXREF_HEX_STATE;
3153             ## NOTE: Some number greater than the maximum length of entity name          $self->{state_keyword} = 0;
3154             ((0x0041 <= $self->{next_char} and # a          ## Reconsume.
3155               $self->{next_char} <= 0x005A) or # x          redo A;
3156              (0x0061 <= $self->{next_char} and # a        } else {
3157               $self->{next_char} <= 0x007A) or # z          !!!parse-error (type => 'bare hcro',
3158              (0x0030 <= $self->{next_char} and # 0                          line => $self->{line_prev},
3159               $self->{next_char} <= 0x0039) or # 9                          column => $self->{column_prev} - 2);
3160              $self->{next_char} == 0x003B)) { # ;  
3161        $entity_name .= chr $self->{next_char};          ## NOTE: According to the spec algorithm, nothing is returned,
3162        if (defined $EntityChar->{$entity_name}) {          ## and then "&#" followed by "X" or "x" is appended to the parent
3163          if ($self->{next_char} == 0x003B) { # ;          ## element or the attribute value in the later processing.
3164            !!!cp (1020);  
3165            $value = $EntityChar->{$entity_name};          if ($self->{prev_state} == DATA_STATE) {
3166            $match = 1;            !!!cp (1005);
3167            !!!next-input-character;            $self->{state} = $self->{prev_state};
3168            last;            ## Reconsume.
3169              !!!emit ({type => CHARACTER_TOKEN,
3170                        data => '&' . $self->{state_keyword},
3171                        line => $self->{line_prev},
3172                        column => $self->{column_prev} - length $self->{state_keyword},
3173                       });
3174              redo A;
3175            } else {
3176              !!!cp (989);
3177              $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3178              $self->{state} = $self->{prev_state};
3179              ## Reconsume.
3180              redo A;
3181            }
3182          }
3183        } elsif ($self->{state} == HEXREF_HEX_STATE) {
3184          if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) {
3185            # 0..9
3186            !!!cp (1002);
3187            $self->{state_keyword} *= 0x10;
3188            $self->{state_keyword} += $self->{next_char} - 0x0030;
3189            ## Stay in the state.
3190            !!!next-input-character;
3191            redo A;
3192          } elsif (0x0061 <= $self->{next_char} and
3193                   $self->{next_char} <= 0x0066) { # a..f
3194            !!!cp (1003);
3195            $self->{state_keyword} *= 0x10;
3196            $self->{state_keyword} += $self->{next_char} - 0x0060 + 9;
3197            ## Stay in the state.
3198            !!!next-input-character;
3199            redo A;
3200          } elsif (0x0041 <= $self->{next_char} and
3201                   $self->{next_char} <= 0x0046) { # A..F
3202            !!!cp (1004);
3203            $self->{state_keyword} *= 0x10;
3204            $self->{state_keyword} += $self->{next_char} - 0x0040 + 9;
3205            ## Stay in the state.
3206            !!!next-input-character;
3207            redo A;
3208          } elsif ($self->{next_char} == 0x003B) { # ;
3209            !!!cp (1006);
3210            !!!next-input-character;
3211            #
3212          } else {
3213            !!!cp (1007);
3214            !!!parse-error (type => 'no refc',
3215                            line => $self->{line},
3216                            column => $self->{column});
3217            ## Reconsume.
3218            #
3219          }
3220    
3221          my $code = $self->{state_keyword};
3222          my $l = $self->{line_prev};
3223          my $c = $self->{column_prev};
3224          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3225            !!!cp (1008);
3226            !!!parse-error (type => 'invalid character reference',
3227                            text => (sprintf 'U+%04X', $code),
3228                            line => $l, column => $c);
3229            $code = 0xFFFD;
3230          } elsif ($code > 0x10FFFF) {
3231            !!!cp (1009);
3232            !!!parse-error (type => 'invalid character reference',
3233                            text => (sprintf 'U-%08X', $code),
3234                            line => $l, column => $c);
3235            $code = 0xFFFD;
3236          } elsif ($code == 0x000D) {
3237            !!!cp (1010);
3238            !!!parse-error (type => 'CR character reference', line => $l, column => $c);
3239            $code = 0x000A;
3240          } elsif (0x80 <= $code and $code <= 0x9F) {
3241            !!!cp (1011);
3242            !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);
3243            $code = $c1_entity_char->{$code};
3244          }
3245    
3246          if ($self->{prev_state} == DATA_STATE) {
3247            !!!cp (988);
3248            $self->{state} = $self->{prev_state};
3249            ## Reconsume.
3250            !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3251                      line => $l, column => $c,
3252                     });
3253            redo A;
3254          } else {
3255            !!!cp (987);
3256            $self->{current_attribute}->{value} .= chr $code;
3257            $self->{current_attribute}->{has_reference} = 1;
3258            $self->{state} = $self->{prev_state};
3259            ## Reconsume.
3260            redo A;
3261          }
3262        } elsif ($self->{state} == ENTITY_NAME_STATE) {
3263          if (length $self->{state_keyword} < 30 and
3264              ## NOTE: Some number greater than the maximum length of entity name
3265              ((0x0041 <= $self->{next_char} and # a
3266                $self->{next_char} <= 0x005A) or # x
3267               (0x0061 <= $self->{next_char} and # a
3268                $self->{next_char} <= 0x007A) or # z
3269               (0x0030 <= $self->{next_char} and # 0
3270                $self->{next_char} <= 0x0039) or # 9
3271               $self->{next_char} == 0x003B)) { # ;
3272            our $EntityChar;
3273            $self->{state_keyword} .= chr $self->{next_char};
3274            if (defined $EntityChar->{$self->{state_keyword}}) {
3275              if ($self->{next_char} == 0x003B) { # ;
3276                !!!cp (1020);
3277                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3278                $self->{entity__match} = 1;
3279                !!!next-input-character;
3280                #
3281              } else {
3282                !!!cp (1021);
3283                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3284                $self->{entity__match} = -1;
3285                ## Stay in the state.
3286                !!!next-input-character;
3287                redo A;
3288              }
3289          } else {          } else {
3290            !!!cp (1021);            !!!cp (1022);
3291            $value = $EntityChar->{$entity_name};            $self->{entity__value} .= chr $self->{next_char};
3292            $match = -1;            $self->{entity__match} *= 2;
3293              ## Stay in the state.
3294            !!!next-input-character;            !!!next-input-character;
3295              redo A;
3296            }
3297          }
3298    
3299          my $data;
3300          my $has_ref;
3301          if ($self->{entity__match} > 0) {
3302            !!!cp (1023);
3303            $data = $self->{entity__value};
3304            $has_ref = 1;
3305            #
3306          } elsif ($self->{entity__match} < 0) {
3307            !!!parse-error (type => 'no refc');
3308            if ($self->{prev_state} != DATA_STATE and # in attribute
3309                $self->{entity__match} < -1) {
3310              !!!cp (1024);
3311              $data = '&' . $self->{state_keyword};
3312              #
3313            } else {
3314              !!!cp (1025);
3315              $data = $self->{entity__value};
3316              $has_ref = 1;
3317              #
3318          }          }
3319        } else {        } else {
3320          !!!cp (1022);          !!!cp (1026);
3321          $value .= chr $self->{next_char};          !!!parse-error (type => 'bare ero',
3322          $match *= 2;                          line => $self->{line_prev},
3323          !!!next-input-character;                          column => $self->{column_prev});
3324            $data = '&' . $self->{state_keyword};
3325            #
3326        }        }
3327      }    
3328              ## NOTE: In these cases, when a character reference is found,
3329      if ($match > 0) {        ## it is consumed and a character token is returned, or, otherwise,
3330        !!!cp (1023);        ## nothing is consumed and returned, according to the spec algorithm.
3331        return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        ## In this implementation, anything that has been examined by the
3332                line => $l, column => $c,        ## tokenizer is appended to the parent element or the attribute value
3333               };        ## as string, either literal string when no character reference or
3334      } elsif ($match < 0) {        ## entity-replaced string otherwise, in this stage, since any characters
3335        !!!parse-error (type => 'no refc', line => $l, column => $c);        ## that would not be consumed are appended in the data state or in an
3336        if ($in_attr and $match < -1) {        ## appropriate attribute value state anyway.
3337          !!!cp (1024);  
3338          return {type => CHARACTER_TOKEN, data => '&'.$entity_name,        if ($self->{prev_state} == DATA_STATE) {
3339                  line => $l, column => $c,          !!!cp (986);
3340                 };          $self->{state} = $self->{prev_state};
3341        } else {          ## Reconsume.
3342          !!!cp (1025);          !!!emit ({type => CHARACTER_TOKEN,
3343          return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,                    data => $data,
3344                  line => $l, column => $c,                    line => $self->{line_prev},
3345                 };                    column => $self->{column_prev} + 1 - length $self->{state_keyword},
3346                     });
3347            redo A;
3348          } else {
3349            !!!cp (985);
3350            $self->{current_attribute}->{value} .= $data;
3351            $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3352            $self->{state} = $self->{prev_state};
3353            ## Reconsume.
3354            redo A;
3355        }        }
3356      } else {      } else {
3357        !!!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,  
              };  
3358      }      }
3359    } else {    } # A  
3360      !!!cp (1027);  
3361      ## no characters are consumed    die "$0: _get_next_token: unexpected case";
3362      !!!parse-error (type => 'bare ero', line => $l, column => $c);  } # _get_next_token
     return undef;  
   }  
 } # _tokenize_attempt_to_consume_an_entity  
3363    
3364  sub _initialize_tree_constructor ($) {  sub _initialize_tree_constructor ($) {
3365    my $self = shift;    my $self = shift;
# Line 3154  sub _tree_construction_initial ($) { Line 3424  sub _tree_construction_initial ($) {
3424        ## language.        ## language.
3425        my $doctype_name = $token->{name};        my $doctype_name = $token->{name};
3426        $doctype_name = '' unless defined $doctype_name;        $doctype_name = '' unless defined $doctype_name;
3427        $doctype_name =~ tr/a-z/A-Z/;        $doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive
3428        if (not defined $token->{name} or # <!DOCTYPE>        if (not defined $token->{name} or # <!DOCTYPE>
           defined $token->{public_identifier} or  
3429            defined $token->{system_identifier}) {            defined $token->{system_identifier}) {
3430          !!!cp ('t1');          !!!cp ('t1');
3431          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3432        } elsif ($doctype_name ne 'HTML') {        } elsif ($doctype_name ne 'HTML') {
3433          !!!cp ('t2');          !!!cp ('t2');
         ## ISSUE: ASCII case-insensitive? (in fact it does not matter)  
3434          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3435          } elsif (defined $token->{public_identifier}) {
3436            if ($token->{public_identifier} eq 'XSLT-compat') {
3437              !!!cp ('t1.2');
3438              !!!parse-error (type => 'XSLT-compat', token => $token,
3439                              level => $self->{level}->{should});
3440            } else {
3441              !!!parse-error (type => 'not HTML5', token => $token);
3442            }
3443        } else {        } else {
3444          !!!cp ('t3');          !!!cp ('t3');
3445            #
3446        }        }
3447                
3448        my $doctype = $self->{document}->create_document_type_definition        my $doctype = $self->{document}->create_document_type_definition
# Line 7436  sub _tree_construction_main ($) { Line 7713  sub _tree_construction_main ($) {
7713    ## TODO: script stuffs    ## TODO: script stuffs
7714  } # _tree_construct_main  } # _tree_construct_main
7715    
7716  sub set_inner_html ($$$) {  sub set_inner_html ($$$;$) {
7717    my $class = shift;    my $class = shift;
7718    my $node = shift;    my $node = shift;
7719    my $s = \$_[0];    my $s = \$_[0];
7720    my $onerror = $_[1];    my $onerror = $_[1];
7721      my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7722    
7723    ## ISSUE: Should {confident} be true?    ## ISSUE: Should {confident} be true?
7724    
# Line 7459  sub set_inner_html ($$$) { Line 7737  sub set_inner_html ($$$) {
7737      }      }
7738    
7739      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7740      $class->parse_string ($$s => $node, $onerror);      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);
7741    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7742      ## TODO: If non-html element      ## TODO: If non-html element
7743    
7744      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
7745    
7746    ## TODO: Support for $get_wrapper
7747    
7748      ## Step 1 # MUST      ## Step 1 # MUST
7749      my $this_doc = $node->owner_document;      my $this_doc = $node->owner_document;
7750      my $doc = $this_doc->implementation->create_document;      my $doc = $this_doc->implementation->create_document;
# Line 7537  sub set_inner_html ($$$) { Line 7817  sub set_inner_html ($$$) {
7817      };      };
7818      $p->{prev_char} = [-1, -1, -1];      $p->{prev_char} = [-1, -1, -1];
7819      $p->{next_char} = -1;      $p->{next_char} = -1;
7820        
7821        $p->{getc_until} = sub {
7822          ## TODO: ...
7823          return undef;
7824        }; # $p->{getc_until};
7825    
7826      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7827        my (%opt) = @_;        my (%opt) = @_;
7828        my $line = $opt{line};        my $line = $opt{line};
Legend:
Removed from v.1.158  
changed lines
  Added in v.1.171
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24