/[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.157 by wakaba, Sun Aug 31 09:12:30 2008 UTC revision 1.167 by wakaba, Sat Sep 13 09:02:28 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 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    sub ENTITY_STATE () { 44 } # "consume a character reference" in the spec
816    
817  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
818  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 827  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 865  sub IN_COLUMN_GROUP_IM () { 0b10 }
865  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
866    my $self = shift;    my $self = shift;
867    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
868      #$self->{state_keyword}; # initialized when used
869    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
870    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
871    undef $self->{current_attribute};    undef $self->{current_attribute};
872    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
873    undef $self->{last_attribute_value_state};    undef $self->{last_attribute_value_state};
# Line 902  sub _get_next_token ($) { Line 941  sub _get_next_token ($) {
941          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA
942              not $self->{escape}) {              not $self->{escape}) {
943            !!!cp (1);            !!!cp (1);
944            $self->{state} = ENTITY_DATA_STATE;            ## NOTE: In the spec, the tokenizer is switched to the
945              ## "entity data state".  In this implementation, the tokenizer
946              ## is switched to the |ENTITY_STATE|, which is an implementation
947              ## of the "consume a character reference" algorithm.
948              #$self->{state} = ENTITY_DATA_STATE;
949              $self->{entity_in_attr} = 0;
950              $self->{entity_additional} = -1;
951              $self->{state} = ENTITY_STATE;
952            !!!next-input-character;            !!!next-input-character;
953            redo A;            redo A;
954          } else {          } else {
# Line 973  sub _get_next_token ($) { Line 1019  sub _get_next_token ($) {
1019    
1020        redo A;        redo A;
1021      } elsif ($self->{state} == ENTITY_DATA_STATE) {      } elsif ($self->{state} == ENTITY_DATA_STATE) {
       ## (cannot happen in CDATA state)  
   
1022        my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        my ($l, $c) = ($self->{line_prev}, $self->{column_prev});
1023          
1024        my $token = $self->_tokenize_attempt_to_consume_an_entity (0, -1);        my $token = $self->{entity_return};
1025    
1026        $self->{state} = DATA_STATE;        $self->{state} = DATA_STATE;
1027        # next-input-character is already done        # next-input-character is already done
# Line 1089  sub _get_next_token ($) { Line 1133  sub _get_next_token ($) {
1133          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1134        }        }
1135      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1136          ## NOTE: The "close tag open state" in the spec is implemented as
1137          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1138    
1139        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1140        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1141          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1142              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1143            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1144            my @next_char;            ## Reconsume.
1145            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...  
           }  
1146          } else {          } else {
1147            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1148              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1149            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1150            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1151              ## Reconsume.
1152            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1153                      line => $l, column => $c,                      line => $l, column => $c,
1154                     });                     });
1155            redo A;            redo A;
1156          }          }
1157        }        }
1158          
1159        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1160            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1161          !!!cp (29);          !!!cp (29);
# Line 1198  sub _get_next_token ($) { Line 1202  sub _get_next_token ($) {
1202                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1203                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1204                                   };                                   };
1205          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1206          redo A;          ## Although the "anything else" case of the spec not explicitly
1207            ## states that the next input character is to be reconsumed,
1208            ## it will be included to the |data| of the comment token
1209            ## generated from the bogus end tag, as defined in the
1210            ## "bogus comment state" entry.
1211            redo A;
1212          }
1213        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1214          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1215          if (length $ch) {
1216            my $CH = $ch;
1217            $ch =~ tr/a-z/A-Z/;
1218            my $nch = chr $self->{next_char};
1219            if ($nch eq $ch or $nch eq $CH) {
1220              !!!cp (24);
1221              ## Stay in the state.
1222              $self->{state_keyword} .= $nch;
1223              !!!next-input-character;
1224              redo A;
1225            } else {
1226              !!!cp (25);
1227              $self->{state} = DATA_STATE;
1228              ## Reconsume.
1229              !!!emit ({type => CHARACTER_TOKEN,
1230                        data => '</' . $self->{state_keyword},
1231                        line => $self->{line_prev},
1232                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1233                       });
1234              redo A;
1235            }
1236          } else { # after "<{tag-name}"
1237            unless ({
1238                     0x0009 => 1, # HT
1239                     0x000A => 1, # LF
1240                     0x000B => 1, # VT
1241                     0x000C => 1, # FF
1242                     0x0020 => 1, # SP
1243                     0x003E => 1, # >
1244                     0x002F => 1, # /
1245                     -1 => 1, # EOF
1246                    }->{$self->{next_char}}) {
1247              !!!cp (26);
1248              ## Reconsume.
1249              $self->{state} = DATA_STATE;
1250              !!!emit ({type => CHARACTER_TOKEN,
1251                        data => '</' . $self->{state_keyword},
1252                        line => $self->{line_prev},
1253                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1254                       });
1255              redo A;
1256            } else {
1257              !!!cp (27);
1258              $self->{current_token}
1259                  = {type => END_TAG_TOKEN,
1260                     tag_name => $self->{last_emitted_start_tag_name},
1261                     line => $self->{line_prev},
1262                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1263              $self->{state} = TAG_NAME_STATE;
1264              ## Reconsume.
1265              redo A;
1266            }
1267        }        }
1268      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1269        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1647  sub _get_next_token ($) { Line 1711  sub _get_next_token ($) {
1711        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1712          !!!cp (96);          !!!cp (96);
1713          $self->{last_attribute_value_state} = $self->{state};          $self->{last_attribute_value_state} = $self->{state};
1714          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## NOTE: In the spec, the tokenizer is switched to the
1715            ## "entity in attribute value state".  In this implementation, the
1716            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1717            ## implementation of the "consume a character reference" algorithm.
1718            #$self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;
1719            $self->{entity_in_attr} = 1;
1720            $self->{entity_additional} = 0x0022; # "
1721            $self->{state} = ENTITY_STATE;
1722          !!!next-input-character;          !!!next-input-character;
1723          redo A;          redo A;
1724        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1689  sub _get_next_token ($) { Line 1760  sub _get_next_token ($) {
1760        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1761          !!!cp (102);          !!!cp (102);
1762          $self->{last_attribute_value_state} = $self->{state};          $self->{last_attribute_value_state} = $self->{state};
1763          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## NOTE: In the spec, the tokenizer is switched to the
1764            ## "entity in attribute value state".  In this implementation, the
1765            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1766            ## implementation of the "consume a character reference" algorithm.
1767            #$self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;
1768            $self->{entity_in_attr} = 1;
1769            $self->{entity_additional} = 0x0027; # '
1770            $self->{state} = ENTITY_STATE;
1771          !!!next-input-character;          !!!next-input-character;
1772          redo A;          redo A;
1773        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1735  sub _get_next_token ($) { Line 1813  sub _get_next_token ($) {
1813        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1814          !!!cp (108);          !!!cp (108);
1815          $self->{last_attribute_value_state} = $self->{state};          $self->{last_attribute_value_state} = $self->{state};
1816          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## NOTE: In the spec, the tokenizer is switched to the
1817            ## "entity in attribute value state".  In this implementation, the
1818            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1819            ## implementation of the "consume a character reference" algorithm.
1820            #$self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;
1821            $self->{entity_in_attr} = 1;
1822            $self->{entity_additional} = -1;
1823            $self->{state} = ENTITY_STATE;
1824          !!!next-input-character;          !!!next-input-character;
1825          redo A;          redo A;
1826        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
# Line 1800  sub _get_next_token ($) { Line 1885  sub _get_next_token ($) {
1885          redo A;          redo A;
1886        }        }
1887      } elsif ($self->{state} == ENTITY_IN_ATTRIBUTE_VALUE_STATE) {      } elsif ($self->{state} == ENTITY_IN_ATTRIBUTE_VALUE_STATE) {
1888        my $token = $self->_tokenize_attempt_to_consume_an_entity        my $token = $self->{entity_return};
           (1,  
            $self->{last_attribute_value_state}  
              == ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE ? 0x0022 : # "  
            $self->{last_attribute_value_state}  
              == ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE ? 0x0027 : # '  
            -1);  
1889    
1890        unless (defined $token) {        unless (defined $token) {
1891          !!!cp (117);          !!!cp (117);
# Line 1940  sub _get_next_token ($) { Line 2019  sub _get_next_token ($) {
2019        }        }
2020      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
2021        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
         
       ## NOTE: Set by the previous state  
       #my $token = {type => COMMENT_TOKEN, data => ''};  
2022    
2023        BC: {        ## NOTE: Unlike spec's "bogus comment state", this implementation
2024          if ($self->{next_char} == 0x003E) { # >        ## consumes characters one-by-one basis.
2025            !!!cp (124);        
2026            $self->{state} = DATA_STATE;        if ($self->{next_char} == 0x003E) { # >
2027            !!!next-input-character;          !!!cp (124);
2028            $self->{state} = DATA_STATE;
2029            !!!emit ($self->{current_token}); # comment          !!!next-input-character;
   
           redo A;  
         } elsif ($self->{next_char} == -1) {  
           !!!cp (125);  
           $self->{state} = DATA_STATE;  
           ## reconsume  
   
           !!!emit ($self->{current_token}); # comment  
2030    
2031            redo A;          !!!emit ($self->{current_token}); # comment
2032          } else {          redo A;
2033            !!!cp (126);        } elsif ($self->{next_char} == -1) {
2034            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          !!!cp (125);
2035            !!!next-input-character;          $self->{state} = DATA_STATE;
2036            redo BC;          ## reconsume
         }  
       } # BC  
2037    
2038        die "$0: _get_next_token: unexpected case [BC]";          !!!emit ($self->{current_token}); # comment
2039            redo A;
2040          } else {
2041            !!!cp (126);
2042            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2043            ## Stay in the state.
2044            !!!next-input-character;
2045            redo A;
2046          }
2047      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2048        ## (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};  
2049                
2050        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2051            !!!cp (133);
2052            $self->{state} = MD_HYPHEN_STATE;
2053          !!!next-input-character;          !!!next-input-character;
2054          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);  
         }  
2055        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2056                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2057            ## ASCII case-insensitive.
2058            !!!cp (130);
2059            $self->{state} = MD_DOCTYPE_STATE;
2060            $self->{state_keyword} = chr $self->{next_char};
2061          !!!next-input-character;          !!!next-input-character;
2062          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);  
         }  
2063        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2064                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2065                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2066            !!!cp (135.4);                
2067            $self->{state} = MD_CDATA_STATE;
2068            $self->{state_keyword} = '[';
2069          !!!next-input-character;          !!!next-input-character;
2070          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);  
         }  
2071        } else {        } else {
2072          !!!cp (136);          !!!cp (136);
2073        }        }
2074    
2075        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2076        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2077        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2078          ## Reconsume.
2079        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2080        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2081                                  line => $l, column => $c,                                  line => $self->{line_prev},
2082                                    column => $self->{column_prev} - 1,
2083                                 };                                 };
2084        redo A;        redo A;
2085              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2086        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2087        ## 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);
2088            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2089                                      line => $self->{line_prev},
2090                                      column => $self->{column_prev} - 2,
2091                                     };
2092            $self->{state} = COMMENT_START_STATE;
2093            !!!next-input-character;
2094            redo A;
2095          } else {
2096            !!!cp (128);
2097            !!!parse-error (type => 'bogus comment',
2098                            line => $self->{line_prev},
2099                            column => $self->{column_prev} - 2);
2100            $self->{state} = BOGUS_COMMENT_STATE;
2101            ## Reconsume.
2102            $self->{current_token} = {type => COMMENT_TOKEN,
2103                                      data => '-',
2104                                      line => $self->{line_prev},
2105                                      column => $self->{column_prev} - 2,
2106                                     };
2107            redo A;
2108          }
2109        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2110          ## ASCII case-insensitive.
2111          if ($self->{next_char} == [
2112                undef,
2113                0x004F, # O
2114                0x0043, # C
2115                0x0054, # T
2116                0x0059, # Y
2117                0x0050, # P
2118              ]->[length $self->{state_keyword}] or
2119              $self->{next_char} == [
2120                undef,
2121                0x006F, # o
2122                0x0063, # c
2123                0x0074, # t
2124                0x0079, # y
2125                0x0070, # p
2126              ]->[length $self->{state_keyword}]) {
2127            !!!cp (131);
2128            ## Stay in the state.
2129            $self->{state_keyword} .= chr $self->{next_char};
2130            !!!next-input-character;
2131            redo A;
2132          } elsif ((length $self->{state_keyword}) == 6 and
2133                   ($self->{next_char} == 0x0045 or # E
2134                    $self->{next_char} == 0x0065)) { # e
2135            !!!cp (129);
2136            $self->{state} = DOCTYPE_STATE;
2137            $self->{current_token} = {type => DOCTYPE_TOKEN,
2138                                      quirks => 1,
2139                                      line => $self->{line_prev},
2140                                      column => $self->{column_prev} - 7,
2141                                     };
2142            !!!next-input-character;
2143            redo A;
2144          } else {
2145            !!!cp (132);        
2146            !!!parse-error (type => 'bogus comment',
2147                            line => $self->{line_prev},
2148                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2149            $self->{state} = BOGUS_COMMENT_STATE;
2150            ## Reconsume.
2151            $self->{current_token} = {type => COMMENT_TOKEN,
2152                                      data => $self->{state_keyword},
2153                                      line => $self->{line_prev},
2154                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2155                                     };
2156            redo A;
2157          }
2158        } elsif ($self->{state} == MD_CDATA_STATE) {
2159          if ($self->{next_char} == {
2160                '[' => 0x0043, # C
2161                '[C' => 0x0044, # D
2162                '[CD' => 0x0041, # A
2163                '[CDA' => 0x0054, # T
2164                '[CDAT' => 0x0041, # A
2165              }->{$self->{state_keyword}}) {
2166            !!!cp (135.1);
2167            ## Stay in the state.
2168            $self->{state_keyword} .= chr $self->{next_char};
2169            !!!next-input-character;
2170            redo A;
2171          } elsif ($self->{state_keyword} eq '[CDATA' and
2172                   $self->{next_char} == 0x005B) { # [
2173            !!!cp (135.2);
2174            $self->{current_token} = {type => CHARACTER_TOKEN,
2175                                      data => '',
2176                                      line => $self->{line_prev},
2177                                      column => $self->{column_prev} - 7};
2178            $self->{state} = CDATA_SECTION_STATE;
2179            !!!next-input-character;
2180            redo A;
2181          } else {
2182            !!!cp (135.3);
2183            !!!parse-error (type => 'bogus comment',
2184                            line => $self->{line_prev},
2185                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2186            $self->{state} = BOGUS_COMMENT_STATE;
2187            ## Reconsume.
2188            $self->{current_token} = {type => COMMENT_TOKEN,
2189                                      data => $self->{state_keyword},
2190                                      line => $self->{line_prev},
2191                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2192                                     };
2193            redo A;
2194          }
2195      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2196        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2197          !!!cp (137);          !!!cp (137);
# Line 2369  sub _get_next_token ($) { Line 2458  sub _get_next_token ($) {
2458          redo A;          redo A;
2459        } elsif ($self->{next_char} == 0x0050 or # P        } elsif ($self->{next_char} == 0x0050 or # P
2460                 $self->{next_char} == 0x0070) { # p                 $self->{next_char} == 0x0070) { # p
2461            $self->{state} = PUBLIC_STATE;
2462            $self->{state_keyword} = chr $self->{next_char};
2463          !!!next-input-character;          !!!next-input-character;
2464          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);  
         }  
   
         #  
2465        } elsif ($self->{next_char} == 0x0053 or # S        } elsif ($self->{next_char} == 0x0053 or # S
2466                 $self->{next_char} == 0x0073) { # s                 $self->{next_char} == 0x0073) { # s
2467            $self->{state} = SYSTEM_STATE;
2468            $self->{state_keyword} = chr $self->{next_char};
2469          !!!next-input-character;          !!!next-input-character;
2470          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);  
         }  
   
         #  
2471        } else {        } else {
2472          !!!cp (180);          !!!cp (180);
2473            !!!parse-error (type => 'string after DOCTYPE name');
2474            $self->{current_token}->{quirks} = 1;
2475    
2476            $self->{state} = BOGUS_DOCTYPE_STATE;
2477          !!!next-input-character;          !!!next-input-character;
2478          #          redo A;
2479        }        }
2480        } elsif ($self->{state} == PUBLIC_STATE) {
2481          ## ASCII case-insensitive
2482          if ($self->{next_char} == [
2483                undef,
2484                0x0055, # U
2485                0x0042, # B
2486                0x004C, # L
2487                0x0049, # I
2488              ]->[length $self->{state_keyword}] or
2489              $self->{next_char} == [
2490                undef,
2491                0x0075, # u
2492                0x0062, # b
2493                0x006C, # l
2494                0x0069, # i
2495              ]->[length $self->{state_keyword}]) {
2496            !!!cp (175);
2497            ## Stay in the state.
2498            $self->{state_keyword} .= chr $self->{next_char};
2499            !!!next-input-character;
2500            redo A;
2501          } elsif ((length $self->{state_keyword}) == 5 and
2502                   ($self->{next_char} == 0x0043 or # C
2503                    $self->{next_char} == 0x0063)) { # c
2504            !!!cp (168);
2505            $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
2506            !!!next-input-character;
2507            redo A;
2508          } else {
2509            !!!cp (169);
2510            !!!parse-error (type => 'string after DOCTYPE name',
2511                            line => $self->{line_prev},
2512                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2513            $self->{current_token}->{quirks} = 1;
2514    
2515        !!!parse-error (type => 'string after DOCTYPE name');          $self->{state} = BOGUS_DOCTYPE_STATE;
2516        $self->{current_token}->{quirks} = 1;          ## Reconsume.
2517            redo A;
2518          }
2519        } elsif ($self->{state} == SYSTEM_STATE) {
2520          ## ASCII case-insensitive
2521          if ($self->{next_char} == [
2522                undef,
2523                0x0059, # Y
2524                0x0053, # S
2525                0x0054, # T
2526                0x0045, # E
2527              ]->[length $self->{state_keyword}] or
2528              $self->{next_char} == [
2529                undef,
2530                0x0079, # y
2531                0x0073, # s
2532                0x0074, # t
2533                0x0065, # e
2534              ]->[length $self->{state_keyword}]) {
2535            !!!cp (170);
2536            ## Stay in the state.
2537            $self->{state_keyword} .= chr $self->{next_char};
2538            !!!next-input-character;
2539            redo A;
2540          } elsif ((length $self->{state_keyword}) == 5 and
2541                   ($self->{next_char} == 0x004D or # M
2542                    $self->{next_char} == 0x006D)) { # m
2543            !!!cp (171);
2544            $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
2545            !!!next-input-character;
2546            redo A;
2547          } else {
2548            !!!cp (172);
2549            !!!parse-error (type => 'string after DOCTYPE name',
2550                            line => $self->{line_prev},
2551                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2552            $self->{current_token}->{quirks} = 1;
2553    
2554        $self->{state} = BOGUS_DOCTYPE_STATE;          $self->{state} = BOGUS_DOCTYPE_STATE;
2555        # next-input-character is already done          ## Reconsume.
2556        redo A;          redo A;
2557          }
2558      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
2559        if ({        if ({
2560              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 2911  sub _get_next_token ($) {
2911          !!!next-input-character;          !!!next-input-character;
2912          redo A;          redo A;
2913        }        }
2914      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2915        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2916          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2917          ## and |CDATA_SECTION_MSE2_STATE|.
2918                
2919        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2920            !!!cp (221.1);
2921            $self->{state} = CDATA_SECTION_MSE1_STATE;
2922            !!!next-input-character;
2923            redo A;
2924          } elsif ($self->{next_char} == -1) {
2925            $self->{state} = DATA_STATE;
2926            !!!next-input-character;
2927            if (length $self->{current_token}->{data}) { # character
2928              !!!cp (221.2);
2929              !!!emit ($self->{current_token}); # character
2930            } else {
2931              !!!cp (221.3);
2932              ## No token to emit. $self->{current_token} is discarded.
2933            }        
2934            redo A;
2935          } else {
2936            !!!cp (221.4);
2937            $self->{current_token}->{data} .= chr $self->{next_char};
2938            ## Stay in the state.
2939            !!!next-input-character;
2940            redo A;
2941          }
2942    
2943        CS: while ($self->{next_char} != -1) {        ## ISSUE: "text tokens" in spec.
2944          if ($self->{next_char} == 0x005D) { # ]      } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
2945            !!!next-input-character;        if ($self->{next_char} == 0x005D) { # ]
2946            if ($self->{next_char} == 0x005D) { # ]          !!!cp (221.5);
2947              !!!next-input-character;          $self->{state} = CDATA_SECTION_MSE2_STATE;
2948              MDC: {          !!!next-input-character;
2949                if ($self->{next_char} == 0x003E) { # >          redo A;
2950                  !!!cp (221.1);        } else {
2951                  !!!next-input-character;          !!!cp (221.6);
2952                  last CS;          $self->{current_token}->{data} .= ']';
2953                } elsif ($self->{next_char} == 0x005D) { # ]          $self->{state} = CDATA_SECTION_STATE;
2954                  !!!cp (221.2);          ## Reconsume.
2955                  $s .= ']';          redo A;
2956                  !!!next-input-character;        }
2957                  redo MDC;      } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
2958                } else {        if ($self->{next_char} == 0x003E) { # >
2959                  !!!cp (221.3);          $self->{state} = DATA_STATE;
2960                  $s .= ']]';          !!!next-input-character;
2961                  #          if (length $self->{current_token}->{data}) { # character
2962                }            !!!cp (221.7);
2963              } # MDC            !!!emit ($self->{current_token}); # character
           } else {  
             !!!cp (221.4);  
             $s .= ']';  
             #  
           }  
2964          } else {          } else {
2965            !!!cp (221.5);            !!!cp (221.8);
2966            #            ## No token to emit. $self->{current_token} is discarded.
2967          }          }
2968          $s .= chr $self->{next_char};          redo A;
2969          } elsif ($self->{next_char} == 0x005D) { # ]
2970            !!!cp (221.9); # character
2971            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
2972            ## Stay in the state.
2973          !!!next-input-character;          !!!next-input-character;
2974        } # 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});  
2975        } else {        } else {
2976          !!!cp (221.7);          !!!cp (221.11);
2977            $self->{current_token}->{data} .= ']]'; # character
2978            $self->{state} = CDATA_SECTION_STATE;
2979            ## Reconsume.
2980            redo A;
2981        }        }
2982    
2983        redo A;      } elsif ($self->{state} == ENTITY_STATE) {
2984          my $in_attr = $self->{entity_in_attr};
2985        ## ISSUE: "text tokens" in spec.        my $additional = $self->{entity_additional};
       ## TODO: Streaming support  
     } else {  
       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) = @_;  
2986    
2987    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});
2988    
# Line 2886  sub _tokenize_attempt_to_consume_an_enti Line 2994  sub _tokenize_attempt_to_consume_an_enti
2994      !!!cp (1001);      !!!cp (1001);
2995      ## Don't consume      ## Don't consume
2996      ## No error      ## No error
2997      return undef;      $self->{entity_return} = undef;
2998        $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
2999        redo A;
3000    } elsif ($self->{next_char} == 0x0023) { # #    } elsif ($self->{next_char} == 0x0023) { # #
3001      !!!next-input-character;      !!!next-input-character;
3002      if ($self->{next_char} == 0x0078 or # x      if ($self->{next_char} == 0x0078 or # x
# Line 2921  sub _tokenize_attempt_to_consume_an_enti Line 3031  sub _tokenize_attempt_to_consume_an_enti
3031            !!!parse-error (type => 'bare hcro', line => $l, column => $c);            !!!parse-error (type => 'bare hcro', line => $l, column => $c);
3032            !!!back-next-input-character ($x_char, $self->{next_char});            !!!back-next-input-character ($x_char, $self->{next_char});
3033            $self->{next_char} = 0x0023; # #            $self->{next_char} = 0x0023; # #
3034            return undef;            $self->{entity_return} = undef;
3035              $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
3036              redo A;
3037          } elsif ($self->{next_char} == 0x003B) { # ;          } elsif ($self->{next_char} == 0x003B) { # ;
3038            !!!cp (1006);            !!!cp (1006);
3039            !!!next-input-character;            !!!next-input-character;
# Line 2952  sub _tokenize_attempt_to_consume_an_enti Line 3064  sub _tokenize_attempt_to_consume_an_enti
3064            $code = $c1_entity_char->{$code};            $code = $c1_entity_char->{$code};
3065          }          }
3066    
3067          return {type => CHARACTER_TOKEN, data => chr $code,          $self->{entity_return} = {type => CHARACTER_TOKEN, data => chr $code,
3068                  has_reference => 1,                  has_reference => 1,
3069                  line => $l, column => $c,                  line => $l, column => $c,
3070                 };                 };
3071            $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
3072            redo A;
3073        } # X        } # X
3074      } elsif (0x0030 <= $self->{next_char} and      } elsif (0x0030 <= $self->{next_char} and
3075               $self->{next_char} <= 0x0039) { # 0..9               $self->{next_char} <= 0x0039) { # 0..9
# Line 3004  sub _tokenize_attempt_to_consume_an_enti Line 3118  sub _tokenize_attempt_to_consume_an_enti
3118          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3119        }        }
3120                
3121        return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        $self->{entity_return} = {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,
3122                line => $l, column => $c,                line => $l, column => $c,
3123               };               };
3124          $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
3125          redo A;
3126      } else {      } else {
3127        !!!cp (1019);        !!!cp (1019);
3128        !!!parse-error (type => 'bare nero', line => $l, column => $c);        !!!parse-error (type => 'bare nero', line => $l, column => $c);
3129        !!!back-next-input-character ($self->{next_char});        !!!back-next-input-character ($self->{next_char});
3130        $self->{next_char} = 0x0023; # #        $self->{next_char} = 0x0023; # #
3131        return undef;        $self->{entity_return} = undef;
3132          $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
3133          redo A;
3134      }      }
3135    } elsif ((0x0041 <= $self->{next_char} and    } elsif ((0x0041 <= $self->{next_char} and
3136              $self->{next_char} <= 0x005A) or              $self->{next_char} <= 0x005A) or
# Line 3059  sub _tokenize_attempt_to_consume_an_enti Line 3177  sub _tokenize_attempt_to_consume_an_enti
3177            
3178      if ($match > 0) {      if ($match > 0) {
3179        !!!cp (1023);        !!!cp (1023);
3180        return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        $self->{entity_return} = {type => CHARACTER_TOKEN, data => $value, has_reference => 1,
3181                line => $l, column => $c,                line => $l, column => $c,
3182               };               };
3183          $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
3184          redo A;
3185      } elsif ($match < 0) {      } elsif ($match < 0) {
3186        !!!parse-error (type => 'no refc', line => $l, column => $c);        !!!parse-error (type => 'no refc', line => $l, column => $c);
3187        if ($in_attr and $match < -1) {        if ($in_attr and $match < -1) {
3188          !!!cp (1024);          !!!cp (1024);
3189          return {type => CHARACTER_TOKEN, data => '&'.$entity_name,          $self->{entity_return} = {type => CHARACTER_TOKEN, data => '&'.$entity_name,
3190                  line => $l, column => $c,                  line => $l, column => $c,
3191                 };                 };
3192            $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
3193            redo A;
3194        } else {        } else {
3195          !!!cp (1025);          !!!cp (1025);
3196          return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,          $self->{entity_return} = {type => CHARACTER_TOKEN, data => $value, has_reference => 1,
3197                  line => $l, column => $c,                  line => $l, column => $c,
3198                 };                 };
3199            $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
3200            redo A;
3201        }        }
3202      } else {      } else {
3203        !!!cp (1026);        !!!cp (1026);
3204        !!!parse-error (type => 'bare ero', line => $l, column => $c);        !!!parse-error (type => 'bare ero', line => $l, column => $c);
3205        ## NOTE: "No characters are consumed" in the spec.        ## NOTE: "No characters are consumed" in the spec.
3206        return {type => CHARACTER_TOKEN, data => '&'.$value,        $self->{entity_return} = {type => CHARACTER_TOKEN, data => '&'.$value,
3207                line => $l, column => $c,                line => $l, column => $c,
3208               };               };
3209          $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
3210          redo A;
3211      }      }
3212    } else {    } else {
3213      !!!cp (1027);      !!!cp (1027);
3214      ## no characters are consumed      ## no characters are consumed
3215      !!!parse-error (type => 'bare ero', line => $l, column => $c);      !!!parse-error (type => 'bare ero', line => $l, column => $c);
3216      return undef;      $self->{entity_return} = undef;
3217        $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;
3218        redo A;
3219    }    }
3220  } # _tokenize_attempt_to_consume_an_entity  
3221        } else {
3222          die "$0: $self->{state}: Unknown state";
3223        }
3224      } # A  
3225    
3226      die "$0: _get_next_token: unexpected case";
3227    } # _get_next_token
3228    
3229  sub _initialize_tree_constructor ($) {  sub _initialize_tree_constructor ($) {
3230    my $self = shift;    my $self = shift;
# Line 3154  sub _tree_construction_initial ($) { Line 3289  sub _tree_construction_initial ($) {
3289        ## language.        ## language.
3290        my $doctype_name = $token->{name};        my $doctype_name = $token->{name};
3291        $doctype_name = '' unless defined $doctype_name;        $doctype_name = '' unless defined $doctype_name;
3292        $doctype_name =~ tr/a-z/A-Z/;        $doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive
3293        if (not defined $token->{name} or # <!DOCTYPE>        if (not defined $token->{name} or # <!DOCTYPE>
           defined $token->{public_identifier} or  
3294            defined $token->{system_identifier}) {            defined $token->{system_identifier}) {
3295          !!!cp ('t1');          !!!cp ('t1');
3296          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3297        } elsif ($doctype_name ne 'HTML') {        } elsif ($doctype_name ne 'HTML') {
3298          !!!cp ('t2');          !!!cp ('t2');
         ## ISSUE: ASCII case-insensitive? (in fact it does not matter)  
3299          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3300          } elsif (defined $token->{public_identifier}) {
3301            if ($token->{public_identifier} eq 'XSLT-compat') {
3302              !!!cp ('t1.2');
3303              !!!parse-error (type => 'XSLT-compat', token => $token,
3304                              level => $self->{level}->{should});
3305            } else {
3306              !!!parse-error (type => 'not HTML5', token => $token);
3307            }
3308        } else {        } else {
3309          !!!cp ('t3');          !!!cp ('t3');
3310            #
3311        }        }
3312                
3313        my $doctype = $self->{document}->create_document_type_definition        my $doctype = $self->{document}->create_document_type_definition
# Line 6301  sub _tree_construction_main ($) { Line 6443  sub _tree_construction_main ($) {
6443            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6444              !!!cp ('t312');              !!!cp ('t312');
6445              !!!parse-error (type => 'after frameset:#text', token => $token);              !!!parse-error (type => 'after frameset:#text', token => $token);
6446            } else { # "after html frameset"            } else { # "after after frameset"
6447              !!!cp ('t313');              !!!cp ('t313');
6448              !!!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);  
6449            }            }
6450                        
6451            ## Ignore the token.            ## Ignore the token.
# Line 6323  sub _tree_construction_main ($) { Line 6461  sub _tree_construction_main ($) {
6461                    
6462          die qq[$0: Character "$token->{data}"];          die qq[$0: Character "$token->{data}"];
6463        } 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');  
         }  
   
6464          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6465              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6466            !!!cp ('t318');            !!!cp ('t318');
# Line 6354  sub _tree_construction_main ($) { Line 6481  sub _tree_construction_main ($) {
6481            ## NOTE: As if in head.            ## NOTE: As if in head.
6482            $parse_rcdata->(CDATA_CONTENT_MODEL);            $parse_rcdata->(CDATA_CONTENT_MODEL);
6483            next B;            next B;
6484    
6485              ## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>|
6486              ## has no parse error.
6487          } else {          } else {
6488            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6489              !!!cp ('t321');              !!!cp ('t321');
6490              !!!parse-error (type => 'in frameset',              !!!parse-error (type => 'in frameset',
6491                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6492            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6493              !!!cp ('t322');              !!!cp ('t322');
6494              !!!parse-error (type => 'after frameset',              !!!parse-error (type => 'after frameset',
6495                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6496              } else { # "after after frameset"
6497                !!!cp ('t322.2');
6498                !!!parse-error (type => 'after after frameset',
6499                                text => $token->{tag_name}, token => $token);
6500            }            }
6501            ## Ignore the token            ## Ignore the token
6502            !!!nack ('t322.1');            !!!nack ('t322.1');
# Line 6370  sub _tree_construction_main ($) { Line 6504  sub _tree_construction_main ($) {
6504            next B;            next B;
6505          }          }
6506        } 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');  
         }  
   
6507          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6508              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6509            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 6538  sub _tree_construction_main ($) {
6538              !!!cp ('t330');              !!!cp ('t330');
6539              !!!parse-error (type => 'in frameset:/',              !!!parse-error (type => 'in frameset:/',
6540                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6541            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6542              !!!cp ('t331');              !!!cp ('t330.1');
6543              !!!parse-error (type => 'after frameset:/',              !!!parse-error (type => 'after frameset:/',
6544                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6545              } else { # "after after html"
6546                !!!cp ('t331');
6547                !!!parse-error (type => 'after after frameset:/',
6548                                text => $token->{tag_name}, token => $token);
6549            }            }
6550            ## Ignore the token            ## Ignore the token
6551            !!!next-token;            !!!next-token;
# Line 7451  sub _tree_construction_main ($) { Line 7578  sub _tree_construction_main ($) {
7578    ## TODO: script stuffs    ## TODO: script stuffs
7579  } # _tree_construct_main  } # _tree_construct_main
7580    
7581  sub set_inner_html ($$$) {  sub set_inner_html ($$$;$) {
7582    my $class = shift;    my $class = shift;
7583    my $node = shift;    my $node = shift;
7584    my $s = \$_[0];    my $s = \$_[0];
7585    my $onerror = $_[1];    my $onerror = $_[1];
7586      my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7587    
7588    ## ISSUE: Should {confident} be true?    ## ISSUE: Should {confident} be true?
7589    
# Line 7474  sub set_inner_html ($$$) { Line 7602  sub set_inner_html ($$$) {
7602      }      }
7603    
7604      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7605      $class->parse_string ($$s => $node, $onerror);      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);
7606    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7607      ## TODO: If non-html element      ## TODO: If non-html element
7608    
7609      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
7610    
7611    ## TODO: Support for $get_wrapper
7612    
7613      ## Step 1 # MUST      ## Step 1 # MUST
7614      my $this_doc = $node->owner_document;      my $this_doc = $node->owner_document;
7615      my $doc = $this_doc->implementation->create_document;      my $doc = $this_doc->implementation->create_document;
Legend:
Removed from v.1.157  
changed lines
  Added in v.1.167
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24