/[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.156 by wakaba, Sat Aug 30 13:43:50 2008 UTC revision 1.168 by wakaba, Sat Sep 13 10:49:21 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;
621    require utf8;    require utf8;
622    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $s = ref $_[0] ? $_[0] : \($_[0]);
623    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $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 708  sub new ($) { Line 736  sub new ($) {
736    my $class = shift;    my $class = shift;
737    my $self = bless {    my $self = bless {
738      level => {must => 'm',      level => {must => 'm',
739                  should => 's',
740                warn => 'w',                warn => 'w',
741                info => 'i',                info => 'i',
742                uncertain => 'u'},                uncertain => 'u'},
# Line 740  sub RCDATA_CONTENT_MODEL () { CM_ENTITY Line 769  sub RCDATA_CONTENT_MODEL () { CM_ENTITY
769  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
770    
771  sub DATA_STATE () { 0 }  sub DATA_STATE () { 0 }
772  sub ENTITY_DATA_STATE () { 1 }  #sub ENTITY_DATA_STATE () { 1 }
773  sub TAG_OPEN_STATE () { 2 }  sub TAG_OPEN_STATE () { 2 }
774  sub CLOSE_TAG_OPEN_STATE () { 3 }  sub CLOSE_TAG_OPEN_STATE () { 3 }
775  sub TAG_NAME_STATE () { 4 }  sub TAG_NAME_STATE () { 4 }
# Line 751  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 Line 780  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8
780  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
781  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
782  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
783  sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }  #sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
784  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
785  sub COMMENT_START_STATE () { 14 }  sub COMMENT_START_STATE () { 14 }
786  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
# Line 774  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT Line 803  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT
803  sub BOGUS_DOCTYPE_STATE () { 32 }  sub BOGUS_DOCTYPE_STATE () { 32 }
804  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }
805  sub SELF_CLOSING_START_TAG_STATE () { 34 }  sub SELF_CLOSING_START_TAG_STATE () { 34 }
806  sub CDATA_BLOCK_STATE () { 35 }  sub CDATA_SECTION_STATE () { 35 }
807    sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec
808    sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec
809    sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec
810    sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec
811    sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec
812    sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
813    sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec
814    sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec
815    ## NOTE: "Entity data state", "entity in attribute value state", and
816    ## "consume a character reference" algorithm are jointly implemented
817    ## using the following six states:
818    sub ENTITY_STATE () { 44 }
819    sub ENTITY_HASH_STATE () { 45 }
820    sub NCR_NUM_STATE () { 46 }
821    sub HEXREF_X_STATE () { 47 }
822    sub HEXREF_HEX_STATE () { 48 }
823    sub ENTITY_NAME_STATE () { 49 }
824    
825  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
826  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 827  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 873  sub IN_COLUMN_GROUP_IM () { 0b10 }
873  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
874    my $self = shift;    my $self = shift;
875    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
876      #$self->{state_keyword}; # initialized when used
877    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
878    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
879    undef $self->{current_attribute};    undef $self->{current_attribute};
880    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
881    undef $self->{last_attribute_value_state};    undef $self->{last_attribute_value_state};
# Line 902  sub _get_next_token ($) { Line 949  sub _get_next_token ($) {
949          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA
950              not $self->{escape}) {              not $self->{escape}) {
951            !!!cp (1);            !!!cp (1);
952            $self->{state} = ENTITY_DATA_STATE;            ## NOTE: In the spec, the tokenizer is switched to the
953              ## "entity data state".  In this implementation, the tokenizer
954              ## is switched to the |ENTITY_STATE|, which is an implementation
955              ## of the "consume a character reference" algorithm.
956              $self->{entity_in_attr} = 0;
957              $self->{entity_additional} = -1;
958              $self->{state} = ENTITY_STATE;
959            !!!next-input-character;            !!!next-input-character;
960            redo A;            redo A;
961          } else {          } else {
# Line 972  sub _get_next_token ($) { Line 1025  sub _get_next_token ($) {
1025        !!!emit ($token);        !!!emit ($token);
1026    
1027        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;  
1028      } elsif ($self->{state} == TAG_OPEN_STATE) {      } elsif ($self->{state} == TAG_OPEN_STATE) {
1029        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1030          if ($self->{next_char} == 0x002F) { # /          if ($self->{next_char} == 0x002F) { # /
# Line 1089  sub _get_next_token ($) { Line 1121  sub _get_next_token ($) {
1121          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1122        }        }
1123      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1124          ## NOTE: The "close tag open state" in the spec is implemented as
1125          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1126    
1127        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1128        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1129          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1130              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1131            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1132            my @next_char;            ## Reconsume.
1133            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...  
           }  
1134          } else {          } else {
1135            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1136              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1137            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1138            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1139              ## Reconsume.
1140            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1141                      line => $l, column => $c,                      line => $l, column => $c,
1142                     });                     });
1143            redo A;            redo A;
1144          }          }
1145        }        }
1146          
1147        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1148            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1149          !!!cp (29);          !!!cp (29);
# Line 1198  sub _get_next_token ($) { Line 1190  sub _get_next_token ($) {
1190                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1191                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1192                                   };                                   };
1193          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1194          redo A;          ## Although the "anything else" case of the spec not explicitly
1195            ## states that the next input character is to be reconsumed,
1196            ## it will be included to the |data| of the comment token
1197            ## generated from the bogus end tag, as defined in the
1198            ## "bogus comment state" entry.
1199            redo A;
1200          }
1201        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1202          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1203          if (length $ch) {
1204            my $CH = $ch;
1205            $ch =~ tr/a-z/A-Z/;
1206            my $nch = chr $self->{next_char};
1207            if ($nch eq $ch or $nch eq $CH) {
1208              !!!cp (24);
1209              ## Stay in the state.
1210              $self->{state_keyword} .= $nch;
1211              !!!next-input-character;
1212              redo A;
1213            } else {
1214              !!!cp (25);
1215              $self->{state} = DATA_STATE;
1216              ## Reconsume.
1217              !!!emit ({type => CHARACTER_TOKEN,
1218                        data => '</' . $self->{state_keyword},
1219                        line => $self->{line_prev},
1220                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1221                       });
1222              redo A;
1223            }
1224          } else { # after "<{tag-name}"
1225            unless ({
1226                     0x0009 => 1, # HT
1227                     0x000A => 1, # LF
1228                     0x000B => 1, # VT
1229                     0x000C => 1, # FF
1230                     0x0020 => 1, # SP
1231                     0x003E => 1, # >
1232                     0x002F => 1, # /
1233                     -1 => 1, # EOF
1234                    }->{$self->{next_char}}) {
1235              !!!cp (26);
1236              ## Reconsume.
1237              $self->{state} = DATA_STATE;
1238              !!!emit ({type => CHARACTER_TOKEN,
1239                        data => '</' . $self->{state_keyword},
1240                        line => $self->{line_prev},
1241                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1242                       });
1243              redo A;
1244            } else {
1245              !!!cp (27);
1246              $self->{current_token}
1247                  = {type => END_TAG_TOKEN,
1248                     tag_name => $self->{last_emitted_start_tag_name},
1249                     line => $self->{line_prev},
1250                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1251              $self->{state} = TAG_NAME_STATE;
1252              ## Reconsume.
1253              redo A;
1254            }
1255        }        }
1256      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1257        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1647  sub _get_next_token ($) { Line 1699  sub _get_next_token ($) {
1699        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1700          !!!cp (96);          !!!cp (96);
1701          $self->{last_attribute_value_state} = $self->{state};          $self->{last_attribute_value_state} = $self->{state};
1702          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## NOTE: In the spec, the tokenizer is switched to the
1703            ## "entity in attribute value state".  In this implementation, the
1704            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1705            ## implementation of the "consume a character reference" algorithm.
1706            $self->{entity_in_attr} = 1;
1707            $self->{entity_additional} = 0x0022; # "
1708            $self->{state} = ENTITY_STATE;
1709          !!!next-input-character;          !!!next-input-character;
1710          redo A;          redo A;
1711        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1689  sub _get_next_token ($) { Line 1747  sub _get_next_token ($) {
1747        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1748          !!!cp (102);          !!!cp (102);
1749          $self->{last_attribute_value_state} = $self->{state};          $self->{last_attribute_value_state} = $self->{state};
1750          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## NOTE: In the spec, the tokenizer is switched to the
1751            ## "entity in attribute value state".  In this implementation, the
1752            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1753            ## implementation of the "consume a character reference" algorithm.
1754            $self->{entity_in_attr} = 1;
1755            $self->{entity_additional} = 0x0027; # '
1756            $self->{state} = ENTITY_STATE;
1757          !!!next-input-character;          !!!next-input-character;
1758          redo A;          redo A;
1759        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1735  sub _get_next_token ($) { Line 1799  sub _get_next_token ($) {
1799        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1800          !!!cp (108);          !!!cp (108);
1801          $self->{last_attribute_value_state} = $self->{state};          $self->{last_attribute_value_state} = $self->{state};
1802          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## NOTE: In the spec, the tokenizer is switched to the
1803            ## "entity in attribute value state".  In this implementation, the
1804            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1805            ## implementation of the "consume a character reference" algorithm.
1806            $self->{entity_in_attr} = 1;
1807            $self->{entity_additional} = -1;
1808            $self->{state} = ENTITY_STATE;
1809          !!!next-input-character;          !!!next-input-character;
1810          redo A;          redo A;
1811        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
# Line 1799  sub _get_next_token ($) { Line 1869  sub _get_next_token ($) {
1869          !!!next-input-character;          !!!next-input-character;
1870          redo A;          redo A;
1871        }        }
     } 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;  
1872      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {
1873        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
1874            $self->{next_char} == 0x000A or # LF            $self->{next_char} == 0x000A or # LF
# Line 1940  sub _get_next_token ($) { Line 1988  sub _get_next_token ($) {
1988        }        }
1989      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
1990        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
         
       ## NOTE: Set by the previous state  
       #my $token = {type => COMMENT_TOKEN, data => ''};  
   
       BC: {  
         if ($self->{next_char} == 0x003E) { # >  
           !!!cp (124);  
           $self->{state} = DATA_STATE;  
           !!!next-input-character;  
   
           !!!emit ($self->{current_token}); # comment  
   
           redo A;  
         } elsif ($self->{next_char} == -1) {  
           !!!cp (125);  
           $self->{state} = DATA_STATE;  
           ## reconsume  
1991    
1992            !!!emit ($self->{current_token}); # comment        ## NOTE: Unlike spec's "bogus comment state", this implementation
1993          ## consumes characters one-by-one basis.
1994          
1995          if ($self->{next_char} == 0x003E) { # >
1996            !!!cp (124);
1997            $self->{state} = DATA_STATE;
1998            !!!next-input-character;
1999    
2000            redo A;          !!!emit ($self->{current_token}); # comment
2001          } else {          redo A;
2002            !!!cp (126);        } elsif ($self->{next_char} == -1) {
2003            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          !!!cp (125);
2004            !!!next-input-character;          $self->{state} = DATA_STATE;
2005            redo BC;          ## reconsume
         }  
       } # BC  
2006    
2007        die "$0: _get_next_token: unexpected case [BC]";          !!!emit ($self->{current_token}); # comment
2008            redo A;
2009          } else {
2010            !!!cp (126);
2011            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2012            ## Stay in the state.
2013            !!!next-input-character;
2014            redo A;
2015          }
2016      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2017        ## (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};  
2018                
2019        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2020            !!!cp (133);
2021            $self->{state} = MD_HYPHEN_STATE;
2022          !!!next-input-character;          !!!next-input-character;
2023          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);  
         }  
2024        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2025                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2026            ## ASCII case-insensitive.
2027            !!!cp (130);
2028            $self->{state} = MD_DOCTYPE_STATE;
2029            $self->{state_keyword} = chr $self->{next_char};
2030          !!!next-input-character;          !!!next-input-character;
2031          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);  
         }  
2032        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2033                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2034                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2035            !!!cp (135.4);                
2036            $self->{state} = MD_CDATA_STATE;
2037            $self->{state_keyword} = '[';
2038          !!!next-input-character;          !!!next-input-character;
2039          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);  
         }  
2040        } else {        } else {
2041          !!!cp (136);          !!!cp (136);
2042        }        }
2043    
2044        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2045        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2046        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2047          ## Reconsume.
2048        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2049        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2050                                  line => $l, column => $c,                                  line => $self->{line_prev},
2051                                    column => $self->{column_prev} - 1,
2052                                 };                                 };
2053        redo A;        redo A;
2054              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2055        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2056        ## 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);
2057            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2058                                      line => $self->{line_prev},
2059                                      column => $self->{column_prev} - 2,
2060                                     };
2061            $self->{state} = COMMENT_START_STATE;
2062            !!!next-input-character;
2063            redo A;
2064          } else {
2065            !!!cp (128);
2066            !!!parse-error (type => 'bogus comment',
2067                            line => $self->{line_prev},
2068                            column => $self->{column_prev} - 2);
2069            $self->{state} = BOGUS_COMMENT_STATE;
2070            ## Reconsume.
2071            $self->{current_token} = {type => COMMENT_TOKEN,
2072                                      data => '-',
2073                                      line => $self->{line_prev},
2074                                      column => $self->{column_prev} - 2,
2075                                     };
2076            redo A;
2077          }
2078        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2079          ## ASCII case-insensitive.
2080          if ($self->{next_char} == [
2081                undef,
2082                0x004F, # O
2083                0x0043, # C
2084                0x0054, # T
2085                0x0059, # Y
2086                0x0050, # P
2087              ]->[length $self->{state_keyword}] or
2088              $self->{next_char} == [
2089                undef,
2090                0x006F, # o
2091                0x0063, # c
2092                0x0074, # t
2093                0x0079, # y
2094                0x0070, # p
2095              ]->[length $self->{state_keyword}]) {
2096            !!!cp (131);
2097            ## Stay in the state.
2098            $self->{state_keyword} .= chr $self->{next_char};
2099            !!!next-input-character;
2100            redo A;
2101          } elsif ((length $self->{state_keyword}) == 6 and
2102                   ($self->{next_char} == 0x0045 or # E
2103                    $self->{next_char} == 0x0065)) { # e
2104            !!!cp (129);
2105            $self->{state} = DOCTYPE_STATE;
2106            $self->{current_token} = {type => DOCTYPE_TOKEN,
2107                                      quirks => 1,
2108                                      line => $self->{line_prev},
2109                                      column => $self->{column_prev} - 7,
2110                                     };
2111            !!!next-input-character;
2112            redo A;
2113          } else {
2114            !!!cp (132);        
2115            !!!parse-error (type => 'bogus comment',
2116                            line => $self->{line_prev},
2117                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2118            $self->{state} = BOGUS_COMMENT_STATE;
2119            ## Reconsume.
2120            $self->{current_token} = {type => COMMENT_TOKEN,
2121                                      data => $self->{state_keyword},
2122                                      line => $self->{line_prev},
2123                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2124                                     };
2125            redo A;
2126          }
2127        } elsif ($self->{state} == MD_CDATA_STATE) {
2128          if ($self->{next_char} == {
2129                '[' => 0x0043, # C
2130                '[C' => 0x0044, # D
2131                '[CD' => 0x0041, # A
2132                '[CDA' => 0x0054, # T
2133                '[CDAT' => 0x0041, # A
2134              }->{$self->{state_keyword}}) {
2135            !!!cp (135.1);
2136            ## Stay in the state.
2137            $self->{state_keyword} .= chr $self->{next_char};
2138            !!!next-input-character;
2139            redo A;
2140          } elsif ($self->{state_keyword} eq '[CDATA' and
2141                   $self->{next_char} == 0x005B) { # [
2142            !!!cp (135.2);
2143            $self->{current_token} = {type => CHARACTER_TOKEN,
2144                                      data => '',
2145                                      line => $self->{line_prev},
2146                                      column => $self->{column_prev} - 7};
2147            $self->{state} = CDATA_SECTION_STATE;
2148            !!!next-input-character;
2149            redo A;
2150          } else {
2151            !!!cp (135.3);
2152            !!!parse-error (type => 'bogus comment',
2153                            line => $self->{line_prev},
2154                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2155            $self->{state} = BOGUS_COMMENT_STATE;
2156            ## Reconsume.
2157            $self->{current_token} = {type => COMMENT_TOKEN,
2158                                      data => $self->{state_keyword},
2159                                      line => $self->{line_prev},
2160                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2161                                     };
2162            redo A;
2163          }
2164      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2165        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2166          !!!cp (137);          !!!cp (137);
# Line 2369  sub _get_next_token ($) { Line 2427  sub _get_next_token ($) {
2427          redo A;          redo A;
2428        } elsif ($self->{next_char} == 0x0050 or # P        } elsif ($self->{next_char} == 0x0050 or # P
2429                 $self->{next_char} == 0x0070) { # p                 $self->{next_char} == 0x0070) { # p
2430            $self->{state} = PUBLIC_STATE;
2431            $self->{state_keyword} = chr $self->{next_char};
2432          !!!next-input-character;          !!!next-input-character;
2433          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);  
         }  
   
         #  
2434        } elsif ($self->{next_char} == 0x0053 or # S        } elsif ($self->{next_char} == 0x0053 or # S
2435                 $self->{next_char} == 0x0073) { # s                 $self->{next_char} == 0x0073) { # s
2436            $self->{state} = SYSTEM_STATE;
2437            $self->{state_keyword} = chr $self->{next_char};
2438          !!!next-input-character;          !!!next-input-character;
2439          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);  
         }  
   
         #  
2440        } else {        } else {
2441          !!!cp (180);          !!!cp (180);
2442            !!!parse-error (type => 'string after DOCTYPE name');
2443            $self->{current_token}->{quirks} = 1;
2444    
2445            $self->{state} = BOGUS_DOCTYPE_STATE;
2446          !!!next-input-character;          !!!next-input-character;
2447          #          redo A;
2448        }        }
2449        } elsif ($self->{state} == PUBLIC_STATE) {
2450          ## ASCII case-insensitive
2451          if ($self->{next_char} == [
2452                undef,
2453                0x0055, # U
2454                0x0042, # B
2455                0x004C, # L
2456                0x0049, # I
2457              ]->[length $self->{state_keyword}] or
2458              $self->{next_char} == [
2459                undef,
2460                0x0075, # u
2461                0x0062, # b
2462                0x006C, # l
2463                0x0069, # i
2464              ]->[length $self->{state_keyword}]) {
2465            !!!cp (175);
2466            ## Stay in the state.
2467            $self->{state_keyword} .= chr $self->{next_char};
2468            !!!next-input-character;
2469            redo A;
2470          } elsif ((length $self->{state_keyword}) == 5 and
2471                   ($self->{next_char} == 0x0043 or # C
2472                    $self->{next_char} == 0x0063)) { # c
2473            !!!cp (168);
2474            $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
2475            !!!next-input-character;
2476            redo A;
2477          } else {
2478            !!!cp (169);
2479            !!!parse-error (type => 'string after DOCTYPE name',
2480                            line => $self->{line_prev},
2481                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2482            $self->{current_token}->{quirks} = 1;
2483    
2484        !!!parse-error (type => 'string after DOCTYPE name');          $self->{state} = BOGUS_DOCTYPE_STATE;
2485        $self->{current_token}->{quirks} = 1;          ## Reconsume.
2486            redo A;
2487          }
2488        } elsif ($self->{state} == SYSTEM_STATE) {
2489          ## ASCII case-insensitive
2490          if ($self->{next_char} == [
2491                undef,
2492                0x0059, # Y
2493                0x0053, # S
2494                0x0054, # T
2495                0x0045, # E
2496              ]->[length $self->{state_keyword}] or
2497              $self->{next_char} == [
2498                undef,
2499                0x0079, # y
2500                0x0073, # s
2501                0x0074, # t
2502                0x0065, # e
2503              ]->[length $self->{state_keyword}]) {
2504            !!!cp (170);
2505            ## Stay in the state.
2506            $self->{state_keyword} .= chr $self->{next_char};
2507            !!!next-input-character;
2508            redo A;
2509          } elsif ((length $self->{state_keyword}) == 5 and
2510                   ($self->{next_char} == 0x004D or # M
2511                    $self->{next_char} == 0x006D)) { # m
2512            !!!cp (171);
2513            $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
2514            !!!next-input-character;
2515            redo A;
2516          } else {
2517            !!!cp (172);
2518            !!!parse-error (type => 'string after DOCTYPE name',
2519                            line => $self->{line_prev},
2520                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2521            $self->{current_token}->{quirks} = 1;
2522    
2523        $self->{state} = BOGUS_DOCTYPE_STATE;          $self->{state} = BOGUS_DOCTYPE_STATE;
2524        # next-input-character is already done          ## Reconsume.
2525        redo A;          redo A;
2526          }
2527      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
2528        if ({        if ({
2529              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 2880  sub _get_next_token ($) {
2880          !!!next-input-character;          !!!next-input-character;
2881          redo A;          redo A;
2882        }        }
2883      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2884        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2885          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2886          ## and |CDATA_SECTION_MSE2_STATE|.
2887                
2888        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2889            !!!cp (221.1);
2890            $self->{state} = CDATA_SECTION_MSE1_STATE;
2891            !!!next-input-character;
2892            redo A;
2893          } elsif ($self->{next_char} == -1) {
2894            $self->{state} = DATA_STATE;
2895            !!!next-input-character;
2896            if (length $self->{current_token}->{data}) { # character
2897              !!!cp (221.2);
2898              !!!emit ($self->{current_token}); # character
2899            } else {
2900              !!!cp (221.3);
2901              ## No token to emit. $self->{current_token} is discarded.
2902            }        
2903            redo A;
2904          } else {
2905            !!!cp (221.4);
2906            $self->{current_token}->{data} .= chr $self->{next_char};
2907            ## Stay in the state.
2908            !!!next-input-character;
2909            redo A;
2910          }
2911    
2912        CS: while ($self->{next_char} != -1) {        ## ISSUE: "text tokens" in spec.
2913          if ($self->{next_char} == 0x005D) { # ]      } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
2914            !!!next-input-character;        if ($self->{next_char} == 0x005D) { # ]
2915            if ($self->{next_char} == 0x005D) { # ]          !!!cp (221.5);
2916              !!!next-input-character;          $self->{state} = CDATA_SECTION_MSE2_STATE;
2917              MDC: {          !!!next-input-character;
2918                if ($self->{next_char} == 0x003E) { # >          redo A;
2919                  !!!cp (221.1);        } else {
2920                  !!!next-input-character;          !!!cp (221.6);
2921                  last CS;          $self->{current_token}->{data} .= ']';
2922                } elsif ($self->{next_char} == 0x005D) { # ]          $self->{state} = CDATA_SECTION_STATE;
2923                  !!!cp (221.2);          ## Reconsume.
2924                  $s .= ']';          redo A;
2925                  !!!next-input-character;        }
2926                  redo MDC;      } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
2927                } else {        if ($self->{next_char} == 0x003E) { # >
2928                  !!!cp (221.3);          $self->{state} = DATA_STATE;
2929                  $s .= ']]';          !!!next-input-character;
2930                  #          if (length $self->{current_token}->{data}) { # character
2931                }            !!!cp (221.7);
2932              } # MDC            !!!emit ($self->{current_token}); # character
           } else {  
             !!!cp (221.4);  
             $s .= ']';  
             #  
           }  
2933          } else {          } else {
2934            !!!cp (221.5);            !!!cp (221.8);
2935            #            ## No token to emit. $self->{current_token} is discarded.
2936          }          }
2937          $s .= chr $self->{next_char};          redo A;
2938          } elsif ($self->{next_char} == 0x005D) { # ]
2939            !!!cp (221.9); # character
2940            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
2941            ## Stay in the state.
2942          !!!next-input-character;          !!!next-input-character;
2943        } # 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});  
2944        } else {        } else {
2945          !!!cp (221.7);          !!!cp (221.11);
2946            $self->{current_token}->{data} .= ']]'; # character
2947            $self->{state} = CDATA_SECTION_STATE;
2948            ## Reconsume.
2949            redo A;
2950          }
2951        } elsif ($self->{state} == ENTITY_STATE) {
2952          if ({
2953            0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
2954            0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, &
2955            $self->{entity_additional} => 1,
2956          }->{$self->{next_char}}) {
2957            !!!cp (1001);
2958            ## Don't consume
2959            ## No error
2960            ## Return nothing.
2961            #
2962          } elsif ($self->{next_char} == 0x0023) { # #
2963            $self->{state} = ENTITY_HASH_STATE;
2964            $self->{state_keyword} = '#';
2965            !!!next-input-character;
2966            redo A;
2967          } elsif ((0x0041 <= $self->{next_char} and
2968                    $self->{next_char} <= 0x005A) or # A..Z
2969                   (0x0061 <= $self->{next_char} and
2970                    $self->{next_char} <= 0x007A)) { # a..z
2971            require Whatpm::_NamedEntityList;
2972            $self->{state} = ENTITY_NAME_STATE;
2973            $self->{state_keyword} = chr $self->{next_char};
2974            $self->{entity__value} = $self->{state_keyword};
2975            $self->{entity__match} = 0;
2976            !!!next-input-character;
2977            redo A;
2978          } else {
2979            !!!cp (1027);
2980            !!!parse-error (type => 'bare ero');
2981            ## Return nothing.
2982            #
2983        }        }
2984    
2985        redo A;        ## NOTE: No character is consumed by the "consume a character
2986          ## reference" algorithm.  In other word, there is an "&" character
2987        ## ISSUE: "text tokens" in spec.        ## that does not introduce a character reference, which would be
2988        ## TODO: Streaming support        ## appended to the parent element or the attribute value in later
2989      } else {        ## process of the tokenizer.
       die "$0: $self->{state}: Unknown state";  
     }  
   } # A    
   
   die "$0: _get_next_token: unexpected case";  
 } # _get_next_token  
   
 sub _tokenize_attempt_to_consume_an_entity ($$$) {  
   my ($self, $in_attr, $additional) = @_;  
2990    
2991    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        if ($self->{entity_in_attr}) {
2992            $self->{current_attribute}->{value} .= '&';
2993            $self->{state} = $self->{last_attribute_value_state};
2994            ## Reconsume.
2995            redo A;
2996          } else {
2997            $self->{state} = DATA_STATE;
2998            ## Reconsume.
2999            !!!emit ({type => CHARACTER_TOKEN, data => '&',
3000                      line => $self->{line_prev},
3001                      column => $self->{column_prev},
3002                     });
3003            redo A;
3004          }
3005        } elsif ($self->{state} == ENTITY_HASH_STATE) {
3006          if ($self->{next_char} == 0x0078 or # x
3007              $self->{next_char} == 0x0058) { # X
3008            $self->{state} = HEXREF_X_STATE;
3009            $self->{state_keyword} .= chr $self->{next_char};
3010            !!!next-input-character;
3011            redo A;
3012          } elsif (0x0030 <= $self->{next_char} and
3013                   $self->{next_char} <= 0x0039) { # 0..9
3014            $self->{state} = NCR_NUM_STATE;
3015            $self->{state_keyword} = $self->{next_char} - 0x0030;
3016            !!!next-input-character;
3017            redo A;
3018          } else {
3019            !!!cp (1019);
3020            !!!parse-error (type => 'bare nero',
3021                            line => $self->{line_prev},
3022                            column => $self->{column_prev} - 1);
3023    
3024    if ({          ## NOTE: According to the spec algorithm, nothing is returned,
3025         0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,          ## and then "&#" is appended to the parent element or the attribute
3026         0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR          ## value in the later processing.
3027         $additional => 1,  
3028        }->{$self->{next_char}}) {          if ($self->{entity_in_attr}) {
3029      !!!cp (1001);            $self->{current_attribute}->{value} .= '&#';
3030      ## Don't consume            $self->{state} = $self->{last_attribute_value_state};
3031      ## No error            ## Reconsume.
3032      return undef;            redo A;
   } elsif ($self->{next_char} == 0x0023) { # #  
     !!!next-input-character;  
     if ($self->{next_char} == 0x0078 or # x  
         $self->{next_char} == 0x0058) { # X  
       my $code;  
       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;  
3033          } else {          } else {
3034            !!!cp (1007);            $self->{state} = DATA_STATE;
3035            !!!parse-error (type => 'no refc', line => $l, column => $c);            ## Reconsume.
3036              !!!emit ({type => CHARACTER_TOKEN,
3037                        data => '&#',
3038                        line => $self->{line_prev},
3039                        column => $self->{column_prev} - 1,
3040                       });
3041              redo A;
3042          }          }
3043          }
3044          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {      } elsif ($self->{state} == NCR_NUM_STATE) {
3045            !!!cp (1008);        if (0x0030 <= $self->{next_char} and
3046            !!!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  
3047          !!!cp (1012);          !!!cp (1012);
3048          $code *= 10;          $self->{state_keyword} *= 10;
3049          $code += $self->{next_char} - 0x0030;          $self->{state_keyword} += $self->{next_char} - 0x0030;
3050                    
3051            ## Stay in the state.
3052          !!!next-input-character;          !!!next-input-character;
3053        }          redo A;
3054          } elsif ($self->{next_char} == 0x003B) { # ;
       if ($self->{next_char} == 0x003B) { # ;  
3055          !!!cp (1013);          !!!cp (1013);
3056          !!!next-input-character;          !!!next-input-character;
3057            #
3058        } else {        } else {
3059          !!!cp (1014);          !!!cp (1014);
3060          !!!parse-error (type => 'no refc', line => $l, column => $c);          !!!parse-error (type => 'no refc');
3061            ## Reconsume.
3062            #
3063        }        }
3064    
3065          my $code = $self->{state_keyword};
3066          my $l = $self->{line_prev};
3067          my $c = $self->{column_prev};
3068        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3069          !!!cp (1015);          !!!cp (1015);
3070          !!!parse-error (type => 'invalid character reference',          !!!parse-error (type => 'invalid character reference',
# Line 3003  sub _tokenize_attempt_to_consume_an_enti Line 3089  sub _tokenize_attempt_to_consume_an_enti
3089                          line => $l, column => $c);                          line => $l, column => $c);
3090          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3091        }        }
3092          
3093        return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        if ($self->{entity_in_attr}) {
3094                line => $l, column => $c,          $self->{current_attribute}->{value} .= chr $code;
3095               };          $self->{current_attribute}->{has_reference} = 1;
3096      } else {          $self->{state} = $self->{last_attribute_value_state};
3097        !!!cp (1019);          ## Reconsume.
3098        !!!parse-error (type => 'bare nero', line => $l, column => $c);          redo A;
3099        !!!back-next-input-character ($self->{next_char});        } else {
3100        $self->{next_char} = 0x0023; # #          $self->{state} = DATA_STATE;
3101        return undef;          ## Reconsume.
3102      }          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3103    } elsif ((0x0041 <= $self->{next_char} and                    has_reference => 1,
3104              $self->{next_char} <= 0x005A) or                    line => $l, column => $c,
3105             (0x0061 <= $self->{next_char} and                   });
3106              $self->{next_char} <= 0x007A)) {          redo A;
3107      my $entity_name = chr $self->{next_char};        }
3108      !!!next-input-character;      } elsif ($self->{state} == HEXREF_X_STATE) {
3109          if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3110      my $value = $entity_name;            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3111      my $match = 0;            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3112      require Whatpm::_NamedEntityList;          # 0..9, A..F, a..f
3113      our $EntityChar;          $self->{state} = HEXREF_HEX_STATE;
3114            $self->{state_keyword} = 0;
3115      while (length $entity_name < 30 and          ## Reconsume.
3116             ## NOTE: Some number greater than the maximum length of entity name          redo A;
3117             ((0x0041 <= $self->{next_char} and # a        } else {
3118               $self->{next_char} <= 0x005A) or # x          !!!cp (1005);
3119              (0x0061 <= $self->{next_char} and # a          !!!parse-error (type => 'bare hcro',
3120               $self->{next_char} <= 0x007A) or # z                          line => $self->{line_prev},
3121              (0x0030 <= $self->{next_char} and # 0                          column => $self->{column_prev} - 2);
3122               $self->{next_char} <= 0x0039) or # 9  
3123              $self->{next_char} == 0x003B)) { # ;          ## NOTE: According to the spec algorithm, nothing is returned,
3124        $entity_name .= chr $self->{next_char};          ## and then "&#" followed by "X" or "x" is appended to the parent
3125        if (defined $EntityChar->{$entity_name}) {          ## element or the attribute value in the later processing.
3126          if ($self->{next_char} == 0x003B) { # ;  
3127            !!!cp (1020);          if ($self->{entity_in_attr}) {
3128            $value = $EntityChar->{$entity_name};            $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3129            $match = 1;            $self->{state} = $self->{last_attribute_value_state};
3130            !!!next-input-character;            ## Reconsume.
3131            last;            redo A;
3132          } else {          } else {
3133            !!!cp (1021);            $self->{state} = DATA_STATE;
3134            $value = $EntityChar->{$entity_name};            ## Reconsume.
3135            $match = -1;            !!!emit ({type => CHARACTER_TOKEN,
3136                        data => '&' . $self->{state_keyword},
3137                        line => $self->{line_prev},
3138                        column => $self->{column_prev} - length $self->{state_keyword},
3139                       });
3140              redo A;
3141            }
3142          }
3143        } elsif ($self->{state} == HEXREF_HEX_STATE) {
3144          if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) {
3145            # 0..9
3146            !!!cp (1002);
3147            $self->{state_keyword} *= 0x10;
3148            $self->{state_keyword} += $self->{next_char} - 0x0030;
3149            ## Stay in the state.
3150            !!!next-input-character;
3151            redo A;
3152          } elsif (0x0061 <= $self->{next_char} and
3153                   $self->{next_char} <= 0x0066) { # a..f
3154            !!!cp (1003);
3155            $self->{state_keyword} *= 0x10;
3156            $self->{state_keyword} += $self->{next_char} - 0x0060 + 9;
3157            ## Stay in the state.
3158            !!!next-input-character;
3159            redo A;
3160          } elsif (0x0041 <= $self->{next_char} and
3161                   $self->{next_char} <= 0x0046) { # A..F
3162            !!!cp (1004);
3163            $self->{state_keyword} *= 0x10;
3164            $self->{state_keyword} += $self->{next_char} - 0x0040 + 9;
3165            ## Stay in the state.
3166            !!!next-input-character;
3167            redo A;
3168          } elsif ($self->{next_char} == 0x003B) { # ;
3169            !!!cp (1006);
3170            !!!next-input-character;
3171            #
3172          } else {
3173            !!!cp (1007);
3174            !!!parse-error (type => 'no refc',
3175                            line => $self->{line},
3176                            column => $self->{column});
3177            ## Reconsume.
3178            #
3179          }
3180    
3181          my $code = $self->{state_keyword};
3182          my $l = $self->{line_prev};
3183          my $c = $self->{column_prev};
3184          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3185            !!!cp (1008);
3186            !!!parse-error (type => 'invalid character reference',
3187                            text => (sprintf 'U+%04X', $code),
3188                            line => $l, column => $c);
3189            $code = 0xFFFD;
3190          } elsif ($code > 0x10FFFF) {
3191            !!!cp (1009);
3192            !!!parse-error (type => 'invalid character reference',
3193                            text => (sprintf 'U-%08X', $code),
3194                            line => $l, column => $c);
3195            $code = 0xFFFD;
3196          } elsif ($code == 0x000D) {
3197            !!!cp (1010);
3198            !!!parse-error (type => 'CR character reference', line => $l, column => $c);
3199            $code = 0x000A;
3200          } elsif (0x80 <= $code and $code <= 0x9F) {
3201            !!!cp (1011);
3202            !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);
3203            $code = $c1_entity_char->{$code};
3204          }
3205    
3206          if ($self->{entity_in_attr}) {
3207            $self->{current_attribute}->{value} .= chr $code;
3208            $self->{current_attribute}->{has_reference} = 1;
3209            $self->{state} = $self->{last_attribute_value_state};
3210            ## Reconsume.
3211            redo A;
3212          } else {
3213            $self->{state} = DATA_STATE;
3214            ## Reconsume.
3215            !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3216                      has_reference => 1,
3217                      line => $l, column => $c,
3218                     });
3219            redo A;
3220          }
3221        } elsif ($self->{state} == ENTITY_NAME_STATE) {
3222          if (length $self->{state_keyword} < 30 and
3223              ## NOTE: Some number greater than the maximum length of entity name
3224              ((0x0041 <= $self->{next_char} and # a
3225                $self->{next_char} <= 0x005A) or # x
3226               (0x0061 <= $self->{next_char} and # a
3227                $self->{next_char} <= 0x007A) or # z
3228               (0x0030 <= $self->{next_char} and # 0
3229                $self->{next_char} <= 0x0039) or # 9
3230               $self->{next_char} == 0x003B)) { # ;
3231            our $EntityChar;
3232            $self->{state_keyword} .= chr $self->{next_char};
3233            if (defined $EntityChar->{$self->{state_keyword}}) {
3234              if ($self->{next_char} == 0x003B) { # ;
3235                !!!cp (1020);
3236                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3237                $self->{entity__match} = 1;
3238                !!!next-input-character;
3239                #
3240              } else {
3241                !!!cp (1021);
3242                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3243                $self->{entity__match} = -1;
3244                ## Stay in the state.
3245                !!!next-input-character;
3246                redo A;
3247              }
3248            } else {
3249              !!!cp (1022);
3250              $self->{entity__value} .= chr $self->{next_char};
3251              $self->{entity__match} *= 2;
3252              ## Stay in the state.
3253            !!!next-input-character;            !!!next-input-character;
3254              redo A;
3255            }
3256          }
3257    
3258          my $data;
3259          my $has_ref;
3260          if ($self->{entity__match} > 0) {
3261            !!!cp (1023);
3262            $data = $self->{entity__value};
3263            $has_ref = 1;
3264            #
3265          } elsif ($self->{entity__match} < 0) {
3266            !!!parse-error (type => 'no refc');
3267            if ($self->{entity_in_attr} and $self->{entity__match} < -1) {
3268              !!!cp (1024);
3269              $data = '&' . $self->{state_keyword};
3270              #
3271            } else {
3272              !!!cp (1025);
3273              $data = $self->{entity__value};
3274              $has_ref = 1;
3275              #
3276          }          }
3277        } else {        } else {
3278          !!!cp (1022);          !!!cp (1026);
3279          $value .= chr $self->{next_char};          !!!parse-error (type => 'bare ero',
3280          $match *= 2;                          line => $self->{line_prev},
3281          !!!next-input-character;                          column => $self->{column_prev});
3282            $data = '&' . $self->{state_keyword};
3283            #
3284        }        }
3285      }    
3286              ## NOTE: In these cases, when a character reference is found,
3287      if ($match > 0) {        ## it is consumed and a character token is returned, or, otherwise,
3288        !!!cp (1023);        ## nothing is consumed and returned, according to the spec algorithm.
3289        return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        ## In this implementation, anything that has been examined by the
3290                line => $l, column => $c,        ## tokenizer is appended to the parent element or the attribute value
3291               };        ## as string, either literal string when no character reference or
3292      } elsif ($match < 0) {        ## entity-replaced string otherwise, in this stage, since any characters
3293        !!!parse-error (type => 'no refc', line => $l, column => $c);        ## that would not be consumed are appended in the data state or in an
3294        if ($in_attr and $match < -1) {        ## appropriate attribute value state anyway.
3295          !!!cp (1024);  
3296          return {type => CHARACTER_TOKEN, data => '&'.$entity_name,        if ($self->{entity_in_attr}) {
3297                  line => $l, column => $c,          $self->{current_attribute}->{value} .= $data;
3298                 };          $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3299        } else {          $self->{state} = $self->{last_attribute_value_state};
3300          !!!cp (1025);          ## Reconsume.
3301          return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,          redo A;
3302                  line => $l, column => $c,        } else {
3303                 };          $self->{state} = DATA_STATE;
3304            ## Reconsume.
3305            !!!emit ({type => CHARACTER_TOKEN,
3306                      data => $data, has_reference => $has_ref,
3307                      line => $self->{line_prev},
3308                      column => $self->{column_prev} + 1 - length $self->{state_keyword},
3309                     });
3310            redo A;
3311        }        }
3312      } else {      } else {
3313        !!!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,  
              };  
3314      }      }
3315    } else {    } # A  
3316      !!!cp (1027);  
3317      ## no characters are consumed    die "$0: _get_next_token: unexpected case";
3318      !!!parse-error (type => 'bare ero', line => $l, column => $c);  } # _get_next_token
     return undef;  
   }  
 } # _tokenize_attempt_to_consume_an_entity  
3319    
3320  sub _initialize_tree_constructor ($) {  sub _initialize_tree_constructor ($) {
3321    my $self = shift;    my $self = shift;
# Line 3154  sub _tree_construction_initial ($) { Line 3380  sub _tree_construction_initial ($) {
3380        ## language.        ## language.
3381        my $doctype_name = $token->{name};        my $doctype_name = $token->{name};
3382        $doctype_name = '' unless defined $doctype_name;        $doctype_name = '' unless defined $doctype_name;
3383        $doctype_name =~ tr/a-z/A-Z/;        $doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive
3384        if (not defined $token->{name} or # <!DOCTYPE>        if (not defined $token->{name} or # <!DOCTYPE>
           defined $token->{public_identifier} or  
3385            defined $token->{system_identifier}) {            defined $token->{system_identifier}) {
3386          !!!cp ('t1');          !!!cp ('t1');
3387          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3388        } elsif ($doctype_name ne 'HTML') {        } elsif ($doctype_name ne 'HTML') {
3389          !!!cp ('t2');          !!!cp ('t2');
         ## ISSUE: ASCII case-insensitive? (in fact it does not matter)  
3390          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3391          } elsif (defined $token->{public_identifier}) {
3392            if ($token->{public_identifier} eq 'XSLT-compat') {
3393              !!!cp ('t1.2');
3394              !!!parse-error (type => 'XSLT-compat', token => $token,
3395                              level => $self->{level}->{should});
3396            } else {
3397              !!!parse-error (type => 'not HTML5', token => $token);
3398            }
3399        } else {        } else {
3400          !!!cp ('t3');          !!!cp ('t3');
3401            #
3402        }        }
3403                
3404        my $doctype = $self->{document}->create_document_type_definition        my $doctype = $self->{document}->create_document_type_definition
# Line 6301  sub _tree_construction_main ($) { Line 6534  sub _tree_construction_main ($) {
6534            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6535              !!!cp ('t312');              !!!cp ('t312');
6536              !!!parse-error (type => 'after frameset:#text', token => $token);              !!!parse-error (type => 'after frameset:#text', token => $token);
6537            } else { # "after html frameset"            } else { # "after after frameset"
6538              !!!cp ('t313');              !!!cp ('t313');
6539              !!!parse-error (type => 'after html:#text', token => $token);              !!!parse-error (type => 'after html:#text', token => $token);
   
             $self->{insertion_mode} = AFTER_FRAMESET_IM;  
             ## Reprocess in the "after frameset" insertion mode.  
             !!!parse-error (type => 'after frameset:#text', token => $token);  
6540            }            }
6541                        
6542            ## Ignore the token.            ## Ignore the token.
# Line 6323  sub _tree_construction_main ($) { Line 6552  sub _tree_construction_main ($) {
6552                    
6553          die qq[$0: Character "$token->{data}"];          die qq[$0: Character "$token->{data}"];
6554        } elsif ($token->{type} == START_TAG_TOKEN) {        } elsif ($token->{type} == START_TAG_TOKEN) {
         if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {  
           !!!cp ('t316');  
           !!!parse-error (type => 'after html',  
                           text => $token->{tag_name}, token => $token);  
   
           $self->{insertion_mode} = AFTER_FRAMESET_IM;  
           ## Process in the "after frameset" insertion mode.  
         } else {  
           !!!cp ('t317');  
         }  
   
6555          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6556              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6557            !!!cp ('t318');            !!!cp ('t318');
# Line 6354  sub _tree_construction_main ($) { Line 6572  sub _tree_construction_main ($) {
6572            ## NOTE: As if in head.            ## NOTE: As if in head.
6573            $parse_rcdata->(CDATA_CONTENT_MODEL);            $parse_rcdata->(CDATA_CONTENT_MODEL);
6574            next B;            next B;
6575    
6576              ## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>|
6577              ## has no parse error.
6578          } else {          } else {
6579            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6580              !!!cp ('t321');              !!!cp ('t321');
6581              !!!parse-error (type => 'in frameset',              !!!parse-error (type => 'in frameset',
6582                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6583            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6584              !!!cp ('t322');              !!!cp ('t322');
6585              !!!parse-error (type => 'after frameset',              !!!parse-error (type => 'after frameset',
6586                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6587              } else { # "after after frameset"
6588                !!!cp ('t322.2');
6589                !!!parse-error (type => 'after after frameset',
6590                                text => $token->{tag_name}, token => $token);
6591            }            }
6592            ## Ignore the token            ## Ignore the token
6593            !!!nack ('t322.1');            !!!nack ('t322.1');
# Line 6370  sub _tree_construction_main ($) { Line 6595  sub _tree_construction_main ($) {
6595            next B;            next B;
6596          }          }
6597        } elsif ($token->{type} == END_TAG_TOKEN) {        } elsif ($token->{type} == END_TAG_TOKEN) {
         if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {  
           !!!cp ('t323');  
           !!!parse-error (type => 'after html:/',  
                           text => $token->{tag_name}, token => $token);  
   
           $self->{insertion_mode} = AFTER_FRAMESET_IM;  
           ## Process in the "after frameset" insertion mode.  
         } else {  
           !!!cp ('t324');  
         }  
   
6598          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6599              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6600            if ($self->{open_elements}->[-1]->[1] & HTML_EL and            if ($self->{open_elements}->[-1]->[1] & HTML_EL and
# Line 6415  sub _tree_construction_main ($) { Line 6629  sub _tree_construction_main ($) {
6629              !!!cp ('t330');              !!!cp ('t330');
6630              !!!parse-error (type => 'in frameset:/',              !!!parse-error (type => 'in frameset:/',
6631                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6632            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6633              !!!cp ('t331');              !!!cp ('t330.1');
6634              !!!parse-error (type => 'after frameset:/',              !!!parse-error (type => 'after frameset:/',
6635                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6636              } else { # "after after html"
6637                !!!cp ('t331');
6638                !!!parse-error (type => 'after after frameset:/',
6639                                text => $token->{tag_name}, token => $token);
6640            }            }
6641            ## Ignore the token            ## Ignore the token
6642            !!!next-token;            !!!next-token;
# Line 7141  sub _tree_construction_main ($) { Line 7359  sub _tree_construction_main ($) {
7359            !!!cp ('t413');            !!!cp ('t413');
7360            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7361                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7362              ## NOTE: Ignore the token.
7363          } else {          } else {
7364            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7365            while ({            while ({
# Line 7200  sub _tree_construction_main ($) { Line 7419  sub _tree_construction_main ($) {
7419            !!!cp ('t421');            !!!cp ('t421');
7420            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7421                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7422              ## NOTE: Ignore the token.
7423          } else {          } else {
7424            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7425            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7246  sub _tree_construction_main ($) { Line 7466  sub _tree_construction_main ($) {
7466            !!!cp ('t425.1');            !!!cp ('t425.1');
7467            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7468                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7469              ## NOTE: Ignore the token.
7470          } else {          } else {
7471            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7472            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7448  sub _tree_construction_main ($) { Line 7669  sub _tree_construction_main ($) {
7669    ## TODO: script stuffs    ## TODO: script stuffs
7670  } # _tree_construct_main  } # _tree_construct_main
7671    
7672  sub set_inner_html ($$$) {  sub set_inner_html ($$$;$) {
7673    my $class = shift;    my $class = shift;
7674    my $node = shift;    my $node = shift;
7675    my $s = \$_[0];    my $s = \$_[0];
7676    my $onerror = $_[1];    my $onerror = $_[1];
7677      my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7678    
7679    ## ISSUE: Should {confident} be true?    ## ISSUE: Should {confident} be true?
7680    
# Line 7471  sub set_inner_html ($$$) { Line 7693  sub set_inner_html ($$$) {
7693      }      }
7694    
7695      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7696      $class->parse_string ($$s => $node, $onerror);      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);
7697    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7698      ## TODO: If non-html element      ## TODO: If non-html element
7699    
7700      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
7701    
7702    ## TODO: Support for $get_wrapper
7703    
7704      ## Step 1 # MUST      ## Step 1 # MUST
7705      my $this_doc = $node->owner_document;      my $this_doc = $node->owner_document;
7706      my $doc = $this_doc->implementation->create_document;      my $doc = $this_doc->implementation->create_document;
Legend:
Removed from v.1.156  
changed lines
  Added in v.1.168
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24