/[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.177 by wakaba, Sun Sep 14 09:05:54 2008 UTC
# 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 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 669  sub parse_char_stream ($$$;$) { Line 669  sub parse_char_stream ($$$;$) {
669        $self->{column} = 0;        $self->{column} = 0;
670      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
671        !!!cp ('j2');        !!!cp ('j2');
672    ## TODO: support for abort/streaming
673        my $next = $input->getc;        my $next = $input->getc;
674        if (defined $next and $next ne "\x0A") {        if (defined $next and $next ne "\x0A") {
675          $self->{next_next_char} = $next;          $self->{next_next_char} = $next;
# Line 688  sub parse_char_stream ($$$;$) { Line 689  sub parse_char_stream ($$$;$) {
689               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or
690               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or
691               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or
692    ## ISSUE: U+FDE0-U+FDEF are not excluded
693               {               {
694                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,
695                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
# Line 712  sub parse_char_stream ($$$;$) { Line 714  sub parse_char_stream ($$$;$) {
714    $self->{prev_char} = [-1, -1, -1];    $self->{prev_char} = [-1, -1, -1];
715    $self->{next_char} = -1;    $self->{next_char} = -1;
716    
717      $self->{read_until} = sub {
718        #my ($scalar, $specials_range, $offset) = @_;
719        my $specials_range = $_[1];
720        return 0 if defined $self->{next_next_char};
721        my $count = $input->manakai_read_until
722           ($_[0],
723            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}]/,
724            $_[2]);
725        if ($count) {
726          $self->{column} += $count;
727          $self->{column_prev} += $count;
728          $self->{prev_char} = [-1, -1, -1];
729          $self->{next_char} = -1;
730        }
731        return $count;
732      }; # $self->{read_until}
733    
734    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
735      my (%opt) = @_;      my (%opt) = @_;
736      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 788  sub RCDATA_CONTENT_MODEL () { CM_ENTITY
788  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
789    
790  sub DATA_STATE () { 0 }  sub DATA_STATE () { 0 }
791  sub ENTITY_DATA_STATE () { 1 }  #sub ENTITY_DATA_STATE () { 1 }
792  sub TAG_OPEN_STATE () { 2 }  sub TAG_OPEN_STATE () { 2 }
793  sub CLOSE_TAG_OPEN_STATE () { 3 }  sub CLOSE_TAG_OPEN_STATE () { 3 }
794  sub TAG_NAME_STATE () { 4 }  sub TAG_NAME_STATE () { 4 }
# Line 780  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 Line 799  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8
799  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
800  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
801  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
802  sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }  #sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
803  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
804  sub COMMENT_START_STATE () { 14 }  sub COMMENT_START_STATE () { 14 }
805  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
# Line 803  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT Line 822  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT
822  sub BOGUS_DOCTYPE_STATE () { 32 }  sub BOGUS_DOCTYPE_STATE () { 32 }
823  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }
824  sub SELF_CLOSING_START_TAG_STATE () { 34 }  sub SELF_CLOSING_START_TAG_STATE () { 34 }
825  sub CDATA_BLOCK_STATE () { 35 }  sub CDATA_SECTION_STATE () { 35 }
826    sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec
827    sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec
828    sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec
829    sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec
830    sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec
831    sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
832    sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec
833    sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec
834    ## NOTE: "Entity data state", "entity in attribute value state", and
835    ## "consume a character reference" algorithm are jointly implemented
836    ## using the following six states:
837    sub ENTITY_STATE () { 44 }
838    sub ENTITY_HASH_STATE () { 45 }
839    sub NCR_NUM_STATE () { 46 }
840    sub HEXREF_X_STATE () { 47 }
841    sub HEXREF_HEX_STATE () { 48 }
842    sub ENTITY_NAME_STATE () { 49 }
843    
844  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
845  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 856  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 892  sub IN_COLUMN_GROUP_IM () { 0b10 }
892  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
893    my $self = shift;    my $self = shift;
894    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
895      #$self->{state_keyword}; # initialized when used
896      #$self->{entity__value}; # initialized when used
897      #$self->{entity__match}; # initialized when used
898    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
899    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
900    undef $self->{current_attribute};    undef $self->{current_attribute};
901    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
902    undef $self->{last_attribute_value_state};    #$self->{prev_state}; # initialized when used
903    delete $self->{self_closing};    delete $self->{self_closing};
   $self->{char} = [];  
904    # $self->{next_char}    # $self->{next_char}
905    !!!next-input-character;    !!!next-input-character;
906    $self->{token} = [];    $self->{token} = [];
# Line 894  sub _initialize_tokenizer ($) { Line 932  sub _initialize_tokenizer ($) {
932  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
933  ## and removed from the list.  ## and removed from the list.
934    
935  ## NOTE: HTML5 "Writing HTML documents" section, applied to  ## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.)
936  ## 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,  
937    
938  sub _get_next_token ($) {  sub _get_next_token ($) {
939    my $self = shift;    my $self = shift;
# Line 931  sub _get_next_token ($) { Line 957  sub _get_next_token ($) {
957          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA
958              not $self->{escape}) {              not $self->{escape}) {
959            !!!cp (1);            !!!cp (1);
960            $self->{state} = ENTITY_DATA_STATE;            ## NOTE: In the spec, the tokenizer is switched to the
961              ## "entity data state".  In this implementation, the tokenizer
962              ## is switched to the |ENTITY_STATE|, which is an implementation
963              ## of the "consume a character reference" algorithm.
964              $self->{entity_additional} = -1;
965              $self->{prev_state} = DATA_STATE;
966              $self->{state} = ENTITY_STATE;
967            !!!next-input-character;            !!!next-input-character;
968            redo A;            redo A;
969          } else {          } else {
# Line 995  sub _get_next_token ($) { Line 1027  sub _get_next_token ($) {
1027                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1028                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1029                    };                    };
1030          $self->{read_until}->($token->{data}, q[-!<>&], length $token->{data});
1031    
1032        ## Stay in the data state        ## Stay in the data state
1033        !!!next-input-character;        !!!next-input-character;
1034    
1035        !!!emit ($token);        !!!emit ($token);
1036    
1037        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;  
1038      } elsif ($self->{state} == TAG_OPEN_STATE) {      } elsif ($self->{state} == TAG_OPEN_STATE) {
1039        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1040          if ($self->{next_char} == 0x002F) { # /          if ($self->{next_char} == 0x002F) { # /
# Line 1118  sub _get_next_token ($) { Line 1131  sub _get_next_token ($) {
1131          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1132        }        }
1133      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1134          ## NOTE: The "close tag open state" in the spec is implemented as
1135          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1136    
1137        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1138        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1139          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1140              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1141            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1142            my @next_char;            ## Reconsume.
1143            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...  
           }  
1144          } else {          } else {
1145            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1146              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1147            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1148            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1149              ## Reconsume.
1150            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1151                      line => $l, column => $c,                      line => $l, column => $c,
1152                     });                     });
1153            redo A;            redo A;
1154          }          }
1155        }        }
1156          
1157        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1158            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1159          !!!cp (29);          !!!cp (29);
# Line 1227  sub _get_next_token ($) { Line 1200  sub _get_next_token ($) {
1200                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1201                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1202                                   };                                   };
1203          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1204          redo A;          ## Although the "anything else" case of the spec not explicitly
1205            ## states that the next input character is to be reconsumed,
1206            ## it will be included to the |data| of the comment token
1207            ## generated from the bogus end tag, as defined in the
1208            ## "bogus comment state" entry.
1209            redo A;
1210          }
1211        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1212          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1213          if (length $ch) {
1214            my $CH = $ch;
1215            $ch =~ tr/a-z/A-Z/;
1216            my $nch = chr $self->{next_char};
1217            if ($nch eq $ch or $nch eq $CH) {
1218              !!!cp (24);
1219              ## Stay in the state.
1220              $self->{state_keyword} .= $nch;
1221              !!!next-input-character;
1222              redo A;
1223            } else {
1224              !!!cp (25);
1225              $self->{state} = DATA_STATE;
1226              ## Reconsume.
1227              !!!emit ({type => CHARACTER_TOKEN,
1228                        data => '</' . $self->{state_keyword},
1229                        line => $self->{line_prev},
1230                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1231                       });
1232              redo A;
1233            }
1234          } else { # after "<{tag-name}"
1235            unless ({
1236                     0x0009 => 1, # HT
1237                     0x000A => 1, # LF
1238                     0x000B => 1, # VT
1239                     0x000C => 1, # FF
1240                     0x0020 => 1, # SP
1241                     0x003E => 1, # >
1242                     0x002F => 1, # /
1243                     -1 => 1, # EOF
1244                    }->{$self->{next_char}}) {
1245              !!!cp (26);
1246              ## Reconsume.
1247              $self->{state} = DATA_STATE;
1248              !!!emit ({type => CHARACTER_TOKEN,
1249                        data => '</' . $self->{state_keyword},
1250                        line => $self->{line_prev},
1251                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1252                       });
1253              redo A;
1254            } else {
1255              !!!cp (27);
1256              $self->{current_token}
1257                  = {type => END_TAG_TOKEN,
1258                     tag_name => $self->{last_emitted_start_tag_name},
1259                     line => $self->{line_prev},
1260                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1261              $self->{state} = TAG_NAME_STATE;
1262              ## Reconsume.
1263              redo A;
1264            }
1265        }        }
1266      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1267        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1675  sub _get_next_token ($) { Line 1708  sub _get_next_token ($) {
1708          redo A;          redo A;
1709        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1710          !!!cp (96);          !!!cp (96);
1711          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1712          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1713            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1714            ## implementation of the "consume a character reference" algorithm.
1715            $self->{prev_state} = $self->{state};
1716            $self->{entity_additional} = 0x0022; # "
1717            $self->{state} = ENTITY_STATE;
1718          !!!next-input-character;          !!!next-input-character;
1719          redo A;          redo A;
1720        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1705  sub _get_next_token ($) { Line 1743  sub _get_next_token ($) {
1743        } else {        } else {
1744          !!!cp (100);          !!!cp (100);
1745          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1746            $self->{read_until}->($self->{current_attribute}->{value},
1747                                  q["&],
1748                                  length $self->{current_attribute}->{value});
1749    
1750          ## Stay in the state          ## Stay in the state
1751          !!!next-input-character;          !!!next-input-character;
1752          redo A;          redo A;
# Line 1717  sub _get_next_token ($) { Line 1759  sub _get_next_token ($) {
1759          redo A;          redo A;
1760        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1761          !!!cp (102);          !!!cp (102);
1762          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1763          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1764            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1765            ## implementation of the "consume a character reference" algorithm.
1766            $self->{entity_additional} = 0x0027; # '
1767            $self->{prev_state} = $self->{state};
1768            $self->{state} = ENTITY_STATE;
1769          !!!next-input-character;          !!!next-input-character;
1770          redo A;          redo A;
1771        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1747  sub _get_next_token ($) { Line 1794  sub _get_next_token ($) {
1794        } else {        } else {
1795          !!!cp (106);          !!!cp (106);
1796          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1797            $self->{read_until}->($self->{current_attribute}->{value},
1798                                  q['&],
1799                                  length $self->{current_attribute}->{value});
1800    
1801          ## Stay in the state          ## Stay in the state
1802          !!!next-input-character;          !!!next-input-character;
1803          redo A;          redo A;
# Line 1763  sub _get_next_token ($) { Line 1814  sub _get_next_token ($) {
1814          redo A;          redo A;
1815        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1816          !!!cp (108);          !!!cp (108);
1817          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1818          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1819            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1820            ## implementation of the "consume a character reference" algorithm.
1821            $self->{entity_additional} = -1;
1822            $self->{prev_state} = $self->{state};
1823            $self->{state} = ENTITY_STATE;
1824          !!!next-input-character;          !!!next-input-character;
1825          redo A;          redo A;
1826        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
# Line 1824  sub _get_next_token ($) { Line 1880  sub _get_next_token ($) {
1880            !!!cp (116);            !!!cp (116);
1881          }          }
1882          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1883            $self->{read_until}->($self->{current_attribute}->{value},
1884                                  q["'=& >],
1885                                  length $self->{current_attribute}->{value});
1886    
1887          ## Stay in the state          ## Stay in the state
1888          !!!next-input-character;          !!!next-input-character;
1889          redo A;          redo A;
1890        }        }
     } 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;  
1891      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {
1892        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
1893            $self->{next_char} == 0x000A or # LF            $self->{next_char} == 0x000A or # LF
# Line 1969  sub _get_next_token ($) { Line 2007  sub _get_next_token ($) {
2007        }        }
2008      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
2009        ## (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;  
2010    
2011            !!!emit ($self->{current_token}); # comment        ## NOTE: Unlike spec's "bogus comment state", this implementation
2012          ## consumes characters one-by-one basis.
2013            redo A;        
2014          } elsif ($self->{next_char} == -1) {        if ($self->{next_char} == 0x003E) { # >
2015            !!!cp (125);          !!!cp (124);
2016            $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2017            ## reconsume          !!!next-input-character;
2018    
2019            !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
2020            redo A;
2021          } elsif ($self->{next_char} == -1) {
2022            !!!cp (125);
2023            $self->{state} = DATA_STATE;
2024            ## reconsume
2025    
2026            redo A;          !!!emit ($self->{current_token}); # comment
2027          } else {          redo A;
2028            !!!cp (126);        } else {
2029            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          !!!cp (126);
2030            !!!next-input-character;          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2031            redo BC;          $self->{read_until}->($self->{current_token}->{data},
2032          }                                q[>],
2033        } # BC                                length $self->{current_token}->{data});
2034    
2035        die "$0: _get_next_token: unexpected case [BC]";          ## Stay in the state.
2036            !!!next-input-character;
2037            redo A;
2038          }
2039      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2040        ## (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};  
2041                
2042        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2043            !!!cp (133);
2044            $self->{state} = MD_HYPHEN_STATE;
2045          !!!next-input-character;          !!!next-input-character;
2046          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);  
         }  
2047        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2048                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2049            ## ASCII case-insensitive.
2050            !!!cp (130);
2051            $self->{state} = MD_DOCTYPE_STATE;
2052            $self->{state_keyword} = chr $self->{next_char};
2053          !!!next-input-character;          !!!next-input-character;
2054          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);  
         }  
2055        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2056                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2057                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2058            !!!cp (135.4);                
2059            $self->{state} = MD_CDATA_STATE;
2060            $self->{state_keyword} = '[';
2061          !!!next-input-character;          !!!next-input-character;
2062          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);  
         }  
2063        } else {        } else {
2064          !!!cp (136);          !!!cp (136);
2065        }        }
2066    
2067        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2068        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2069        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2070          ## Reconsume.
2071        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2072        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2073                                  line => $l, column => $c,                                  line => $self->{line_prev},
2074                                    column => $self->{column_prev} - 1,
2075                                 };                                 };
2076        redo A;        redo A;
2077              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2078        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2079        ## 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);
2080            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2081                                      line => $self->{line_prev},
2082                                      column => $self->{column_prev} - 2,
2083                                     };
2084            $self->{state} = COMMENT_START_STATE;
2085            !!!next-input-character;
2086            redo A;
2087          } else {
2088            !!!cp (128);
2089            !!!parse-error (type => 'bogus comment',
2090                            line => $self->{line_prev},
2091                            column => $self->{column_prev} - 2);
2092            $self->{state} = BOGUS_COMMENT_STATE;
2093            ## Reconsume.
2094            $self->{current_token} = {type => COMMENT_TOKEN,
2095                                      data => '-',
2096                                      line => $self->{line_prev},
2097                                      column => $self->{column_prev} - 2,
2098                                     };
2099            redo A;
2100          }
2101        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2102          ## ASCII case-insensitive.
2103          if ($self->{next_char} == [
2104                undef,
2105                0x004F, # O
2106                0x0043, # C
2107                0x0054, # T
2108                0x0059, # Y
2109                0x0050, # P
2110              ]->[length $self->{state_keyword}] or
2111              $self->{next_char} == [
2112                undef,
2113                0x006F, # o
2114                0x0063, # c
2115                0x0074, # t
2116                0x0079, # y
2117                0x0070, # p
2118              ]->[length $self->{state_keyword}]) {
2119            !!!cp (131);
2120            ## Stay in the state.
2121            $self->{state_keyword} .= chr $self->{next_char};
2122            !!!next-input-character;
2123            redo A;
2124          } elsif ((length $self->{state_keyword}) == 6 and
2125                   ($self->{next_char} == 0x0045 or # E
2126                    $self->{next_char} == 0x0065)) { # e
2127            !!!cp (129);
2128            $self->{state} = DOCTYPE_STATE;
2129            $self->{current_token} = {type => DOCTYPE_TOKEN,
2130                                      quirks => 1,
2131                                      line => $self->{line_prev},
2132                                      column => $self->{column_prev} - 7,
2133                                     };
2134            !!!next-input-character;
2135            redo A;
2136          } else {
2137            !!!cp (132);        
2138            !!!parse-error (type => 'bogus comment',
2139                            line => $self->{line_prev},
2140                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2141            $self->{state} = BOGUS_COMMENT_STATE;
2142            ## Reconsume.
2143            $self->{current_token} = {type => COMMENT_TOKEN,
2144                                      data => $self->{state_keyword},
2145                                      line => $self->{line_prev},
2146                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2147                                     };
2148            redo A;
2149          }
2150        } elsif ($self->{state} == MD_CDATA_STATE) {
2151          if ($self->{next_char} == {
2152                '[' => 0x0043, # C
2153                '[C' => 0x0044, # D
2154                '[CD' => 0x0041, # A
2155                '[CDA' => 0x0054, # T
2156                '[CDAT' => 0x0041, # A
2157              }->{$self->{state_keyword}}) {
2158            !!!cp (135.1);
2159            ## Stay in the state.
2160            $self->{state_keyword} .= chr $self->{next_char};
2161            !!!next-input-character;
2162            redo A;
2163          } elsif ($self->{state_keyword} eq '[CDATA' and
2164                   $self->{next_char} == 0x005B) { # [
2165            !!!cp (135.2);
2166            $self->{current_token} = {type => CHARACTER_TOKEN,
2167                                      data => '',
2168                                      line => $self->{line_prev},
2169                                      column => $self->{column_prev} - 7};
2170            $self->{state} = CDATA_SECTION_STATE;
2171            !!!next-input-character;
2172            redo A;
2173          } else {
2174            !!!cp (135.3);
2175            !!!parse-error (type => 'bogus comment',
2176                            line => $self->{line_prev},
2177                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2178            $self->{state} = BOGUS_COMMENT_STATE;
2179            ## Reconsume.
2180            $self->{current_token} = {type => COMMENT_TOKEN,
2181                                      data => $self->{state_keyword},
2182                                      line => $self->{line_prev},
2183                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2184                                     };
2185            redo A;
2186          }
2187      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2188        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2189          !!!cp (137);          !!!cp (137);
# Line 2214  sub _get_next_token ($) { Line 2266  sub _get_next_token ($) {
2266        } else {        } else {
2267          !!!cp (147);          !!!cp (147);
2268          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2269            $self->{read_until}->($self->{current_token}->{data},
2270                                  q[-],
2271                                  length $self->{current_token}->{data});
2272    
2273          ## Stay in the state          ## Stay in the state
2274          !!!next-input-character;          !!!next-input-character;
2275          redo A;          redo A;
# Line 2398  sub _get_next_token ($) { Line 2454  sub _get_next_token ($) {
2454          redo A;          redo A;
2455        } elsif ($self->{next_char} == 0x0050 or # P        } elsif ($self->{next_char} == 0x0050 or # P
2456                 $self->{next_char} == 0x0070) { # p                 $self->{next_char} == 0x0070) { # p
2457            $self->{state} = PUBLIC_STATE;
2458            $self->{state_keyword} = chr $self->{next_char};
2459          !!!next-input-character;          !!!next-input-character;
2460          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);  
         }  
   
         #  
2461        } elsif ($self->{next_char} == 0x0053 or # S        } elsif ($self->{next_char} == 0x0053 or # S
2462                 $self->{next_char} == 0x0073) { # s                 $self->{next_char} == 0x0073) { # s
2463            $self->{state} = SYSTEM_STATE;
2464            $self->{state_keyword} = chr $self->{next_char};
2465          !!!next-input-character;          !!!next-input-character;
2466          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);  
         }  
   
         #  
2467        } else {        } else {
2468          !!!cp (180);          !!!cp (180);
2469            !!!parse-error (type => 'string after DOCTYPE name');
2470            $self->{current_token}->{quirks} = 1;
2471    
2472            $self->{state} = BOGUS_DOCTYPE_STATE;
2473          !!!next-input-character;          !!!next-input-character;
2474          #          redo A;
2475        }        }
2476        } elsif ($self->{state} == PUBLIC_STATE) {
2477          ## ASCII case-insensitive
2478          if ($self->{next_char} == [
2479                undef,
2480                0x0055, # U
2481                0x0042, # B
2482                0x004C, # L
2483                0x0049, # I
2484              ]->[length $self->{state_keyword}] or
2485              $self->{next_char} == [
2486                undef,
2487                0x0075, # u
2488                0x0062, # b
2489                0x006C, # l
2490                0x0069, # i
2491              ]->[length $self->{state_keyword}]) {
2492            !!!cp (175);
2493            ## Stay in the state.
2494            $self->{state_keyword} .= chr $self->{next_char};
2495            !!!next-input-character;
2496            redo A;
2497          } elsif ((length $self->{state_keyword}) == 5 and
2498                   ($self->{next_char} == 0x0043 or # C
2499                    $self->{next_char} == 0x0063)) { # c
2500            !!!cp (168);
2501            $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
2502            !!!next-input-character;
2503            redo A;
2504          } else {
2505            !!!cp (169);
2506            !!!parse-error (type => 'string after DOCTYPE name',
2507                            line => $self->{line_prev},
2508                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2509            $self->{current_token}->{quirks} = 1;
2510    
2511        !!!parse-error (type => 'string after DOCTYPE name');          $self->{state} = BOGUS_DOCTYPE_STATE;
2512        $self->{current_token}->{quirks} = 1;          ## Reconsume.
2513            redo A;
2514          }
2515        } elsif ($self->{state} == SYSTEM_STATE) {
2516          ## ASCII case-insensitive
2517          if ($self->{next_char} == [
2518                undef,
2519                0x0059, # Y
2520                0x0053, # S
2521                0x0054, # T
2522                0x0045, # E
2523              ]->[length $self->{state_keyword}] or
2524              $self->{next_char} == [
2525                undef,
2526                0x0079, # y
2527                0x0073, # s
2528                0x0074, # t
2529                0x0065, # e
2530              ]->[length $self->{state_keyword}]) {
2531            !!!cp (170);
2532            ## Stay in the state.
2533            $self->{state_keyword} .= chr $self->{next_char};
2534            !!!next-input-character;
2535            redo A;
2536          } elsif ((length $self->{state_keyword}) == 5 and
2537                   ($self->{next_char} == 0x004D or # M
2538                    $self->{next_char} == 0x006D)) { # m
2539            !!!cp (171);
2540            $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
2541            !!!next-input-character;
2542            redo A;
2543          } else {
2544            !!!cp (172);
2545            !!!parse-error (type => 'string after DOCTYPE name',
2546                            line => $self->{line_prev},
2547                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2548            $self->{current_token}->{quirks} = 1;
2549    
2550        $self->{state} = BOGUS_DOCTYPE_STATE;          $self->{state} = BOGUS_DOCTYPE_STATE;
2551        # next-input-character is already done          ## Reconsume.
2552        redo A;          redo A;
2553          }
2554      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
2555        if ({        if ({
2556              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 2635  sub _get_next_token ($) {
2635          !!!cp (190);          !!!cp (190);
2636          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2637              .= chr $self->{next_char};              .= chr $self->{next_char};
2638            $self->{read_until}->($self->{current_token}->{public_identifier},
2639                                  q[">],
2640                                  length $self->{current_token}->{public_identifier});
2641    
2642          ## Stay in the state          ## Stay in the state
2643          !!!next-input-character;          !!!next-input-character;
2644          redo A;          redo A;
# Line 2604  sub _get_next_token ($) { Line 2675  sub _get_next_token ($) {
2675          !!!cp (194);          !!!cp (194);
2676          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2677              .= chr $self->{next_char};              .= chr $self->{next_char};
2678            $self->{read_until}->($self->{current_token}->{public_identifier},
2679                                  q['>],
2680                                  length $self->{current_token}->{public_identifier});
2681    
2682          ## Stay in the state          ## Stay in the state
2683          !!!next-input-character;          !!!next-input-character;
2684          redo A;          redo A;
# Line 2740  sub _get_next_token ($) { Line 2815  sub _get_next_token ($) {
2815          !!!cp (210);          !!!cp (210);
2816          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2817              .= chr $self->{next_char};              .= chr $self->{next_char};
2818            $self->{read_until}->($self->{current_token}->{system_identifier},
2819                                  q[">],
2820                                  length $self->{current_token}->{system_identifier});
2821    
2822          ## Stay in the state          ## Stay in the state
2823          !!!next-input-character;          !!!next-input-character;
2824          redo A;          redo A;
# Line 2776  sub _get_next_token ($) { Line 2855  sub _get_next_token ($) {
2855          !!!cp (214);          !!!cp (214);
2856          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2857              .= chr $self->{next_char};              .= chr $self->{next_char};
2858            $self->{read_until}->($self->{current_token}->{system_identifier},
2859                                  q['>],
2860                                  length $self->{current_token}->{system_identifier});
2861    
2862          ## Stay in the state          ## Stay in the state
2863          !!!next-input-character;          !!!next-input-character;
2864          redo A;          redo A;
# Line 2836  sub _get_next_token ($) { Line 2919  sub _get_next_token ($) {
2919          redo A;          redo A;
2920        } else {        } else {
2921          !!!cp (221);          !!!cp (221);
2922            my $s = '';
2923            $self->{read_until}->($s, q[>], 0);
2924    
2925          ## Stay in the state          ## Stay in the state
2926          !!!next-input-character;          !!!next-input-character;
2927          redo A;          redo A;
2928        }        }
2929      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2930        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2931          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2932          ## and |CDATA_SECTION_MSE2_STATE|.
2933                
2934        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2935            !!!cp (221.1);
2936        CS: while ($self->{next_char} != -1) {          $self->{state} = CDATA_SECTION_MSE1_STATE;
         if ($self->{next_char} == 0x005D) { # ]  
           !!!next-input-character;  
           if ($self->{next_char} == 0x005D) { # ]  
             !!!next-input-character;  
             MDC: {  
               if ($self->{next_char} == 0x003E) { # >  
                 !!!cp (221.1);  
                 !!!next-input-character;  
                 last CS;  
               } elsif ($self->{next_char} == 0x005D) { # ]  
                 !!!cp (221.2);  
                 $s .= ']';  
                 !!!next-input-character;  
                 redo MDC;  
               } else {  
                 !!!cp (221.3);  
                 $s .= ']]';  
                 #  
               }  
             } # MDC  
           } else {  
             !!!cp (221.4);  
             $s .= ']';  
             #  
           }  
         } else {  
           !!!cp (221.5);  
           #  
         }  
         $s .= chr $self->{next_char};  
2937          !!!next-input-character;          !!!next-input-character;
2938        } # CS          redo A;
2939          } elsif ($self->{next_char} == -1) {
2940            $self->{state} = DATA_STATE;
2941            !!!next-input-character;
2942            if (length $self->{current_token}->{data}) { # character
2943              !!!cp (221.2);
2944              !!!emit ($self->{current_token}); # character
2945            } else {
2946              !!!cp (221.3);
2947              ## No token to emit. $self->{current_token} is discarded.
2948            }        
2949            redo A;
2950          } else {
2951            !!!cp (221.4);
2952            $self->{current_token}->{data} .= chr $self->{next_char};
2953            $self->{read_until}->($self->{current_token}->{data},
2954                                  q<]>,
2955                                  length $self->{current_token}->{data});
2956    
2957        $self->{state} = DATA_STATE;          ## Stay in the state.
2958        ## next-input-character done or EOF, which is reconsumed.          !!!next-input-character;
2959            redo A;
2960          }
2961    
2962        if (length $s) {        ## ISSUE: "text tokens" in spec.
2963        } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
2964          if ($self->{next_char} == 0x005D) { # ]
2965            !!!cp (221.5);
2966            $self->{state} = CDATA_SECTION_MSE2_STATE;
2967            !!!next-input-character;
2968            redo A;
2969          } else {
2970          !!!cp (221.6);          !!!cp (221.6);
2971          !!!emit ({type => CHARACTER_TOKEN, data => $s,          $self->{current_token}->{data} .= ']';
2972                    line => $l, column => $c});          $self->{state} = CDATA_SECTION_STATE;
2973            ## Reconsume.
2974            redo A;
2975          }
2976        } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
2977          if ($self->{next_char} == 0x003E) { # >
2978            $self->{state} = DATA_STATE;
2979            !!!next-input-character;
2980            if (length $self->{current_token}->{data}) { # character
2981              !!!cp (221.7);
2982              !!!emit ($self->{current_token}); # character
2983            } else {
2984              !!!cp (221.8);
2985              ## No token to emit. $self->{current_token} is discarded.
2986            }
2987            redo A;
2988          } elsif ($self->{next_char} == 0x005D) { # ]
2989            !!!cp (221.9); # character
2990            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
2991            ## Stay in the state.
2992            !!!next-input-character;
2993            redo A;
2994        } else {        } else {
2995          !!!cp (221.7);          !!!cp (221.11);
2996            $self->{current_token}->{data} .= ']]'; # character
2997            $self->{state} = CDATA_SECTION_STATE;
2998            ## Reconsume.
2999            redo A;
3000          }
3001        } elsif ($self->{state} == ENTITY_STATE) {
3002          if ({
3003            0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
3004            0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, &
3005            $self->{entity_additional} => 1,
3006          }->{$self->{next_char}}) {
3007            !!!cp (1001);
3008            ## Don't consume
3009            ## No error
3010            ## Return nothing.
3011            #
3012          } elsif ($self->{next_char} == 0x0023) { # #
3013            !!!cp (999);
3014            $self->{state} = ENTITY_HASH_STATE;
3015            $self->{state_keyword} = '#';
3016            !!!next-input-character;
3017            redo A;
3018          } elsif ((0x0041 <= $self->{next_char} and
3019                    $self->{next_char} <= 0x005A) or # A..Z
3020                   (0x0061 <= $self->{next_char} and
3021                    $self->{next_char} <= 0x007A)) { # a..z
3022            !!!cp (998);
3023            require Whatpm::_NamedEntityList;
3024            $self->{state} = ENTITY_NAME_STATE;
3025            $self->{state_keyword} = chr $self->{next_char};
3026            $self->{entity__value} = $self->{state_keyword};
3027            $self->{entity__match} = 0;
3028            !!!next-input-character;
3029            redo A;
3030          } else {
3031            !!!cp (1027);
3032            !!!parse-error (type => 'bare ero');
3033            ## Return nothing.
3034            #
3035        }        }
3036    
3037        redo A;        ## NOTE: No character is consumed by the "consume a character
3038          ## reference" algorithm.  In other word, there is an "&" character
3039        ## ISSUE: "text tokens" in spec.        ## that does not introduce a character reference, which would be
3040        ## TODO: Streaming support        ## appended to the parent element or the attribute value in later
3041      } else {        ## process of the tokenizer.
3042        die "$0: $self->{state}: Unknown state";  
3043      }        if ($self->{prev_state} == DATA_STATE) {
3044    } # A            !!!cp (997);
3045            $self->{state} = $self->{prev_state};
3046    die "$0: _get_next_token: unexpected case";          ## Reconsume.
3047  } # _get_next_token          !!!emit ({type => CHARACTER_TOKEN, data => '&',
3048                      line => $self->{line_prev},
3049  sub _tokenize_attempt_to_consume_an_entity ($$$) {                    column => $self->{column_prev},
3050    my ($self, $in_attr, $additional) = @_;                   });
3051            redo A;
3052    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        } else {
3053            !!!cp (996);
3054            $self->{current_attribute}->{value} .= '&';
3055            $self->{state} = $self->{prev_state};
3056            ## Reconsume.
3057            redo A;
3058          }
3059        } elsif ($self->{state} == ENTITY_HASH_STATE) {
3060          if ($self->{next_char} == 0x0078 or # x
3061              $self->{next_char} == 0x0058) { # X
3062            !!!cp (995);
3063            $self->{state} = HEXREF_X_STATE;
3064            $self->{state_keyword} .= chr $self->{next_char};
3065            !!!next-input-character;
3066            redo A;
3067          } elsif (0x0030 <= $self->{next_char} and
3068                   $self->{next_char} <= 0x0039) { # 0..9
3069            !!!cp (994);
3070            $self->{state} = NCR_NUM_STATE;
3071            $self->{state_keyword} = $self->{next_char} - 0x0030;
3072            !!!next-input-character;
3073            redo A;
3074          } else {
3075            !!!parse-error (type => 'bare nero',
3076                            line => $self->{line_prev},
3077                            column => $self->{column_prev} - 1);
3078    
3079    if ({          ## NOTE: According to the spec algorithm, nothing is returned,
3080         0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,          ## and then "&#" is appended to the parent element or the attribute
3081         0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR          ## value in the later processing.
3082         $additional => 1,  
3083        }->{$self->{next_char}}) {          if ($self->{prev_state} == DATA_STATE) {
3084      !!!cp (1001);            !!!cp (1019);
3085      ## Don't consume            $self->{state} = $self->{prev_state};
3086      ## No error            ## Reconsume.
3087      return undef;            !!!emit ({type => CHARACTER_TOKEN,
3088    } elsif ($self->{next_char} == 0x0023) { # #                      data => '&#',
3089      !!!next-input-character;                      line => $self->{line_prev},
3090      if ($self->{next_char} == 0x0078 or # x                      column => $self->{column_prev} - 1,
3091          $self->{next_char} == 0x0058) { # X                     });
3092        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;  
3093          } else {          } else {
3094            !!!cp (1007);            !!!cp (993);
3095            !!!parse-error (type => 'no refc', line => $l, column => $c);            $self->{current_attribute}->{value} .= '&#';
3096              $self->{state} = $self->{prev_state};
3097              ## Reconsume.
3098              redo A;
3099          }          }
3100          }
3101          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {      } elsif ($self->{state} == NCR_NUM_STATE) {
3102            !!!cp (1008);        if (0x0030 <= $self->{next_char} and
3103            !!!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  
3104          !!!cp (1012);          !!!cp (1012);
3105          $code *= 10;          $self->{state_keyword} *= 10;
3106          $code += $self->{next_char} - 0x0030;          $self->{state_keyword} += $self->{next_char} - 0x0030;
3107                    
3108            ## Stay in the state.
3109          !!!next-input-character;          !!!next-input-character;
3110        }          redo A;
3111          } elsif ($self->{next_char} == 0x003B) { # ;
       if ($self->{next_char} == 0x003B) { # ;  
3112          !!!cp (1013);          !!!cp (1013);
3113          !!!next-input-character;          !!!next-input-character;
3114            #
3115        } else {        } else {
3116          !!!cp (1014);          !!!cp (1014);
3117          !!!parse-error (type => 'no refc', line => $l, column => $c);          !!!parse-error (type => 'no refc');
3118            ## Reconsume.
3119            #
3120        }        }
3121    
3122          my $code = $self->{state_keyword};
3123          my $l = $self->{line_prev};
3124          my $c = $self->{column_prev};
3125        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3126          !!!cp (1015);          !!!cp (1015);
3127          !!!parse-error (type => 'invalid character reference',          !!!parse-error (type => 'invalid character reference',
# Line 3032  sub _tokenize_attempt_to_consume_an_enti Line 3146  sub _tokenize_attempt_to_consume_an_enti
3146                          line => $l, column => $c);                          line => $l, column => $c);
3147          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3148        }        }
3149          
3150        return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        if ($self->{prev_state} == DATA_STATE) {
3151                line => $l, column => $c,          !!!cp (992);
3152               };          $self->{state} = $self->{prev_state};
3153      } else {          ## Reconsume.
3154        !!!cp (1019);          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3155        !!!parse-error (type => 'bare nero', line => $l, column => $c);                    line => $l, column => $c,
3156        !!!back-next-input-character ($self->{next_char});                   });
3157        $self->{next_char} = 0x0023; # #          redo A;
3158        return undef;        } else {
3159      }          !!!cp (991);
3160    } elsif ((0x0041 <= $self->{next_char} and          $self->{current_attribute}->{value} .= chr $code;
3161              $self->{next_char} <= 0x005A) or          $self->{current_attribute}->{has_reference} = 1;
3162             (0x0061 <= $self->{next_char} and          $self->{state} = $self->{prev_state};
3163              $self->{next_char} <= 0x007A)) {          ## Reconsume.
3164      my $entity_name = chr $self->{next_char};          redo A;
3165      !!!next-input-character;        }
3166        } elsif ($self->{state} == HEXREF_X_STATE) {
3167      my $value = $entity_name;        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3168      my $match = 0;            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3169      require Whatpm::_NamedEntityList;            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3170      our $EntityChar;          # 0..9, A..F, a..f
3171            !!!cp (990);
3172      while (length $entity_name < 30 and          $self->{state} = HEXREF_HEX_STATE;
3173             ## NOTE: Some number greater than the maximum length of entity name          $self->{state_keyword} = 0;
3174             ((0x0041 <= $self->{next_char} and # a          ## Reconsume.
3175               $self->{next_char} <= 0x005A) or # x          redo A;
3176              (0x0061 <= $self->{next_char} and # a        } else {
3177               $self->{next_char} <= 0x007A) or # z          !!!parse-error (type => 'bare hcro',
3178              (0x0030 <= $self->{next_char} and # 0                          line => $self->{line_prev},
3179               $self->{next_char} <= 0x0039) or # 9                          column => $self->{column_prev} - 2);
3180              $self->{next_char} == 0x003B)) { # ;  
3181        $entity_name .= chr $self->{next_char};          ## NOTE: According to the spec algorithm, nothing is returned,
3182        if (defined $EntityChar->{$entity_name}) {          ## and then "&#" followed by "X" or "x" is appended to the parent
3183          if ($self->{next_char} == 0x003B) { # ;          ## element or the attribute value in the later processing.
3184            !!!cp (1020);  
3185            $value = $EntityChar->{$entity_name};          if ($self->{prev_state} == DATA_STATE) {
3186            $match = 1;            !!!cp (1005);
3187            !!!next-input-character;            $self->{state} = $self->{prev_state};
3188            last;            ## Reconsume.
3189              !!!emit ({type => CHARACTER_TOKEN,
3190                        data => '&' . $self->{state_keyword},
3191                        line => $self->{line_prev},
3192                        column => $self->{column_prev} - length $self->{state_keyword},
3193                       });
3194              redo A;
3195            } else {
3196              !!!cp (989);
3197              $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3198              $self->{state} = $self->{prev_state};
3199              ## Reconsume.
3200              redo A;
3201            }
3202          }
3203        } elsif ($self->{state} == HEXREF_HEX_STATE) {
3204          if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) {
3205            # 0..9
3206            !!!cp (1002);
3207            $self->{state_keyword} *= 0x10;
3208            $self->{state_keyword} += $self->{next_char} - 0x0030;
3209            ## Stay in the state.
3210            !!!next-input-character;
3211            redo A;
3212          } elsif (0x0061 <= $self->{next_char} and
3213                   $self->{next_char} <= 0x0066) { # a..f
3214            !!!cp (1003);
3215            $self->{state_keyword} *= 0x10;
3216            $self->{state_keyword} += $self->{next_char} - 0x0060 + 9;
3217            ## Stay in the state.
3218            !!!next-input-character;
3219            redo A;
3220          } elsif (0x0041 <= $self->{next_char} and
3221                   $self->{next_char} <= 0x0046) { # A..F
3222            !!!cp (1004);
3223            $self->{state_keyword} *= 0x10;
3224            $self->{state_keyword} += $self->{next_char} - 0x0040 + 9;
3225            ## Stay in the state.
3226            !!!next-input-character;
3227            redo A;
3228          } elsif ($self->{next_char} == 0x003B) { # ;
3229            !!!cp (1006);
3230            !!!next-input-character;
3231            #
3232          } else {
3233            !!!cp (1007);
3234            !!!parse-error (type => 'no refc',
3235                            line => $self->{line},
3236                            column => $self->{column});
3237            ## Reconsume.
3238            #
3239          }
3240    
3241          my $code = $self->{state_keyword};
3242          my $l = $self->{line_prev};
3243          my $c = $self->{column_prev};
3244          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3245            !!!cp (1008);
3246            !!!parse-error (type => 'invalid character reference',
3247                            text => (sprintf 'U+%04X', $code),
3248                            line => $l, column => $c);
3249            $code = 0xFFFD;
3250          } elsif ($code > 0x10FFFF) {
3251            !!!cp (1009);
3252            !!!parse-error (type => 'invalid character reference',
3253                            text => (sprintf 'U-%08X', $code),
3254                            line => $l, column => $c);
3255            $code = 0xFFFD;
3256          } elsif ($code == 0x000D) {
3257            !!!cp (1010);
3258            !!!parse-error (type => 'CR character reference', line => $l, column => $c);
3259            $code = 0x000A;
3260          } elsif (0x80 <= $code and $code <= 0x9F) {
3261            !!!cp (1011);
3262            !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);
3263            $code = $c1_entity_char->{$code};
3264          }
3265    
3266          if ($self->{prev_state} == DATA_STATE) {
3267            !!!cp (988);
3268            $self->{state} = $self->{prev_state};
3269            ## Reconsume.
3270            !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3271                      line => $l, column => $c,
3272                     });
3273            redo A;
3274          } else {
3275            !!!cp (987);
3276            $self->{current_attribute}->{value} .= chr $code;
3277            $self->{current_attribute}->{has_reference} = 1;
3278            $self->{state} = $self->{prev_state};
3279            ## Reconsume.
3280            redo A;
3281          }
3282        } elsif ($self->{state} == ENTITY_NAME_STATE) {
3283          if (length $self->{state_keyword} < 30 and
3284              ## NOTE: Some number greater than the maximum length of entity name
3285              ((0x0041 <= $self->{next_char} and # a
3286                $self->{next_char} <= 0x005A) or # x
3287               (0x0061 <= $self->{next_char} and # a
3288                $self->{next_char} <= 0x007A) or # z
3289               (0x0030 <= $self->{next_char} and # 0
3290                $self->{next_char} <= 0x0039) or # 9
3291               $self->{next_char} == 0x003B)) { # ;
3292            our $EntityChar;
3293            $self->{state_keyword} .= chr $self->{next_char};
3294            if (defined $EntityChar->{$self->{state_keyword}}) {
3295              if ($self->{next_char} == 0x003B) { # ;
3296                !!!cp (1020);
3297                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3298                $self->{entity__match} = 1;
3299                !!!next-input-character;
3300                #
3301              } else {
3302                !!!cp (1021);
3303                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3304                $self->{entity__match} = -1;
3305                ## Stay in the state.
3306                !!!next-input-character;
3307                redo A;
3308              }
3309          } else {          } else {
3310            !!!cp (1021);            !!!cp (1022);
3311            $value = $EntityChar->{$entity_name};            $self->{entity__value} .= chr $self->{next_char};
3312            $match = -1;            $self->{entity__match} *= 2;
3313              ## Stay in the state.
3314            !!!next-input-character;            !!!next-input-character;
3315              redo A;
3316            }
3317          }
3318    
3319          my $data;
3320          my $has_ref;
3321          if ($self->{entity__match} > 0) {
3322            !!!cp (1023);
3323            $data = $self->{entity__value};
3324            $has_ref = 1;
3325            #
3326          } elsif ($self->{entity__match} < 0) {
3327            !!!parse-error (type => 'no refc');
3328            if ($self->{prev_state} != DATA_STATE and # in attribute
3329                $self->{entity__match} < -1) {
3330              !!!cp (1024);
3331              $data = '&' . $self->{state_keyword};
3332              #
3333            } else {
3334              !!!cp (1025);
3335              $data = $self->{entity__value};
3336              $has_ref = 1;
3337              #
3338          }          }
3339        } else {        } else {
3340          !!!cp (1022);          !!!cp (1026);
3341          $value .= chr $self->{next_char};          !!!parse-error (type => 'bare ero',
3342          $match *= 2;                          line => $self->{line_prev},
3343          !!!next-input-character;                          column => $self->{column_prev} - length $self->{state_keyword});
3344            $data = '&' . $self->{state_keyword};
3345            #
3346        }        }
3347      }    
3348              ## NOTE: In these cases, when a character reference is found,
3349      if ($match > 0) {        ## it is consumed and a character token is returned, or, otherwise,
3350        !!!cp (1023);        ## nothing is consumed and returned, according to the spec algorithm.
3351        return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        ## In this implementation, anything that has been examined by the
3352                line => $l, column => $c,        ## tokenizer is appended to the parent element or the attribute value
3353               };        ## as string, either literal string when no character reference or
3354      } elsif ($match < 0) {        ## entity-replaced string otherwise, in this stage, since any characters
3355        !!!parse-error (type => 'no refc', line => $l, column => $c);        ## that would not be consumed are appended in the data state or in an
3356        if ($in_attr and $match < -1) {        ## appropriate attribute value state anyway.
3357          !!!cp (1024);  
3358          return {type => CHARACTER_TOKEN, data => '&'.$entity_name,        if ($self->{prev_state} == DATA_STATE) {
3359                  line => $l, column => $c,          !!!cp (986);
3360                 };          $self->{state} = $self->{prev_state};
3361        } else {          ## Reconsume.
3362          !!!cp (1025);          !!!emit ({type => CHARACTER_TOKEN,
3363          return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,                    data => $data,
3364                  line => $l, column => $c,                    line => $self->{line_prev},
3365                 };                    column => $self->{column_prev} + 1 - length $self->{state_keyword},
3366                     });
3367            redo A;
3368          } else {
3369            !!!cp (985);
3370            $self->{current_attribute}->{value} .= $data;
3371            $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3372            $self->{state} = $self->{prev_state};
3373            ## Reconsume.
3374            redo A;
3375        }        }
3376      } else {      } else {
3377        !!!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,  
              };  
3378      }      }
3379    } else {    } # A  
3380      !!!cp (1027);  
3381      ## no characters are consumed    die "$0: _get_next_token: unexpected case";
3382      !!!parse-error (type => 'bare ero', line => $l, column => $c);  } # _get_next_token
     return undef;  
   }  
 } # _tokenize_attempt_to_consume_an_entity  
3383    
3384  sub _initialize_tree_constructor ($) {  sub _initialize_tree_constructor ($) {
3385    my $self = shift;    my $self = shift;
# Line 4217  sub _tree_construction_main ($) { Line 4478  sub _tree_construction_main ($) {
4478            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4479              !!!cp ('t88.2');              !!!cp ('t88.2');
4480              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4481                #
4482            } else {            } else {
4483              !!!cp ('t88.1');              !!!cp ('t88.1');
4484              ## Ignore the token.              ## Ignore the token.
4485              !!!next-token;              #
             next B;  
4486            }            }
4487            unless (length $token->{data}) {            unless (length $token->{data}) {
4488              !!!cp ('t88');              !!!cp ('t88');
4489              !!!next-token;              !!!next-token;
4490              next B;              next B;
4491            }            }
4492    ## TODO: set $token->{column} appropriately
4493          }          }
4494    
4495          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {
# Line 7472  sub _tree_construction_main ($) { Line 7734  sub _tree_construction_main ($) {
7734    ## TODO: script stuffs    ## TODO: script stuffs
7735  } # _tree_construct_main  } # _tree_construct_main
7736    
7737  sub set_inner_html ($$$;$) {  sub set_inner_html ($$$$;$) {
7738    my $class = shift;    my $class = shift;
7739    my $node = shift;    my $node = shift;
7740    my $s = \$_[0];    #my $s = \$_[0];
7741    my $onerror = $_[1];    my $onerror = $_[1];
7742    my $get_wrapper = $_[2] || sub ($) { return $_[0] };    my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7743    
# Line 7496  sub set_inner_html ($$$;$) { Line 7758  sub set_inner_html ($$$;$) {
7758      }      }
7759    
7760      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7761      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);      $class->parse_char_string ($_[0] => $node, $onerror, $get_wrapper);
7762    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7763      ## TODO: If non-html element      ## TODO: If non-html element
7764    
# Line 7515  sub set_inner_html ($$$;$) { Line 7777  sub set_inner_html ($$$;$) {
7777      my $i = 0;      my $i = 0;
7778      $p->{line_prev} = $p->{line} = 1;      $p->{line_prev} = $p->{line} = 1;
7779      $p->{column_prev} = $p->{column} = 0;      $p->{column_prev} = $p->{column} = 0;
7780        require Whatpm::Charset::DecodeHandle;
7781        my $input = Whatpm::Charset::DecodeHandle::CharString->new (\($_[0]));
7782        $input = $get_wrapper->($input);
7783      $p->{set_next_char} = sub {      $p->{set_next_char} = sub {
7784        my $self = shift;        my $self = shift;
7785    
7786        pop @{$self->{prev_char}};        pop @{$self->{prev_char}};
7787        unshift @{$self->{prev_char}}, $self->{next_char};        unshift @{$self->{prev_char}}, $self->{next_char};
7788    
7789        $self->{next_char} = -1 and return if $i >= length $$s;        my $char;
7790        $self->{next_char} = ord substr $$s, $i++, 1;        if (defined $self->{next_next_char}) {
7791            $char = $self->{next_next_char};
7792            delete $self->{next_next_char};
7793          } else {
7794            $char = $input->getc;
7795          }
7796          $self->{next_char} = -1 and return unless defined $char;
7797          $self->{next_char} = ord $char;
7798    
7799        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});
7800        $p->{column}++;        $p->{column}++;
# Line 7532  sub set_inner_html ($$$;$) { Line 7804  sub set_inner_html ($$$;$) {
7804          $p->{column} = 0;          $p->{column} = 0;
7805          !!!cp ('i1');          !!!cp ('i1');
7806        } elsif ($self->{next_char} == 0x000D) { # CR        } elsif ($self->{next_char} == 0x000D) { # CR
7807          $i++ if substr ($$s, $i, 1) eq "\x0A";  ## TODO: support for abort/streaming
7808            my $next = $input->getc;
7809            if (defined $next and $next ne "\x0A") {
7810              $self->{next_next_char} = $next;
7811            }
7812          $self->{next_char} = 0x000A; # LF # MUST          $self->{next_char} = 0x000A; # LF # MUST
7813          $p->{line}++;          $p->{line}++;
7814          $p->{column} = 0;          $p->{column} = 0;
# Line 7576  sub set_inner_html ($$$;$) { Line 7852  sub set_inner_html ($$$;$) {
7852      };      };
7853      $p->{prev_char} = [-1, -1, -1];      $p->{prev_char} = [-1, -1, -1];
7854      $p->{next_char} = -1;      $p->{next_char} = -1;
7855        
7856        $p->{read_until} = sub {
7857          #my ($scalar, $specials_range, $offset) = @_;
7858          my $specials_range = $_[1];
7859          return 0 if defined $p->{next_next_char};
7860          my $count = $input->manakai_read_until
7861            ($_[0],
7862             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}]/,
7863             $_[2]);
7864          if ($count) {
7865            $p->{column} += $count;
7866            $p->{column_prev} += $count;
7867            $p->{prev_char} = [-1, -1, -1];
7868            $p->{next_char} = -1;
7869          }
7870          return $count;
7871        }; # $p->{read_until}
7872    
7873      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7874        my (%opt) = @_;        my (%opt) = @_;
7875        my $line = $opt{line};        my $line = $opt{line};
Legend:
Removed from v.1.162  
changed lines
  Added in v.1.177
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24