/[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.162 by wakaba, Thu Sep 11 09:12:27 2008 UTC revision 1.179 by wakaba, Sun Sep 14 13:09:01 2008 UTC
# Line 496  sub parse_byte_stream ($$$$;$$) { Line 496  sub parse_byte_stream ($$$$;$$) {
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;      $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},
# Line 561  sub parse_byte_stream ($$$$;$$) { Line 561  sub parse_byte_stream ($$$$;$$) {
561    my $char_onerror = sub {    my $char_onerror = sub {
562      my (undef, $type, %opt) = @_;      my (undef, $type, %opt) = @_;
563      !!!parse-error (layer => 'encode',      !!!parse-error (layer => 'encode',
564                      %opt, type => $type,                      line => $self->{line}, column => $self->{column} + 1,
565                      line => $self->{line}, column => $self->{column} + 1);                      %opt, type => $type);
566      if ($opt{octets}) {      if ($opt{octets}) {
567        ${$opt{octets}} = "\x{FFFD}"; # relacement character        ${$opt{octets}} = "\x{FFFD}"; # relacement character
568      }      }
# Line 586  sub parse_byte_stream ($$$$;$$) { Line 586  sub parse_byte_stream ($$$$;$$) {
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;        $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},
# Line 618  sub parse_byte_stream ($$$$;$$) { Line 618  sub parse_byte_stream ($$$$;$$) {
618  sub parse_char_string ($$$;$$) {  sub parse_char_string ($$$;$$) {
619    #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;    #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
620    my $self = shift;    my $self = shift;
   require utf8;  
621    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $s = ref $_[0] ? $_[0] : \($_[0]);
622    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;    require Whatpm::Charset::DecodeHandle;
623      my $input = Whatpm::Charset::DecodeHandle::CharString->new ($s);
624    if ($_[3]) {    if ($_[3]) {
625      $input = $_[3]->($input);      $input = $_[3]->($input);
626    }    }
# Line 639  sub parse_char_stream ($$$;$) { Line 639  sub parse_char_stream ($$$;$) {
639    $self->{confident} = 1 unless exists $self->{confident};    $self->{confident} = 1 unless exists $self->{confident};
640    $self->{document}->input_encoding ($self->{input_encoding})    $self->{document}->input_encoding ($self->{input_encoding})
641        if defined $self->{input_encoding};        if defined $self->{input_encoding};
642    ## TODO: |{input_encoding}| is needless?
643    
644    my $i = 0;    my $i = 0;
645    $self->{line_prev} = $self->{line} = 1;    $self->{line_prev} = $self->{line} = 1;
646    $self->{column_prev} = $self->{column} = 0;    $self->{column_prev} = -1;
647      $self->{column} = 0;
648    $self->{set_next_char} = sub {    $self->{set_next_char} = sub {
649      my $self = shift;      my $self = shift;
650    
651      pop @{$self->{prev_char}};      my $char = '';
     unshift @{$self->{prev_char}}, $self->{next_char};  
   
     my $char;  
652      if (defined $self->{next_next_char}) {      if (defined $self->{next_next_char}) {
653        $char = $self->{next_next_char};        $char = $self->{next_next_char};
654        delete $self->{next_next_char};        delete $self->{next_next_char};
655          $self->{next_char} = ord $char;
656      } else {      } else {
657        $char = $input->getc;        $self->{char_buffer} = '';
658          $self->{char_buffer_pos} = 0;
659    
660          my $count = $input->manakai_read_until
661             ($self->{char_buffer},
662              qr/(?!\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
663              $self->{char_buffer_pos});
664          if ($count) {
665            $self->{line_prev} = $self->{line};
666            $self->{column_prev} = $self->{column};
667            $self->{column}++;
668            $self->{next_char}
669                = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
670            return;
671          }
672    
673          if ($input->read ($char, 1)) {
674            $self->{next_char} = ord $char;
675          } else {
676            $self->{next_char} = -1;
677            return;
678          }
679      }      }
     $self->{next_char} = -1 and return unless defined $char;  
     $self->{next_char} = ord $char;  
680    
681      ($self->{line_prev}, $self->{column_prev})      ($self->{line_prev}, $self->{column_prev})
682          = ($self->{line}, $self->{column});          = ($self->{line}, $self->{column});
# Line 669  sub parse_char_stream ($$$;$) { Line 688  sub parse_char_stream ($$$;$) {
688        $self->{column} = 0;        $self->{column} = 0;
689      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
690        !!!cp ('j2');        !!!cp ('j2');
691        my $next = $input->getc;  ## TODO: support for abort/streaming
692        if (defined $next and $next ne "\x0A") {        my $next = '';
693          if ($input->read ($next, 1) and $next ne "\x0A") {
694          $self->{next_next_char} = $next;          $self->{next_next_char} = $next;
695        }        }
696        $self->{next_char} = 0x000A; # LF # MUST        $self->{next_char} = 0x000A; # LF # MUST
# Line 688  sub parse_char_stream ($$$;$) { Line 708  sub parse_char_stream ($$$;$) {
708               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or
709               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or
710               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or
711    ## ISSUE: U+FDE0-U+FDEF are not excluded
712               {               {
713                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,
714                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
# Line 712  sub parse_char_stream ($$$;$) { Line 733  sub parse_char_stream ($$$;$) {
733    $self->{prev_char} = [-1, -1, -1];    $self->{prev_char} = [-1, -1, -1];
734    $self->{next_char} = -1;    $self->{next_char} = -1;
735    
736      $self->{read_until} = sub {
737        #my ($scalar, $specials_range, $offset) = @_;
738        my $specials_range = $_[1];
739        return 0 if defined $self->{next_next_char};
740        my $count = $input->manakai_read_until
741           ($_[0],
742            qr/(?![$specials_range\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
743            $_[2]);
744        if ($count) {
745          $self->{column} += $count;
746          $self->{column_prev} += $count;
747          $self->{prev_char} = [-1, -1, -1];
748          $self->{next_char} = -1;
749        }
750        return $count;
751      }; # $self->{read_until}
752    $self->{read_until}=sub{0};
753    
754    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
755      my (%opt) = @_;      my (%opt) = @_;
756      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};
# Line 769  sub RCDATA_CONTENT_MODEL () { CM_ENTITY Line 808  sub RCDATA_CONTENT_MODEL () { CM_ENTITY
808  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
809    
810  sub DATA_STATE () { 0 }  sub DATA_STATE () { 0 }
811  sub ENTITY_DATA_STATE () { 1 }  #sub ENTITY_DATA_STATE () { 1 }
812  sub TAG_OPEN_STATE () { 2 }  sub TAG_OPEN_STATE () { 2 }
813  sub CLOSE_TAG_OPEN_STATE () { 3 }  sub CLOSE_TAG_OPEN_STATE () { 3 }
814  sub TAG_NAME_STATE () { 4 }  sub TAG_NAME_STATE () { 4 }
# Line 780  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 Line 819  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8
819  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
820  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
821  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
822  sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }  #sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
823  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
824  sub COMMENT_START_STATE () { 14 }  sub COMMENT_START_STATE () { 14 }
825  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
# Line 803  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT Line 842  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT
842  sub BOGUS_DOCTYPE_STATE () { 32 }  sub BOGUS_DOCTYPE_STATE () { 32 }
843  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }
844  sub SELF_CLOSING_START_TAG_STATE () { 34 }  sub SELF_CLOSING_START_TAG_STATE () { 34 }
845  sub CDATA_BLOCK_STATE () { 35 }  sub CDATA_SECTION_STATE () { 35 }
846    sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec
847    sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec
848    sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec
849    sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec
850    sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec
851    sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
852    sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec
853    sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec
854    ## NOTE: "Entity data state", "entity in attribute value state", and
855    ## "consume a character reference" algorithm are jointly implemented
856    ## using the following six states:
857    sub ENTITY_STATE () { 44 }
858    sub ENTITY_HASH_STATE () { 45 }
859    sub NCR_NUM_STATE () { 46 }
860    sub HEXREF_X_STATE () { 47 }
861    sub HEXREF_HEX_STATE () { 48 }
862    sub ENTITY_NAME_STATE () { 49 }
863    
864  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
865  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 856  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 912  sub IN_COLUMN_GROUP_IM () { 0b10 }
912  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
913    my $self = shift;    my $self = shift;
914    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
915      #$self->{state_keyword}; # initialized when used
916      #$self->{entity__value}; # initialized when used
917      #$self->{entity__match}; # initialized when used
918    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
919    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
920    undef $self->{current_attribute};    undef $self->{current_attribute};
921    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
922    undef $self->{last_attribute_value_state};    #$self->{prev_state}; # initialized when used
923    delete $self->{self_closing};    delete $self->{self_closing};
924    $self->{char} = [];    $self->{char_buffer} = '';
925      $self->{char_buffer_pos} = 0;
926    # $self->{next_char}    # $self->{next_char}
927    !!!next-input-character;    !!!next-input-character;
928    $self->{token} = [];    $self->{token} = [];
# Line 894  sub _initialize_tokenizer ($) { Line 954  sub _initialize_tokenizer ($) {
954  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
955  ## and removed from the list.  ## and removed from the list.
956    
957  ## NOTE: HTML5 "Writing HTML documents" section, applied to  ## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.)
958  ## documents and not to user agents and conformance checkers,  ## (This requirement was dropped from HTML5 spec, unfortunately.)
 ## contains some requirements that are not detected by the  
 ## parsing algorithm:  
 ## - Some requirements on character encoding declarations. ## TODO  
 ## - "Elements MUST NOT contain content that their content model disallows."  
 ##   ... Some are parse error, some are not (will be reported by c.c.).  
 ## - Polytheistic slash SHOULD NOT be used. (Applied only to atheists.) ## TODO  
 ## - Text (in elements, attributes, and comments) SHOULD NOT contain  
 ##   control characters other than space characters. ## TODO: (what is control character? C0, C1 and DEL?  Unicode control character?)  
   
 ## TODO: HTML5 poses authors two SHOULD-level requirements that cannot  
 ## be detected by the HTML5 parsing algorithm:  
 ## - Text,  
959    
960  sub _get_next_token ($) {  sub _get_next_token ($) {
961    my $self = shift;    my $self = shift;
# Line 931  sub _get_next_token ($) { Line 979  sub _get_next_token ($) {
979          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA
980              not $self->{escape}) {              not $self->{escape}) {
981            !!!cp (1);            !!!cp (1);
982            $self->{state} = ENTITY_DATA_STATE;            ## NOTE: In the spec, the tokenizer is switched to the
983              ## "entity data state".  In this implementation, the tokenizer
984              ## is switched to the |ENTITY_STATE|, which is an implementation
985              ## of the "consume a character reference" algorithm.
986              $self->{entity_additional} = -1;
987              $self->{prev_state} = DATA_STATE;
988              $self->{state} = ENTITY_STATE;
989            !!!next-input-character;            !!!next-input-character;
990            redo A;            redo A;
991          } else {          } else {
# Line 995  sub _get_next_token ($) { Line 1049  sub _get_next_token ($) {
1049                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1050                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1051                    };                    };
1052          $self->{read_until}->($token->{data}, q[-!<>&], length $token->{data});
1053    
1054        ## Stay in the data state        ## Stay in the data state
1055        !!!next-input-character;        !!!next-input-character;
1056    
1057        !!!emit ($token);        !!!emit ($token);
1058    
1059        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;  
1060      } elsif ($self->{state} == TAG_OPEN_STATE) {      } elsif ($self->{state} == TAG_OPEN_STATE) {
1061        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1062          if ($self->{next_char} == 0x002F) { # /          if ($self->{next_char} == 0x002F) { # /
# Line 1118  sub _get_next_token ($) { Line 1153  sub _get_next_token ($) {
1153          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1154        }        }
1155      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1156          ## NOTE: The "close tag open state" in the spec is implemented as
1157          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1158    
1159        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1160        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1161          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1162              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1163            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1164            my @next_char;            ## Reconsume.
1165            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...  
           }  
1166          } else {          } else {
1167            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1168              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1169            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1170            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1171              ## Reconsume.
1172            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1173                      line => $l, column => $c,                      line => $l, column => $c,
1174                     });                     });
1175            redo A;            redo A;
1176          }          }
1177        }        }
1178          
1179        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1180            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1181          !!!cp (29);          !!!cp (29);
# Line 1227  sub _get_next_token ($) { Line 1222  sub _get_next_token ($) {
1222                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1223                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1224                                   };                                   };
1225          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1226          redo A;          ## Although the "anything else" case of the spec not explicitly
1227            ## states that the next input character is to be reconsumed,
1228            ## it will be included to the |data| of the comment token
1229            ## generated from the bogus end tag, as defined in the
1230            ## "bogus comment state" entry.
1231            redo A;
1232          }
1233        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1234          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1235          if (length $ch) {
1236            my $CH = $ch;
1237            $ch =~ tr/a-z/A-Z/;
1238            my $nch = chr $self->{next_char};
1239            if ($nch eq $ch or $nch eq $CH) {
1240              !!!cp (24);
1241              ## Stay in the state.
1242              $self->{state_keyword} .= $nch;
1243              !!!next-input-character;
1244              redo A;
1245            } else {
1246              !!!cp (25);
1247              $self->{state} = DATA_STATE;
1248              ## Reconsume.
1249              !!!emit ({type => CHARACTER_TOKEN,
1250                        data => '</' . $self->{state_keyword},
1251                        line => $self->{line_prev},
1252                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1253                       });
1254              redo A;
1255            }
1256          } else { # after "<{tag-name}"
1257            unless ({
1258                     0x0009 => 1, # HT
1259                     0x000A => 1, # LF
1260                     0x000B => 1, # VT
1261                     0x000C => 1, # FF
1262                     0x0020 => 1, # SP
1263                     0x003E => 1, # >
1264                     0x002F => 1, # /
1265                     -1 => 1, # EOF
1266                    }->{$self->{next_char}}) {
1267              !!!cp (26);
1268              ## Reconsume.
1269              $self->{state} = DATA_STATE;
1270              !!!emit ({type => CHARACTER_TOKEN,
1271                        data => '</' . $self->{state_keyword},
1272                        line => $self->{line_prev},
1273                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1274                       });
1275              redo A;
1276            } else {
1277              !!!cp (27);
1278              $self->{current_token}
1279                  = {type => END_TAG_TOKEN,
1280                     tag_name => $self->{last_emitted_start_tag_name},
1281                     line => $self->{line_prev},
1282                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1283              $self->{state} = TAG_NAME_STATE;
1284              ## Reconsume.
1285              redo A;
1286            }
1287        }        }
1288      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1289        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1675  sub _get_next_token ($) { Line 1730  sub _get_next_token ($) {
1730          redo A;          redo A;
1731        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1732          !!!cp (96);          !!!cp (96);
1733          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1734          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1735            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1736            ## implementation of the "consume a character reference" algorithm.
1737            $self->{prev_state} = $self->{state};
1738            $self->{entity_additional} = 0x0022; # "
1739            $self->{state} = ENTITY_STATE;
1740          !!!next-input-character;          !!!next-input-character;
1741          redo A;          redo A;
1742        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1705  sub _get_next_token ($) { Line 1765  sub _get_next_token ($) {
1765        } else {        } else {
1766          !!!cp (100);          !!!cp (100);
1767          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1768            $self->{read_until}->($self->{current_attribute}->{value},
1769                                  q["&],
1770                                  length $self->{current_attribute}->{value});
1771    
1772          ## Stay in the state          ## Stay in the state
1773          !!!next-input-character;          !!!next-input-character;
1774          redo A;          redo A;
# Line 1717  sub _get_next_token ($) { Line 1781  sub _get_next_token ($) {
1781          redo A;          redo A;
1782        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1783          !!!cp (102);          !!!cp (102);
1784          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1785          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1786            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1787            ## implementation of the "consume a character reference" algorithm.
1788            $self->{entity_additional} = 0x0027; # '
1789            $self->{prev_state} = $self->{state};
1790            $self->{state} = ENTITY_STATE;
1791          !!!next-input-character;          !!!next-input-character;
1792          redo A;          redo A;
1793        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1747  sub _get_next_token ($) { Line 1816  sub _get_next_token ($) {
1816        } else {        } else {
1817          !!!cp (106);          !!!cp (106);
1818          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1819            $self->{read_until}->($self->{current_attribute}->{value},
1820                                  q['&],
1821                                  length $self->{current_attribute}->{value});
1822    
1823          ## Stay in the state          ## Stay in the state
1824          !!!next-input-character;          !!!next-input-character;
1825          redo A;          redo A;
# Line 1763  sub _get_next_token ($) { Line 1836  sub _get_next_token ($) {
1836          redo A;          redo A;
1837        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1838          !!!cp (108);          !!!cp (108);
1839          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1840          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1841            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1842            ## implementation of the "consume a character reference" algorithm.
1843            $self->{entity_additional} = -1;
1844            $self->{prev_state} = $self->{state};
1845            $self->{state} = ENTITY_STATE;
1846          !!!next-input-character;          !!!next-input-character;
1847          redo A;          redo A;
1848        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
# Line 1824  sub _get_next_token ($) { Line 1902  sub _get_next_token ($) {
1902            !!!cp (116);            !!!cp (116);
1903          }          }
1904          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1905            $self->{read_until}->($self->{current_attribute}->{value},
1906                                  q["'=& >],
1907                                  length $self->{current_attribute}->{value});
1908    
1909          ## Stay in the state          ## Stay in the state
1910          !!!next-input-character;          !!!next-input-character;
1911          redo A;          redo A;
1912        }        }
     } 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;  
1913      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {
1914        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
1915            $self->{next_char} == 0x000A or # LF            $self->{next_char} == 0x000A or # LF
# Line 1969  sub _get_next_token ($) { Line 2029  sub _get_next_token ($) {
2029        }        }
2030      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
2031        ## (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  
2032    
2033            redo A;        ## NOTE: Unlike spec's "bogus comment state", this implementation
2034          } elsif ($self->{next_char} == -1) {        ## consumes characters one-by-one basis.
2035            !!!cp (125);        
2036            $self->{state} = DATA_STATE;        if ($self->{next_char} == 0x003E) { # >
2037            ## reconsume          !!!cp (124);
2038            $self->{state} = DATA_STATE;
2039            !!!next-input-character;
2040    
2041            !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
2042            redo A;
2043          } elsif ($self->{next_char} == -1) {
2044            !!!cp (125);
2045            $self->{state} = DATA_STATE;
2046            ## reconsume
2047    
2048            redo A;          !!!emit ($self->{current_token}); # comment
2049          } else {          redo A;
2050            !!!cp (126);        } else {
2051            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          !!!cp (126);
2052            !!!next-input-character;          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2053            redo BC;          $self->{read_until}->($self->{current_token}->{data},
2054          }                                q[>],
2055        } # BC                                length $self->{current_token}->{data});
2056    
2057        die "$0: _get_next_token: unexpected case [BC]";          ## Stay in the state.
2058            !!!next-input-character;
2059            redo A;
2060          }
2061      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2062        ## (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};  
2063                
2064        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2065            !!!cp (133);
2066            $self->{state} = MD_HYPHEN_STATE;
2067          !!!next-input-character;          !!!next-input-character;
2068          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);  
         }  
2069        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2070                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2071            ## ASCII case-insensitive.
2072            !!!cp (130);
2073            $self->{state} = MD_DOCTYPE_STATE;
2074            $self->{state_keyword} = chr $self->{next_char};
2075          !!!next-input-character;          !!!next-input-character;
2076          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);  
         }  
2077        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2078                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2079                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2080            !!!cp (135.4);                
2081            $self->{state} = MD_CDATA_STATE;
2082            $self->{state_keyword} = '[';
2083          !!!next-input-character;          !!!next-input-character;
2084          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);  
         }  
2085        } else {        } else {
2086          !!!cp (136);          !!!cp (136);
2087        }        }
2088    
2089        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2090        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2091        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2092          ## Reconsume.
2093        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2094        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2095                                  line => $l, column => $c,                                  line => $self->{line_prev},
2096                                    column => $self->{column_prev} - 1,
2097                                 };                                 };
2098        redo A;        redo A;
2099              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2100        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2101        ## 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);
2102            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2103                                      line => $self->{line_prev},
2104                                      column => $self->{column_prev} - 2,
2105                                     };
2106            $self->{state} = COMMENT_START_STATE;
2107            !!!next-input-character;
2108            redo A;
2109          } else {
2110            !!!cp (128);
2111            !!!parse-error (type => 'bogus comment',
2112                            line => $self->{line_prev},
2113                            column => $self->{column_prev} - 2);
2114            $self->{state} = BOGUS_COMMENT_STATE;
2115            ## Reconsume.
2116            $self->{current_token} = {type => COMMENT_TOKEN,
2117                                      data => '-',
2118                                      line => $self->{line_prev},
2119                                      column => $self->{column_prev} - 2,
2120                                     };
2121            redo A;
2122          }
2123        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2124          ## ASCII case-insensitive.
2125          if ($self->{next_char} == [
2126                undef,
2127                0x004F, # O
2128                0x0043, # C
2129                0x0054, # T
2130                0x0059, # Y
2131                0x0050, # P
2132              ]->[length $self->{state_keyword}] or
2133              $self->{next_char} == [
2134                undef,
2135                0x006F, # o
2136                0x0063, # c
2137                0x0074, # t
2138                0x0079, # y
2139                0x0070, # p
2140              ]->[length $self->{state_keyword}]) {
2141            !!!cp (131);
2142            ## Stay in the state.
2143            $self->{state_keyword} .= chr $self->{next_char};
2144            !!!next-input-character;
2145            redo A;
2146          } elsif ((length $self->{state_keyword}) == 6 and
2147                   ($self->{next_char} == 0x0045 or # E
2148                    $self->{next_char} == 0x0065)) { # e
2149            !!!cp (129);
2150            $self->{state} = DOCTYPE_STATE;
2151            $self->{current_token} = {type => DOCTYPE_TOKEN,
2152                                      quirks => 1,
2153                                      line => $self->{line_prev},
2154                                      column => $self->{column_prev} - 7,
2155                                     };
2156            !!!next-input-character;
2157            redo A;
2158          } else {
2159            !!!cp (132);        
2160            !!!parse-error (type => 'bogus comment',
2161                            line => $self->{line_prev},
2162                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2163            $self->{state} = BOGUS_COMMENT_STATE;
2164            ## Reconsume.
2165            $self->{current_token} = {type => COMMENT_TOKEN,
2166                                      data => $self->{state_keyword},
2167                                      line => $self->{line_prev},
2168                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2169                                     };
2170            redo A;
2171          }
2172        } elsif ($self->{state} == MD_CDATA_STATE) {
2173          if ($self->{next_char} == {
2174                '[' => 0x0043, # C
2175                '[C' => 0x0044, # D
2176                '[CD' => 0x0041, # A
2177                '[CDA' => 0x0054, # T
2178                '[CDAT' => 0x0041, # A
2179              }->{$self->{state_keyword}}) {
2180            !!!cp (135.1);
2181            ## Stay in the state.
2182            $self->{state_keyword} .= chr $self->{next_char};
2183            !!!next-input-character;
2184            redo A;
2185          } elsif ($self->{state_keyword} eq '[CDATA' and
2186                   $self->{next_char} == 0x005B) { # [
2187            !!!cp (135.2);
2188            $self->{current_token} = {type => CHARACTER_TOKEN,
2189                                      data => '',
2190                                      line => $self->{line_prev},
2191                                      column => $self->{column_prev} - 7};
2192            $self->{state} = CDATA_SECTION_STATE;
2193            !!!next-input-character;
2194            redo A;
2195          } else {
2196            !!!cp (135.3);
2197            !!!parse-error (type => 'bogus comment',
2198                            line => $self->{line_prev},
2199                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2200            $self->{state} = BOGUS_COMMENT_STATE;
2201            ## Reconsume.
2202            $self->{current_token} = {type => COMMENT_TOKEN,
2203                                      data => $self->{state_keyword},
2204                                      line => $self->{line_prev},
2205                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2206                                     };
2207            redo A;
2208          }
2209      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2210        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2211          !!!cp (137);          !!!cp (137);
# Line 2214  sub _get_next_token ($) { Line 2288  sub _get_next_token ($) {
2288        } else {        } else {
2289          !!!cp (147);          !!!cp (147);
2290          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2291            $self->{read_until}->($self->{current_token}->{data},
2292                                  q[-],
2293                                  length $self->{current_token}->{data});
2294    
2295          ## Stay in the state          ## Stay in the state
2296          !!!next-input-character;          !!!next-input-character;
2297          redo A;          redo A;
# Line 2398  sub _get_next_token ($) { Line 2476  sub _get_next_token ($) {
2476          redo A;          redo A;
2477        } elsif ($self->{next_char} == 0x0050 or # P        } elsif ($self->{next_char} == 0x0050 or # P
2478                 $self->{next_char} == 0x0070) { # p                 $self->{next_char} == 0x0070) { # p
2479            $self->{state} = PUBLIC_STATE;
2480            $self->{state_keyword} = chr $self->{next_char};
2481          !!!next-input-character;          !!!next-input-character;
2482          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);  
         }  
   
         #  
2483        } elsif ($self->{next_char} == 0x0053 or # S        } elsif ($self->{next_char} == 0x0053 or # S
2484                 $self->{next_char} == 0x0073) { # s                 $self->{next_char} == 0x0073) { # s
2485            $self->{state} = SYSTEM_STATE;
2486            $self->{state_keyword} = chr $self->{next_char};
2487          !!!next-input-character;          !!!next-input-character;
2488          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);  
         }  
   
         #  
2489        } else {        } else {
2490          !!!cp (180);          !!!cp (180);
2491            !!!parse-error (type => 'string after DOCTYPE name');
2492            $self->{current_token}->{quirks} = 1;
2493    
2494            $self->{state} = BOGUS_DOCTYPE_STATE;
2495          !!!next-input-character;          !!!next-input-character;
2496          #          redo A;
2497        }        }
2498        } elsif ($self->{state} == PUBLIC_STATE) {
2499          ## ASCII case-insensitive
2500          if ($self->{next_char} == [
2501                undef,
2502                0x0055, # U
2503                0x0042, # B
2504                0x004C, # L
2505                0x0049, # I
2506              ]->[length $self->{state_keyword}] or
2507              $self->{next_char} == [
2508                undef,
2509                0x0075, # u
2510                0x0062, # b
2511                0x006C, # l
2512                0x0069, # i
2513              ]->[length $self->{state_keyword}]) {
2514            !!!cp (175);
2515            ## Stay in the state.
2516            $self->{state_keyword} .= chr $self->{next_char};
2517            !!!next-input-character;
2518            redo A;
2519          } elsif ((length $self->{state_keyword}) == 5 and
2520                   ($self->{next_char} == 0x0043 or # C
2521                    $self->{next_char} == 0x0063)) { # c
2522            !!!cp (168);
2523            $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
2524            !!!next-input-character;
2525            redo A;
2526          } else {
2527            !!!cp (169);
2528            !!!parse-error (type => 'string after DOCTYPE name',
2529                            line => $self->{line_prev},
2530                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2531            $self->{current_token}->{quirks} = 1;
2532    
2533        !!!parse-error (type => 'string after DOCTYPE name');          $self->{state} = BOGUS_DOCTYPE_STATE;
2534        $self->{current_token}->{quirks} = 1;          ## Reconsume.
2535            redo A;
2536          }
2537        } elsif ($self->{state} == SYSTEM_STATE) {
2538          ## ASCII case-insensitive
2539          if ($self->{next_char} == [
2540                undef,
2541                0x0059, # Y
2542                0x0053, # S
2543                0x0054, # T
2544                0x0045, # E
2545              ]->[length $self->{state_keyword}] or
2546              $self->{next_char} == [
2547                undef,
2548                0x0079, # y
2549                0x0073, # s
2550                0x0074, # t
2551                0x0065, # e
2552              ]->[length $self->{state_keyword}]) {
2553            !!!cp (170);
2554            ## Stay in the state.
2555            $self->{state_keyword} .= chr $self->{next_char};
2556            !!!next-input-character;
2557            redo A;
2558          } elsif ((length $self->{state_keyword}) == 5 and
2559                   ($self->{next_char} == 0x004D or # M
2560                    $self->{next_char} == 0x006D)) { # m
2561            !!!cp (171);
2562            $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
2563            !!!next-input-character;
2564            redo A;
2565          } else {
2566            !!!cp (172);
2567            !!!parse-error (type => 'string after DOCTYPE name',
2568                            line => $self->{line_prev},
2569                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2570            $self->{current_token}->{quirks} = 1;
2571    
2572        $self->{state} = BOGUS_DOCTYPE_STATE;          $self->{state} = BOGUS_DOCTYPE_STATE;
2573        # next-input-character is already done          ## Reconsume.
2574        redo A;          redo A;
2575          }
2576      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
2577        if ({        if ({
2578              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
# Line 2568  sub _get_next_token ($) { Line 2657  sub _get_next_token ($) {
2657          !!!cp (190);          !!!cp (190);
2658          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2659              .= chr $self->{next_char};              .= chr $self->{next_char};
2660            $self->{read_until}->($self->{current_token}->{public_identifier},
2661                                  q[">],
2662                                  length $self->{current_token}->{public_identifier});
2663    
2664          ## Stay in the state          ## Stay in the state
2665          !!!next-input-character;          !!!next-input-character;
2666          redo A;          redo A;
# Line 2604  sub _get_next_token ($) { Line 2697  sub _get_next_token ($) {
2697          !!!cp (194);          !!!cp (194);
2698          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2699              .= chr $self->{next_char};              .= chr $self->{next_char};
2700            $self->{read_until}->($self->{current_token}->{public_identifier},
2701                                  q['>],
2702                                  length $self->{current_token}->{public_identifier});
2703    
2704          ## Stay in the state          ## Stay in the state
2705          !!!next-input-character;          !!!next-input-character;
2706          redo A;          redo A;
# Line 2740  sub _get_next_token ($) { Line 2837  sub _get_next_token ($) {
2837          !!!cp (210);          !!!cp (210);
2838          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2839              .= chr $self->{next_char};              .= chr $self->{next_char};
2840            $self->{read_until}->($self->{current_token}->{system_identifier},
2841                                  q[">],
2842                                  length $self->{current_token}->{system_identifier});
2843    
2844          ## Stay in the state          ## Stay in the state
2845          !!!next-input-character;          !!!next-input-character;
2846          redo A;          redo A;
# Line 2776  sub _get_next_token ($) { Line 2877  sub _get_next_token ($) {
2877          !!!cp (214);          !!!cp (214);
2878          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2879              .= chr $self->{next_char};              .= chr $self->{next_char};
2880            $self->{read_until}->($self->{current_token}->{system_identifier},
2881                                  q['>],
2882                                  length $self->{current_token}->{system_identifier});
2883    
2884          ## Stay in the state          ## Stay in the state
2885          !!!next-input-character;          !!!next-input-character;
2886          redo A;          redo A;
# Line 2836  sub _get_next_token ($) { Line 2941  sub _get_next_token ($) {
2941          redo A;          redo A;
2942        } else {        } else {
2943          !!!cp (221);          !!!cp (221);
2944            my $s = '';
2945            $self->{read_until}->($s, q[>], 0);
2946    
2947          ## Stay in the state          ## Stay in the state
2948          !!!next-input-character;          !!!next-input-character;
2949          redo A;          redo A;
2950        }        }
2951      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2952        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2953          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2954          ## and |CDATA_SECTION_MSE2_STATE|.
2955                
2956        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2957            !!!cp (221.1);
2958        CS: while ($self->{next_char} != -1) {          $self->{state} = CDATA_SECTION_MSE1_STATE;
2959          if ($self->{next_char} == 0x005D) { # ]          !!!next-input-character;
2960            !!!next-input-character;          redo A;
2961            if ($self->{next_char} == 0x005D) { # ]        } elsif ($self->{next_char} == -1) {
2962              !!!next-input-character;          $self->{state} = DATA_STATE;
             MDC: {  
               if ($self->{next_char} == 0x003E) { # >  
                 !!!cp (221.1);  
                 !!!next-input-character;  
                 last CS;  
               } elsif ($self->{next_char} == 0x005D) { # ]  
                 !!!cp (221.2);  
                 $s .= ']';  
                 !!!next-input-character;  
                 redo MDC;  
               } else {  
                 !!!cp (221.3);  
                 $s .= ']]';  
                 #  
               }  
             } # MDC  
           } else {  
             !!!cp (221.4);  
             $s .= ']';  
             #  
           }  
         } else {  
           !!!cp (221.5);  
           #  
         }  
         $s .= chr $self->{next_char};  
2963          !!!next-input-character;          !!!next-input-character;
2964        } # CS          if (length $self->{current_token}->{data}) { # character
2965              !!!cp (221.2);
2966              !!!emit ($self->{current_token}); # character
2967            } else {
2968              !!!cp (221.3);
2969              ## No token to emit. $self->{current_token} is discarded.
2970            }        
2971            redo A;
2972          } else {
2973            !!!cp (221.4);
2974            $self->{current_token}->{data} .= chr $self->{next_char};
2975            $self->{read_until}->($self->{current_token}->{data},
2976                                  q<]>,
2977                                  length $self->{current_token}->{data});
2978    
2979        $self->{state} = DATA_STATE;          ## Stay in the state.
2980        ## next-input-character done or EOF, which is reconsumed.          !!!next-input-character;
2981            redo A;
2982          }
2983    
2984        if (length $s) {        ## ISSUE: "text tokens" in spec.
2985        } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
2986          if ($self->{next_char} == 0x005D) { # ]
2987            !!!cp (221.5);
2988            $self->{state} = CDATA_SECTION_MSE2_STATE;
2989            !!!next-input-character;
2990            redo A;
2991          } else {
2992          !!!cp (221.6);          !!!cp (221.6);
2993          !!!emit ({type => CHARACTER_TOKEN, data => $s,          $self->{current_token}->{data} .= ']';
2994                    line => $l, column => $c});          $self->{state} = CDATA_SECTION_STATE;
2995            ## Reconsume.
2996            redo A;
2997          }
2998        } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
2999          if ($self->{next_char} == 0x003E) { # >
3000            $self->{state} = DATA_STATE;
3001            !!!next-input-character;
3002            if (length $self->{current_token}->{data}) { # character
3003              !!!cp (221.7);
3004              !!!emit ($self->{current_token}); # character
3005            } else {
3006              !!!cp (221.8);
3007              ## No token to emit. $self->{current_token} is discarded.
3008            }
3009            redo A;
3010          } elsif ($self->{next_char} == 0x005D) { # ]
3011            !!!cp (221.9); # character
3012            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
3013            ## Stay in the state.
3014            !!!next-input-character;
3015            redo A;
3016        } else {        } else {
3017          !!!cp (221.7);          !!!cp (221.11);
3018            $self->{current_token}->{data} .= ']]'; # character
3019            $self->{state} = CDATA_SECTION_STATE;
3020            ## Reconsume.
3021            redo A;
3022          }
3023        } elsif ($self->{state} == ENTITY_STATE) {
3024          if ({
3025            0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
3026            0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, &
3027            $self->{entity_additional} => 1,
3028          }->{$self->{next_char}}) {
3029            !!!cp (1001);
3030            ## Don't consume
3031            ## No error
3032            ## Return nothing.
3033            #
3034          } elsif ($self->{next_char} == 0x0023) { # #
3035            !!!cp (999);
3036            $self->{state} = ENTITY_HASH_STATE;
3037            $self->{state_keyword} = '#';
3038            !!!next-input-character;
3039            redo A;
3040          } elsif ((0x0041 <= $self->{next_char} and
3041                    $self->{next_char} <= 0x005A) or # A..Z
3042                   (0x0061 <= $self->{next_char} and
3043                    $self->{next_char} <= 0x007A)) { # a..z
3044            !!!cp (998);
3045            require Whatpm::_NamedEntityList;
3046            $self->{state} = ENTITY_NAME_STATE;
3047            $self->{state_keyword} = chr $self->{next_char};
3048            $self->{entity__value} = $self->{state_keyword};
3049            $self->{entity__match} = 0;
3050            !!!next-input-character;
3051            redo A;
3052          } else {
3053            !!!cp (1027);
3054            !!!parse-error (type => 'bare ero');
3055            ## Return nothing.
3056            #
3057        }        }
3058    
3059        redo A;        ## NOTE: No character is consumed by the "consume a character
3060          ## reference" algorithm.  In other word, there is an "&" character
3061        ## ISSUE: "text tokens" in spec.        ## that does not introduce a character reference, which would be
3062        ## TODO: Streaming support        ## appended to the parent element or the attribute value in later
3063      } else {        ## process of the tokenizer.
3064        die "$0: $self->{state}: Unknown state";  
3065      }        if ($self->{prev_state} == DATA_STATE) {
3066    } # A            !!!cp (997);
3067            $self->{state} = $self->{prev_state};
3068    die "$0: _get_next_token: unexpected case";          ## Reconsume.
3069  } # _get_next_token          !!!emit ({type => CHARACTER_TOKEN, data => '&',
3070                      line => $self->{line_prev},
3071  sub _tokenize_attempt_to_consume_an_entity ($$$) {                    column => $self->{column_prev},
3072    my ($self, $in_attr, $additional) = @_;                   });
3073            redo A;
3074    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        } else {
3075            !!!cp (996);
3076            $self->{current_attribute}->{value} .= '&';
3077            $self->{state} = $self->{prev_state};
3078            ## Reconsume.
3079            redo A;
3080          }
3081        } elsif ($self->{state} == ENTITY_HASH_STATE) {
3082          if ($self->{next_char} == 0x0078 or # x
3083              $self->{next_char} == 0x0058) { # X
3084            !!!cp (995);
3085            $self->{state} = HEXREF_X_STATE;
3086            $self->{state_keyword} .= chr $self->{next_char};
3087            !!!next-input-character;
3088            redo A;
3089          } elsif (0x0030 <= $self->{next_char} and
3090                   $self->{next_char} <= 0x0039) { # 0..9
3091            !!!cp (994);
3092            $self->{state} = NCR_NUM_STATE;
3093            $self->{state_keyword} = $self->{next_char} - 0x0030;
3094            !!!next-input-character;
3095            redo A;
3096          } else {
3097            !!!parse-error (type => 'bare nero',
3098                            line => $self->{line_prev},
3099                            column => $self->{column_prev} - 1);
3100    
3101    if ({          ## NOTE: According to the spec algorithm, nothing is returned,
3102         0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,          ## and then "&#" is appended to the parent element or the attribute
3103         0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR          ## value in the later processing.
3104         $additional => 1,  
3105        }->{$self->{next_char}}) {          if ($self->{prev_state} == DATA_STATE) {
3106      !!!cp (1001);            !!!cp (1019);
3107      ## Don't consume            $self->{state} = $self->{prev_state};
3108      ## No error            ## Reconsume.
3109      return undef;            !!!emit ({type => CHARACTER_TOKEN,
3110    } elsif ($self->{next_char} == 0x0023) { # #                      data => '&#',
3111      !!!next-input-character;                      line => $self->{line_prev},
3112      if ($self->{next_char} == 0x0078 or # x                      column => $self->{column_prev} - 1,
3113          $self->{next_char} == 0x0058) { # X                     });
3114        my $code;            redo A;
       X: {  
         my $x_char = $self->{next_char};  
         !!!next-input-character;  
         if (0x0030 <= $self->{next_char} and  
             $self->{next_char} <= 0x0039) { # 0..9  
           !!!cp (1002);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0030;  
           redo X;  
         } elsif (0x0061 <= $self->{next_char} and  
                  $self->{next_char} <= 0x0066) { # a..f  
           !!!cp (1003);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0060 + 9;  
           redo X;  
         } elsif (0x0041 <= $self->{next_char} and  
                  $self->{next_char} <= 0x0046) { # A..F  
           !!!cp (1004);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0040 + 9;  
           redo X;  
         } elsif (not defined $code) { # no hexadecimal digit  
           !!!cp (1005);  
           !!!parse-error (type => 'bare hcro', line => $l, column => $c);  
           !!!back-next-input-character ($x_char, $self->{next_char});  
           $self->{next_char} = 0x0023; # #  
           return undef;  
         } elsif ($self->{next_char} == 0x003B) { # ;  
           !!!cp (1006);  
           !!!next-input-character;  
3115          } else {          } else {
3116            !!!cp (1007);            !!!cp (993);
3117            !!!parse-error (type => 'no refc', line => $l, column => $c);            $self->{current_attribute}->{value} .= '&#';
3118              $self->{state} = $self->{prev_state};
3119              ## Reconsume.
3120              redo A;
3121          }          }
3122          }
3123          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {      } elsif ($self->{state} == NCR_NUM_STATE) {
3124            !!!cp (1008);        if (0x0030 <= $self->{next_char} and
3125            !!!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  
3126          !!!cp (1012);          !!!cp (1012);
3127          $code *= 10;          $self->{state_keyword} *= 10;
3128          $code += $self->{next_char} - 0x0030;          $self->{state_keyword} += $self->{next_char} - 0x0030;
3129                    
3130            ## Stay in the state.
3131          !!!next-input-character;          !!!next-input-character;
3132        }          redo A;
3133          } elsif ($self->{next_char} == 0x003B) { # ;
       if ($self->{next_char} == 0x003B) { # ;  
3134          !!!cp (1013);          !!!cp (1013);
3135          !!!next-input-character;          !!!next-input-character;
3136            #
3137        } else {        } else {
3138          !!!cp (1014);          !!!cp (1014);
3139          !!!parse-error (type => 'no refc', line => $l, column => $c);          !!!parse-error (type => 'no refc');
3140            ## Reconsume.
3141            #
3142        }        }
3143    
3144          my $code = $self->{state_keyword};
3145          my $l = $self->{line_prev};
3146          my $c = $self->{column_prev};
3147        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3148          !!!cp (1015);          !!!cp (1015);
3149          !!!parse-error (type => 'invalid character reference',          !!!parse-error (type => 'invalid character reference',
# Line 3032  sub _tokenize_attempt_to_consume_an_enti Line 3168  sub _tokenize_attempt_to_consume_an_enti
3168                          line => $l, column => $c);                          line => $l, column => $c);
3169          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3170        }        }
3171          
3172        return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        if ($self->{prev_state} == DATA_STATE) {
3173                line => $l, column => $c,          !!!cp (992);
3174               };          $self->{state} = $self->{prev_state};
3175      } else {          ## Reconsume.
3176        !!!cp (1019);          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3177        !!!parse-error (type => 'bare nero', line => $l, column => $c);                    line => $l, column => $c,
3178        !!!back-next-input-character ($self->{next_char});                   });
3179        $self->{next_char} = 0x0023; # #          redo A;
3180        return undef;        } else {
3181      }          !!!cp (991);
3182    } elsif ((0x0041 <= $self->{next_char} and          $self->{current_attribute}->{value} .= chr $code;
3183              $self->{next_char} <= 0x005A) or          $self->{current_attribute}->{has_reference} = 1;
3184             (0x0061 <= $self->{next_char} and          $self->{state} = $self->{prev_state};
3185              $self->{next_char} <= 0x007A)) {          ## Reconsume.
3186      my $entity_name = chr $self->{next_char};          redo A;
3187      !!!next-input-character;        }
3188        } elsif ($self->{state} == HEXREF_X_STATE) {
3189      my $value = $entity_name;        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3190      my $match = 0;            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3191      require Whatpm::_NamedEntityList;            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3192      our $EntityChar;          # 0..9, A..F, a..f
3193            !!!cp (990);
3194      while (length $entity_name < 30 and          $self->{state} = HEXREF_HEX_STATE;
3195             ## NOTE: Some number greater than the maximum length of entity name          $self->{state_keyword} = 0;
3196             ((0x0041 <= $self->{next_char} and # a          ## Reconsume.
3197               $self->{next_char} <= 0x005A) or # x          redo A;
3198              (0x0061 <= $self->{next_char} and # a        } else {
3199               $self->{next_char} <= 0x007A) or # z          !!!parse-error (type => 'bare hcro',
3200              (0x0030 <= $self->{next_char} and # 0                          line => $self->{line_prev},
3201               $self->{next_char} <= 0x0039) or # 9                          column => $self->{column_prev} - 2);
3202              $self->{next_char} == 0x003B)) { # ;  
3203        $entity_name .= chr $self->{next_char};          ## NOTE: According to the spec algorithm, nothing is returned,
3204        if (defined $EntityChar->{$entity_name}) {          ## and then "&#" followed by "X" or "x" is appended to the parent
3205          if ($self->{next_char} == 0x003B) { # ;          ## element or the attribute value in the later processing.
3206            !!!cp (1020);  
3207            $value = $EntityChar->{$entity_name};          if ($self->{prev_state} == DATA_STATE) {
3208            $match = 1;            !!!cp (1005);
3209            !!!next-input-character;            $self->{state} = $self->{prev_state};
3210            last;            ## Reconsume.
3211              !!!emit ({type => CHARACTER_TOKEN,
3212                        data => '&' . $self->{state_keyword},
3213                        line => $self->{line_prev},
3214                        column => $self->{column_prev} - length $self->{state_keyword},
3215                       });
3216              redo A;
3217          } else {          } else {
3218            !!!cp (1021);            !!!cp (989);
3219            $value = $EntityChar->{$entity_name};            $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3220            $match = -1;            $self->{state} = $self->{prev_state};
3221              ## Reconsume.
3222              redo A;
3223            }
3224          }
3225        } elsif ($self->{state} == HEXREF_HEX_STATE) {
3226          if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) {
3227            # 0..9
3228            !!!cp (1002);
3229            $self->{state_keyword} *= 0x10;
3230            $self->{state_keyword} += $self->{next_char} - 0x0030;
3231            ## Stay in the state.
3232            !!!next-input-character;
3233            redo A;
3234          } elsif (0x0061 <= $self->{next_char} and
3235                   $self->{next_char} <= 0x0066) { # a..f
3236            !!!cp (1003);
3237            $self->{state_keyword} *= 0x10;
3238            $self->{state_keyword} += $self->{next_char} - 0x0060 + 9;
3239            ## Stay in the state.
3240            !!!next-input-character;
3241            redo A;
3242          } elsif (0x0041 <= $self->{next_char} and
3243                   $self->{next_char} <= 0x0046) { # A..F
3244            !!!cp (1004);
3245            $self->{state_keyword} *= 0x10;
3246            $self->{state_keyword} += $self->{next_char} - 0x0040 + 9;
3247            ## Stay in the state.
3248            !!!next-input-character;
3249            redo A;
3250          } elsif ($self->{next_char} == 0x003B) { # ;
3251            !!!cp (1006);
3252            !!!next-input-character;
3253            #
3254          } else {
3255            !!!cp (1007);
3256            !!!parse-error (type => 'no refc',
3257                            line => $self->{line},
3258                            column => $self->{column});
3259            ## Reconsume.
3260            #
3261          }
3262    
3263          my $code = $self->{state_keyword};
3264          my $l = $self->{line_prev};
3265          my $c = $self->{column_prev};
3266          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3267            !!!cp (1008);
3268            !!!parse-error (type => 'invalid character reference',
3269                            text => (sprintf 'U+%04X', $code),
3270                            line => $l, column => $c);
3271            $code = 0xFFFD;
3272          } elsif ($code > 0x10FFFF) {
3273            !!!cp (1009);
3274            !!!parse-error (type => 'invalid character reference',
3275                            text => (sprintf 'U-%08X', $code),
3276                            line => $l, column => $c);
3277            $code = 0xFFFD;
3278          } elsif ($code == 0x000D) {
3279            !!!cp (1010);
3280            !!!parse-error (type => 'CR character reference', line => $l, column => $c);
3281            $code = 0x000A;
3282          } elsif (0x80 <= $code and $code <= 0x9F) {
3283            !!!cp (1011);
3284            !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);
3285            $code = $c1_entity_char->{$code};
3286          }
3287    
3288          if ($self->{prev_state} == DATA_STATE) {
3289            !!!cp (988);
3290            $self->{state} = $self->{prev_state};
3291            ## Reconsume.
3292            !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3293                      line => $l, column => $c,
3294                     });
3295            redo A;
3296          } else {
3297            !!!cp (987);
3298            $self->{current_attribute}->{value} .= chr $code;
3299            $self->{current_attribute}->{has_reference} = 1;
3300            $self->{state} = $self->{prev_state};
3301            ## Reconsume.
3302            redo A;
3303          }
3304        } elsif ($self->{state} == ENTITY_NAME_STATE) {
3305          if (length $self->{state_keyword} < 30 and
3306              ## NOTE: Some number greater than the maximum length of entity name
3307              ((0x0041 <= $self->{next_char} and # a
3308                $self->{next_char} <= 0x005A) or # x
3309               (0x0061 <= $self->{next_char} and # a
3310                $self->{next_char} <= 0x007A) or # z
3311               (0x0030 <= $self->{next_char} and # 0
3312                $self->{next_char} <= 0x0039) or # 9
3313               $self->{next_char} == 0x003B)) { # ;
3314            our $EntityChar;
3315            $self->{state_keyword} .= chr $self->{next_char};
3316            if (defined $EntityChar->{$self->{state_keyword}}) {
3317              if ($self->{next_char} == 0x003B) { # ;
3318                !!!cp (1020);
3319                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3320                $self->{entity__match} = 1;
3321                !!!next-input-character;
3322                #
3323              } else {
3324                !!!cp (1021);
3325                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3326                $self->{entity__match} = -1;
3327                ## Stay in the state.
3328                !!!next-input-character;
3329                redo A;
3330              }
3331            } else {
3332              !!!cp (1022);
3333              $self->{entity__value} .= chr $self->{next_char};
3334              $self->{entity__match} *= 2;
3335              ## Stay in the state.
3336            !!!next-input-character;            !!!next-input-character;
3337              redo A;
3338            }
3339          }
3340    
3341          my $data;
3342          my $has_ref;
3343          if ($self->{entity__match} > 0) {
3344            !!!cp (1023);
3345            $data = $self->{entity__value};
3346            $has_ref = 1;
3347            #
3348          } elsif ($self->{entity__match} < 0) {
3349            !!!parse-error (type => 'no refc');
3350            if ($self->{prev_state} != DATA_STATE and # in attribute
3351                $self->{entity__match} < -1) {
3352              !!!cp (1024);
3353              $data = '&' . $self->{state_keyword};
3354              #
3355            } else {
3356              !!!cp (1025);
3357              $data = $self->{entity__value};
3358              $has_ref = 1;
3359              #
3360          }          }
3361        } else {        } else {
3362          !!!cp (1022);          !!!cp (1026);
3363          $value .= chr $self->{next_char};          !!!parse-error (type => 'bare ero',
3364          $match *= 2;                          line => $self->{line_prev},
3365          !!!next-input-character;                          column => $self->{column_prev} - length $self->{state_keyword});
3366            $data = '&' . $self->{state_keyword};
3367            #
3368        }        }
3369      }    
3370              ## NOTE: In these cases, when a character reference is found,
3371      if ($match > 0) {        ## it is consumed and a character token is returned, or, otherwise,
3372        !!!cp (1023);        ## nothing is consumed and returned, according to the spec algorithm.
3373        return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        ## In this implementation, anything that has been examined by the
3374                line => $l, column => $c,        ## tokenizer is appended to the parent element or the attribute value
3375               };        ## as string, either literal string when no character reference or
3376      } elsif ($match < 0) {        ## entity-replaced string otherwise, in this stage, since any characters
3377        !!!parse-error (type => 'no refc', line => $l, column => $c);        ## that would not be consumed are appended in the data state or in an
3378        if ($in_attr and $match < -1) {        ## appropriate attribute value state anyway.
3379          !!!cp (1024);  
3380          return {type => CHARACTER_TOKEN, data => '&'.$entity_name,        if ($self->{prev_state} == DATA_STATE) {
3381                  line => $l, column => $c,          !!!cp (986);
3382                 };          $self->{state} = $self->{prev_state};
3383        } else {          ## Reconsume.
3384          !!!cp (1025);          !!!emit ({type => CHARACTER_TOKEN,
3385          return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,                    data => $data,
3386                  line => $l, column => $c,                    line => $self->{line_prev},
3387                 };                    column => $self->{column_prev} + 1 - length $self->{state_keyword},
3388                     });
3389            redo A;
3390          } else {
3391            !!!cp (985);
3392            $self->{current_attribute}->{value} .= $data;
3393            $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3394            $self->{state} = $self->{prev_state};
3395            ## Reconsume.
3396            redo A;
3397        }        }
3398      } else {      } else {
3399        !!!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,  
              };  
3400      }      }
3401    } else {    } # A  
3402      !!!cp (1027);  
3403      ## no characters are consumed    die "$0: _get_next_token: unexpected case";
3404      !!!parse-error (type => 'bare ero', line => $l, column => $c);  } # _get_next_token
     return undef;  
   }  
 } # _tokenize_attempt_to_consume_an_entity  
3405    
3406  sub _initialize_tree_constructor ($) {  sub _initialize_tree_constructor ($) {
3407    my $self = shift;    my $self = shift;
# Line 4217  sub _tree_construction_main ($) { Line 4500  sub _tree_construction_main ($) {
4500            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4501              !!!cp ('t88.2');              !!!cp ('t88.2');
4502              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4503                #
4504            } else {            } else {
4505              !!!cp ('t88.1');              !!!cp ('t88.1');
4506              ## Ignore the token.              ## Ignore the token.
4507              !!!next-token;              #
             next B;  
4508            }            }
4509            unless (length $token->{data}) {            unless (length $token->{data}) {
4510              !!!cp ('t88');              !!!cp ('t88');
4511              !!!next-token;              !!!next-token;
4512              next B;              next B;
4513            }            }
4514    ## TODO: set $token->{column} appropriately
4515          }          }
4516    
4517          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {
# Line 7472  sub _tree_construction_main ($) { Line 7756  sub _tree_construction_main ($) {
7756    ## TODO: script stuffs    ## TODO: script stuffs
7757  } # _tree_construct_main  } # _tree_construct_main
7758    
7759  sub set_inner_html ($$$;$) {  sub set_inner_html ($$$$;$) {
7760    my $class = shift;    my $class = shift;
7761    my $node = shift;    my $node = shift;
7762    my $s = \$_[0];    #my $s = \$_[0];
7763    my $onerror = $_[1];    my $onerror = $_[1];
7764    my $get_wrapper = $_[2] || sub ($) { return $_[0] };    my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7765    
# Line 7496  sub set_inner_html ($$$;$) { Line 7780  sub set_inner_html ($$$;$) {
7780      }      }
7781    
7782      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7783      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);      $class->parse_char_string ($_[0] => $node, $onerror, $get_wrapper);
7784    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7785      ## TODO: If non-html element      ## TODO: If non-html element
7786    
# Line 7515  sub set_inner_html ($$$;$) { Line 7799  sub set_inner_html ($$$;$) {
7799      my $i = 0;      my $i = 0;
7800      $p->{line_prev} = $p->{line} = 1;      $p->{line_prev} = $p->{line} = 1;
7801      $p->{column_prev} = $p->{column} = 0;      $p->{column_prev} = $p->{column} = 0;
7802        require Whatpm::Charset::DecodeHandle;
7803        my $input = Whatpm::Charset::DecodeHandle::CharString->new (\($_[0]));
7804        $input = $get_wrapper->($input);
7805      $p->{set_next_char} = sub {      $p->{set_next_char} = sub {
7806        my $self = shift;        my $self = shift;
7807    
7808        pop @{$self->{prev_char}};        pop @{$self->{prev_char}};
7809        unshift @{$self->{prev_char}}, $self->{next_char};        unshift @{$self->{prev_char}}, $self->{next_char};
7810    
7811        $self->{next_char} = -1 and return if $i >= length $$s;        my $char = '';
7812        $self->{next_char} = ord substr $$s, $i++, 1;        if (defined $self->{next_next_char}) {
7813            $char = $self->{next_next_char};
7814            delete $self->{next_next_char};
7815            $self->{next_char} = ord $char;
7816          } else {
7817            if ($input->read ($char, 1)) {
7818              $self->{next_char} = ord $char;
7819            } else {
7820              $self->{next_char} = -1;
7821              return;
7822            }
7823          }
7824    
7825        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});
7826        $p->{column}++;        $p->{column}++;
# Line 7532  sub set_inner_html ($$$;$) { Line 7830  sub set_inner_html ($$$;$) {
7830          $p->{column} = 0;          $p->{column} = 0;
7831          !!!cp ('i1');          !!!cp ('i1');
7832        } elsif ($self->{next_char} == 0x000D) { # CR        } elsif ($self->{next_char} == 0x000D) { # CR
7833          $i++ if substr ($$s, $i, 1) eq "\x0A";  ## TODO: support for abort/streaming
7834            my $next = '';
7835            if ($input->read ($next, 1) and $next ne "\x0A") {
7836              $self->{next_next_char} = $next;
7837            }
7838          $self->{next_char} = 0x000A; # LF # MUST          $self->{next_char} = 0x000A; # LF # MUST
7839          $p->{line}++;          $p->{line}++;
7840          $p->{column} = 0;          $p->{column} = 0;
# Line 7576  sub set_inner_html ($$$;$) { Line 7878  sub set_inner_html ($$$;$) {
7878      };      };
7879      $p->{prev_char} = [-1, -1, -1];      $p->{prev_char} = [-1, -1, -1];
7880      $p->{next_char} = -1;      $p->{next_char} = -1;
7881        
7882        $p->{read_until} = sub {
7883          #my ($scalar, $specials_range, $offset) = @_;
7884          my $specials_range = $_[1];
7885          return 0 if defined $p->{next_next_char};
7886          my $count = $input->manakai_read_until
7887            ($_[0],
7888             qr/(?![$specials_range\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
7889             $_[2]);
7890          if ($count) {
7891            $p->{column} += $count;
7892            $p->{column_prev} += $count;
7893            $p->{prev_char} = [-1, -1, -1];
7894            $p->{next_char} = -1;
7895          }
7896          return $count;
7897        }; # $p->{read_until}
7898    
7899      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7900        my (%opt) = @_;        my (%opt) = @_;
7901        my $line = $opt{line};        my $line = $opt{line};
# Line 7591  sub set_inner_html ($$$;$) { Line 7910  sub set_inner_html ($$$;$) {
7910        $ponerror->(line => $p->{line}, column => $p->{column}, @_);        $ponerror->(line => $p->{line}, column => $p->{column}, @_);
7911      };      };
7912            
7913        my $char_onerror = sub {
7914          my (undef, $type, %opt) = @_;
7915          $ponerror->(layer => 'encode',
7916                      line => $p->{line}, column => $p->{column} + 1,
7917                      %opt, type => $type);
7918        }; # $char_onerror
7919        $input->onerror ($char_onerror);
7920    
7921      $p->_initialize_tokenizer;      $p->_initialize_tokenizer;
7922      $p->_initialize_tree_constructor;      $p->_initialize_tree_constructor;
7923    
Legend:
Removed from v.1.162  
changed lines
  Added in v.1.179
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24