/[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.167 by wakaba, Sat Sep 13 09:02:28 2008 UTC revision 1.182 by wakaba, Mon Sep 15 07:19:03 2008 UTC
# Line 3  use strict; Line 3  use strict;
3  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4  use Error qw(:try);  use Error qw(:try);
5    
6    ## NOTE: This module don't check all HTML5 parse errors; character
7    ## encoding related parse errors are expected to be handled by relevant
8    ## modules.
9    ## Parse errors for control characters that are not allowed in HTML5
10    ## documents, for surrogate code points, and for noncharacter code
11    ## points, as well as U+FFFD substitions for characters whose code points
12    ## is higher than U+10FFFF may be detected by combining the parser with
13    ## the checker implemented by Whatpm::Charset::UnicodeChecker (for its
14    ## usage example, see |t/HTML-tree.t| in the Whatpm package or the
15    ## WebHACC::Language::HTML module in the WebHACC package).
16    
17  ## ISSUE:  ## ISSUE:
18  ## var doc = implementation.createDocument (null, null, null);  ## var doc = implementation.createDocument (null, null, null);
19  ## doc.write ('');  ## doc.write ('');
# Line 496  sub parse_byte_stream ($$$$;$$) { Line 507  sub parse_byte_stream ($$$$;$$) {
507                      line => 1, column => 1,                      line => 1, column => 1,
508                      layer => 'encode');                      layer => 'encode');
509    } elsif (not ($e_status &    } elsif (not ($e_status &
510                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL ())) {
511      $self->{input_encoding} = $charset->get_iana_name;      $self->{input_encoding} = $charset->get_iana_name;
512      !!!parse-error (type => 'chardecode:no error',      !!!parse-error (type => 'chardecode:no error',
513                      text => $self->{input_encoding},                      text => $self->{input_encoding},
# Line 561  sub parse_byte_stream ($$$$;$$) { Line 572  sub parse_byte_stream ($$$$;$$) {
572    my $char_onerror = sub {    my $char_onerror = sub {
573      my (undef, $type, %opt) = @_;      my (undef, $type, %opt) = @_;
574      !!!parse-error (layer => 'encode',      !!!parse-error (layer => 'encode',
575                      %opt, type => $type,                      line => $self->{line}, column => $self->{column} + 1,
576                      line => $self->{line}, column => $self->{column} + 1);                      %opt, type => $type);
577      if ($opt{octets}) {      if ($opt{octets}) {
578        ${$opt{octets}} = "\x{FFFD}"; # relacement character        ${$opt{octets}} = "\x{FFFD}"; # relacement character
579      }      }
# Line 571  sub parse_byte_stream ($$$$;$$) { Line 582  sub parse_byte_stream ($$$$;$$) {
582    my $wrapped_char_stream = $get_wrapper->($char_stream);    my $wrapped_char_stream = $get_wrapper->($char_stream);
583    $wrapped_char_stream->onerror ($char_onerror);    $wrapped_char_stream->onerror ($char_onerror);
584    
585    my @args = @_; shift @args; # $s    my @args = ($_[1], $_[2]); # $doc, $onerror - $get_wrapper = undef;
586    my $return;    my $return;
587    try {    try {
588      $return = $self->parse_char_stream ($wrapped_char_stream, @args);        $return = $self->parse_char_stream ($wrapped_char_stream, @args);  
# Line 586  sub parse_byte_stream ($$$$;$$) { Line 597  sub parse_byte_stream ($$$$;$$) {
597                        line => 1, column => 1,                        line => 1, column => 1,
598                        layer => 'encode');                        layer => 'encode');
599      } elsif (not ($e_status &      } elsif (not ($e_status &
600                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL ())) {
601        $self->{input_encoding} = $charset->get_iana_name;        $self->{input_encoding} = $charset->get_iana_name;
602        !!!parse-error (type => 'chardecode:no error',        !!!parse-error (type => 'chardecode:no error',
603                        text => $self->{input_encoding},                        text => $self->{input_encoding},
# Line 618  sub parse_byte_stream ($$$$;$$) { Line 629  sub parse_byte_stream ($$$$;$$) {
629  sub parse_char_string ($$$;$$) {  sub parse_char_string ($$$;$$) {
630    #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;    #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
631    my $self = shift;    my $self = shift;
   require utf8;  
632    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $s = ref $_[0] ? $_[0] : \($_[0]);
633    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;    require Whatpm::Charset::DecodeHandle;
634    if ($_[3]) {    my $input = Whatpm::Charset::DecodeHandle::CharString->new ($s);
     $input = $_[3]->($input);  
   }  
635    return $self->parse_char_stream ($input, @_[1..$#_]);    return $self->parse_char_stream ($input, @_[1..$#_]);
636  } # parse_char_string  } # parse_char_string
637  *parse_string = \&parse_char_string; ## NOTE: Alias for backward compatibility.  *parse_string = \&parse_char_string; ## NOTE: Alias for backward compatibility.
638    
639  sub parse_char_stream ($$$;$) {  sub parse_char_stream ($$$;$$) {
640    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
641    my $input = $_[0];    my $input = $_[0];
642    $self->{document} = $_[1];    $self->{document} = $_[1];
# Line 639  sub parse_char_stream ($$$;$) { Line 647  sub parse_char_stream ($$$;$) {
647    $self->{confident} = 1 unless exists $self->{confident};    $self->{confident} = 1 unless exists $self->{confident};
648    $self->{document}->input_encoding ($self->{input_encoding})    $self->{document}->input_encoding ($self->{input_encoding})
649        if defined $self->{input_encoding};        if defined $self->{input_encoding};
650    ## TODO: |{input_encoding}| is needless?
651    
   my $i = 0;  
652    $self->{line_prev} = $self->{line} = 1;    $self->{line_prev} = $self->{line} = 1;
653    $self->{column_prev} = $self->{column} = 0;    $self->{column_prev} = -1;
654      $self->{column} = 0;
655    $self->{set_next_char} = sub {    $self->{set_next_char} = sub {
656      my $self = shift;      my $self = shift;
657    
658      pop @{$self->{prev_char}};      my $char = '';
     unshift @{$self->{prev_char}}, $self->{next_char};  
   
     my $char;  
659      if (defined $self->{next_next_char}) {      if (defined $self->{next_next_char}) {
660        $char = $self->{next_next_char};        $char = $self->{next_next_char};
661        delete $self->{next_next_char};        delete $self->{next_next_char};
662          $self->{next_char} = ord $char;
663      } else {      } else {
664        $char = $input->getc;        $self->{char_buffer} = '';
665          $self->{char_buffer_pos} = 0;
666    
667          my $count = $input->manakai_read_until
668             ($self->{char_buffer}, qr/[^\x00\x0A\x0D]/, $self->{char_buffer_pos});
669          if ($count) {
670            $self->{line_prev} = $self->{line};
671            $self->{column_prev} = $self->{column};
672            $self->{column}++;
673            $self->{next_char}
674                = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
675            return;
676          }
677    
678          if ($input->read ($char, 1)) {
679            $self->{next_char} = ord $char;
680          } else {
681            $self->{next_char} = -1;
682            return;
683          }
684      }      }
     $self->{next_char} = -1 and return unless defined $char;  
     $self->{next_char} = ord $char;  
685    
686      ($self->{line_prev}, $self->{column_prev})      ($self->{line_prev}, $self->{column_prev})
687          = ($self->{line}, $self->{column});          = ($self->{line}, $self->{column});
# Line 669  sub parse_char_stream ($$$;$) { Line 693  sub parse_char_stream ($$$;$) {
693        $self->{column} = 0;        $self->{column} = 0;
694      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
695        !!!cp ('j2');        !!!cp ('j2');
696        my $next = $input->getc;  ## TODO: support for abort/streaming
697        if (defined $next and $next ne "\x0A") {        my $next = '';
698          if ($input->read ($next, 1) and $next ne "\x0A") {
699          $self->{next_next_char} = $next;          $self->{next_next_char} = $next;
700        }        }
701        $self->{next_char} = 0x000A; # LF # MUST        $self->{next_char} = 0x000A; # LF # MUST
702        $self->{line}++;        $self->{line}++;
703        $self->{column} = 0;        $self->{column} = 0;
     } elsif ($self->{next_char} > 0x10FFFF) {  
       !!!cp ('j3');  
       $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST  
704      } elsif ($self->{next_char} == 0x0000) { # NULL      } elsif ($self->{next_char} == 0x0000) { # NULL
705        !!!cp ('j4');        !!!cp ('j4');
706        !!!parse-error (type => 'NULL');        !!!parse-error (type => 'NULL');
707        $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
708      } elsif ($self->{next_char} <= 0x0008 or      }
709               (0x000E <= $self->{next_char} and $self->{next_char} <= 0x001F) or    };
710               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or  
711               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or    $self->{read_until} = sub {
712               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or      #my ($scalar, $specials_range, $offset) = @_;
713               {      return 0 if defined $self->{next_next_char};
714                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,  
715                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,      my $pattern = qr/[^$_[1]\x00\x0A\x0D]/;
716                0x4FFFE => 1, 0x4FFFF => 1, 0x5FFFE => 1, 0x5FFFF => 1,      my $offset = $_[2] || 0;
717                0x6FFFE => 1, 0x6FFFF => 1, 0x7FFFE => 1, 0x7FFFF => 1,  
718                0x8FFFE => 1, 0x8FFFF => 1, 0x9FFFE => 1, 0x9FFFF => 1,      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
719                0xAFFFE => 1, 0xAFFFF => 1, 0xBFFFE => 1, 0xBFFFF => 1,        pos ($self->{char_buffer}) = $self->{char_buffer_pos};
720                0xCFFFE => 1, 0xCFFFF => 1, 0xDFFFE => 1, 0xDFFFF => 1,        if ($self->{char_buffer} =~ /\G(?>$pattern)+/) {
721                0xEFFFE => 1, 0xEFFFF => 1, 0xFFFFE => 1, 0xFFFFF => 1,          substr ($_[0], $offset)
722                0x10FFFE => 1, 0x10FFFF => 1,              = substr ($self->{char_buffer}, $-[0], $+[0] - $-[0]);
723               }->{$self->{next_char}}) {          my $count = $+[0] - $-[0];
724        !!!cp ('j5');          if ($count) {
725        if ($self->{next_char} < 0x10000) {            $self->{column} += $count;
726          !!!parse-error (type => 'control char',            $self->{char_buffer_pos} += $count;
727                          text => (sprintf 'U+%04X', $self->{next_char}));            $self->{line_prev} = $self->{line};
728              $self->{column_prev} = $self->{column} - 1;
729              $self->{prev_char} = [-1, -1, -1];
730              $self->{next_char} = -1;
731            }
732            return $count;
733        } else {        } else {
734          !!!parse-error (type => 'control char',          return 0;
735                          text => (sprintf 'U-%08X', $self->{next_char}));        }
736        } else {
737          my $count = $input->manakai_read_until ($_[0], $pattern, $_[2]);
738          if ($count) {
739            $self->{column} += $count;
740            $self->{line_prev} = $self->{line};
741            $self->{column_prev} = $self->{column} - 1;
742            $self->{prev_char} = [-1, -1, -1];
743            $self->{next_char} = -1;
744        }        }
745          return $count;
746      }      }
747    };    }; # $self->{read_until}
   $self->{prev_char} = [-1, -1, -1];  
   $self->{next_char} = -1;  
748    
749    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
750      my (%opt) = @_;      my (%opt) = @_;
# Line 722  sub parse_char_stream ($$$;$) { Line 756  sub parse_char_stream ($$$;$) {
756      $onerror->(line => $self->{line}, column => $self->{column}, @_);      $onerror->(line => $self->{line}, column => $self->{column}, @_);
757    };    };
758    
759      my $char_onerror = sub {
760        my (undef, $type, %opt) = @_;
761        !!!parse-error (layer => 'encode',
762                        line => $self->{line}, column => $self->{column} + 1,
763                        %opt, type => $type);
764      }; # $char_onerror
765    
766      if ($_[3]) {
767        $input = $_[3]->($input);
768        $input->onerror ($char_onerror);
769      } else {
770        $input->onerror ($char_onerror) unless defined $input->onerror;
771      }
772    
773    $self->_initialize_tokenizer;    $self->_initialize_tokenizer;
774    $self->_initialize_tree_constructor;    $self->_initialize_tree_constructor;
775    $self->_construct_tree;    $self->_construct_tree;
# Line 769  sub RCDATA_CONTENT_MODEL () { CM_ENTITY Line 817  sub RCDATA_CONTENT_MODEL () { CM_ENTITY
817  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
818    
819  sub DATA_STATE () { 0 }  sub DATA_STATE () { 0 }
820  sub ENTITY_DATA_STATE () { 1 }  #sub ENTITY_DATA_STATE () { 1 }
821  sub TAG_OPEN_STATE () { 2 }  sub TAG_OPEN_STATE () { 2 }
822  sub CLOSE_TAG_OPEN_STATE () { 3 }  sub CLOSE_TAG_OPEN_STATE () { 3 }
823  sub TAG_NAME_STATE () { 4 }  sub TAG_NAME_STATE () { 4 }
# Line 780  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 Line 828  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8
828  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
829  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
830  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
831  sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }  #sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
832  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
833  sub COMMENT_START_STATE () { 14 }  sub COMMENT_START_STATE () { 14 }
834  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
# Line 812  sub CDATA_SECTION_MSE1_STATE () { 40 } # Line 860  sub CDATA_SECTION_MSE1_STATE () { 40 } #
860  sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec  sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
861  sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec  sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec
862  sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec  sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec
863  sub ENTITY_STATE () { 44 } # "consume a character reference" in the spec  ## NOTE: "Entity data state", "entity in attribute value state", and
864    ## "consume a character reference" algorithm are jointly implemented
865    ## using the following six states:
866    sub ENTITY_STATE () { 44 }
867    sub ENTITY_HASH_STATE () { 45 }
868    sub NCR_NUM_STATE () { 46 }
869    sub HEXREF_X_STATE () { 47 }
870    sub HEXREF_HEX_STATE () { 48 }
871    sub ENTITY_NAME_STATE () { 49 }
872    
873  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
874  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 866  sub _initialize_tokenizer ($) { Line 922  sub _initialize_tokenizer ($) {
922    my $self = shift;    my $self = shift;
923    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
924    #$self->{state_keyword}; # initialized when used    #$self->{state_keyword}; # initialized when used
925      #$self->{entity__value}; # initialized when used
926      #$self->{entity__match}; # initialized when used
927    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
928    undef $self->{current_token};    undef $self->{current_token};
929    undef $self->{current_attribute};    undef $self->{current_attribute};
930    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
931    undef $self->{last_attribute_value_state};    #$self->{prev_state}; # initialized when used
932    delete $self->{self_closing};    delete $self->{self_closing};
933    $self->{char} = [];    $self->{char_buffer} = '';
934    # $self->{next_char}    $self->{char_buffer_pos} = 0;
935      $self->{prev_char} = [-1, -1, -1];
936      $self->{next_char} = -1;
937    !!!next-input-character;    !!!next-input-character;
938    $self->{token} = [];    $self->{token} = [];
939    # $self->{escape}    # $self->{escape}
# Line 904  sub _initialize_tokenizer ($) { Line 964  sub _initialize_tokenizer ($) {
964  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
965  ## and removed from the list.  ## and removed from the list.
966    
967  ## NOTE: HTML5 "Writing HTML documents" section, applied to  ## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.)
968  ## 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,  
969    
970  sub _get_next_token ($) {  sub _get_next_token ($) {
971    my $self = shift;    my $self = shift;
# Line 945  sub _get_next_token ($) { Line 993  sub _get_next_token ($) {
993            ## "entity data state".  In this implementation, the tokenizer            ## "entity data state".  In this implementation, the tokenizer
994            ## is switched to the |ENTITY_STATE|, which is an implementation            ## is switched to the |ENTITY_STATE|, which is an implementation
995            ## of the "consume a character reference" algorithm.            ## of the "consume a character reference" algorithm.
           #$self->{state} = ENTITY_DATA_STATE;  
           $self->{entity_in_attr} = 0;  
996            $self->{entity_additional} = -1;            $self->{entity_additional} = -1;
997              $self->{prev_state} = DATA_STATE;
998            $self->{state} = ENTITY_STATE;            $self->{state} = ENTITY_STATE;
999            !!!next-input-character;            !!!next-input-character;
1000            redo A;            redo A;
# Line 1012  sub _get_next_token ($) { Line 1059  sub _get_next_token ($) {
1059                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1060                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1061                    };                    };
1062          $self->{read_until}->($token->{data}, q[-!<>&], length $token->{data});
1063    
1064        ## Stay in the data state        ## Stay in the data state
1065        !!!next-input-character;        !!!next-input-character;
1066    
1067        !!!emit ($token);        !!!emit ($token);
1068    
1069        redo A;        redo A;
     } elsif ($self->{state} == ENTITY_DATA_STATE) {  
       my ($l, $c) = ($self->{line_prev}, $self->{column_prev});  
   
       my $token = $self->{entity_return};  
   
       $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;  
1070      } elsif ($self->{state} == TAG_OPEN_STATE) {      } elsif ($self->{state} == TAG_OPEN_STATE) {
1071        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1072          if ($self->{next_char} == 0x002F) { # /          if ($self->{next_char} == 0x002F) { # /
# Line 1710  sub _get_next_token ($) { Line 1740  sub _get_next_token ($) {
1740          redo A;          redo A;
1741        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1742          !!!cp (96);          !!!cp (96);
         $self->{last_attribute_value_state} = $self->{state};  
1743          ## NOTE: In the spec, the tokenizer is switched to the          ## NOTE: In the spec, the tokenizer is switched to the
1744          ## "entity in attribute value state".  In this implementation, the          ## "entity in attribute value state".  In this implementation, the
1745          ## tokenizer is switched to the |ENTITY_STATE|, which is an          ## tokenizer is switched to the |ENTITY_STATE|, which is an
1746          ## implementation of the "consume a character reference" algorithm.          ## implementation of the "consume a character reference" algorithm.
1747          #$self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          $self->{prev_state} = $self->{state};
         $self->{entity_in_attr} = 1;  
1748          $self->{entity_additional} = 0x0022; # "          $self->{entity_additional} = 0x0022; # "
1749          $self->{state} = ENTITY_STATE;          $self->{state} = ENTITY_STATE;
1750          !!!next-input-character;          !!!next-input-character;
# Line 1747  sub _get_next_token ($) { Line 1775  sub _get_next_token ($) {
1775        } else {        } else {
1776          !!!cp (100);          !!!cp (100);
1777          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1778            $self->{read_until}->($self->{current_attribute}->{value},
1779                                  q["&],
1780                                  length $self->{current_attribute}->{value});
1781    
1782          ## Stay in the state          ## Stay in the state
1783          !!!next-input-character;          !!!next-input-character;
1784          redo A;          redo A;
# Line 1759  sub _get_next_token ($) { Line 1791  sub _get_next_token ($) {
1791          redo A;          redo A;
1792        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1793          !!!cp (102);          !!!cp (102);
         $self->{last_attribute_value_state} = $self->{state};  
1794          ## NOTE: In the spec, the tokenizer is switched to the          ## NOTE: In the spec, the tokenizer is switched to the
1795          ## "entity in attribute value state".  In this implementation, the          ## "entity in attribute value state".  In this implementation, the
1796          ## tokenizer is switched to the |ENTITY_STATE|, which is an          ## tokenizer is switched to the |ENTITY_STATE|, which is an
1797          ## implementation of the "consume a character reference" algorithm.          ## implementation of the "consume a character reference" algorithm.
         #$self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;  
         $self->{entity_in_attr} = 1;  
1798          $self->{entity_additional} = 0x0027; # '          $self->{entity_additional} = 0x0027; # '
1799            $self->{prev_state} = $self->{state};
1800          $self->{state} = ENTITY_STATE;          $self->{state} = ENTITY_STATE;
1801          !!!next-input-character;          !!!next-input-character;
1802          redo A;          redo A;
# Line 1796  sub _get_next_token ($) { Line 1826  sub _get_next_token ($) {
1826        } else {        } else {
1827          !!!cp (106);          !!!cp (106);
1828          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1829            $self->{read_until}->($self->{current_attribute}->{value},
1830                                  q['&],
1831                                  length $self->{current_attribute}->{value});
1832    
1833          ## Stay in the state          ## Stay in the state
1834          !!!next-input-character;          !!!next-input-character;
1835          redo A;          redo A;
# Line 1812  sub _get_next_token ($) { Line 1846  sub _get_next_token ($) {
1846          redo A;          redo A;
1847        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1848          !!!cp (108);          !!!cp (108);
         $self->{last_attribute_value_state} = $self->{state};  
1849          ## NOTE: In the spec, the tokenizer is switched to the          ## NOTE: In the spec, the tokenizer is switched to the
1850          ## "entity in attribute value state".  In this implementation, the          ## "entity in attribute value state".  In this implementation, the
1851          ## tokenizer is switched to the |ENTITY_STATE|, which is an          ## tokenizer is switched to the |ENTITY_STATE|, which is an
1852          ## implementation of the "consume a character reference" algorithm.          ## implementation of the "consume a character reference" algorithm.
         #$self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;  
         $self->{entity_in_attr} = 1;  
1853          $self->{entity_additional} = -1;          $self->{entity_additional} = -1;
1854            $self->{prev_state} = $self->{state};
1855          $self->{state} = ENTITY_STATE;          $self->{state} = ENTITY_STATE;
1856          !!!next-input-character;          !!!next-input-character;
1857          redo A;          redo A;
# Line 1880  sub _get_next_token ($) { Line 1912  sub _get_next_token ($) {
1912            !!!cp (116);            !!!cp (116);
1913          }          }
1914          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1915            $self->{read_until}->($self->{current_attribute}->{value},
1916                                  q["'=& >],
1917                                  length $self->{current_attribute}->{value});
1918    
1919          ## Stay in the state          ## Stay in the state
1920          !!!next-input-character;          !!!next-input-character;
1921          redo A;          redo A;
1922        }        }
     } elsif ($self->{state} == ENTITY_IN_ATTRIBUTE_VALUE_STATE) {  
       my $token = $self->{entity_return};  
   
       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;  
1923      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {
1924        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
1925            $self->{next_char} == 0x000A or # LF            $self->{next_char} == 0x000A or # LF
# Line 2040  sub _get_next_token ($) { Line 2060  sub _get_next_token ($) {
2060        } else {        } else {
2061          !!!cp (126);          !!!cp (126);
2062          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2063            $self->{read_until}->($self->{current_token}->{data},
2064                                  q[>],
2065                                  length $self->{current_token}->{data});
2066    
2067          ## Stay in the state.          ## Stay in the state.
2068          !!!next-input-character;          !!!next-input-character;
2069          redo A;          redo A;
# Line 2274  sub _get_next_token ($) { Line 2298  sub _get_next_token ($) {
2298        } else {        } else {
2299          !!!cp (147);          !!!cp (147);
2300          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2301            $self->{read_until}->($self->{current_token}->{data},
2302                                  q[-],
2303                                  length $self->{current_token}->{data});
2304    
2305          ## Stay in the state          ## Stay in the state
2306          !!!next-input-character;          !!!next-input-character;
2307          redo A;          redo A;
# Line 2639  sub _get_next_token ($) { Line 2667  sub _get_next_token ($) {
2667          !!!cp (190);          !!!cp (190);
2668          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2669              .= chr $self->{next_char};              .= chr $self->{next_char};
2670            $self->{read_until}->($self->{current_token}->{public_identifier},
2671                                  q[">],
2672                                  length $self->{current_token}->{public_identifier});
2673    
2674          ## Stay in the state          ## Stay in the state
2675          !!!next-input-character;          !!!next-input-character;
2676          redo A;          redo A;
# Line 2675  sub _get_next_token ($) { Line 2707  sub _get_next_token ($) {
2707          !!!cp (194);          !!!cp (194);
2708          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2709              .= chr $self->{next_char};              .= chr $self->{next_char};
2710            $self->{read_until}->($self->{current_token}->{public_identifier},
2711                                  q['>],
2712                                  length $self->{current_token}->{public_identifier});
2713    
2714          ## Stay in the state          ## Stay in the state
2715          !!!next-input-character;          !!!next-input-character;
2716          redo A;          redo A;
# Line 2811  sub _get_next_token ($) { Line 2847  sub _get_next_token ($) {
2847          !!!cp (210);          !!!cp (210);
2848          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2849              .= chr $self->{next_char};              .= chr $self->{next_char};
2850            $self->{read_until}->($self->{current_token}->{system_identifier},
2851                                  q[">],
2852                                  length $self->{current_token}->{system_identifier});
2853    
2854          ## Stay in the state          ## Stay in the state
2855          !!!next-input-character;          !!!next-input-character;
2856          redo A;          redo A;
# Line 2847  sub _get_next_token ($) { Line 2887  sub _get_next_token ($) {
2887          !!!cp (214);          !!!cp (214);
2888          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2889              .= chr $self->{next_char};              .= chr $self->{next_char};
2890            $self->{read_until}->($self->{current_token}->{system_identifier},
2891                                  q['>],
2892                                  length $self->{current_token}->{system_identifier});
2893    
2894          ## Stay in the state          ## Stay in the state
2895          !!!next-input-character;          !!!next-input-character;
2896          redo A;          redo A;
# Line 2907  sub _get_next_token ($) { Line 2951  sub _get_next_token ($) {
2951          redo A;          redo A;
2952        } else {        } else {
2953          !!!cp (221);          !!!cp (221);
2954            my $s = '';
2955            $self->{read_until}->($s, q[>], 0);
2956    
2957          ## Stay in the state          ## Stay in the state
2958          !!!next-input-character;          !!!next-input-character;
2959          redo A;          redo A;
# Line 2935  sub _get_next_token ($) { Line 2982  sub _get_next_token ($) {
2982        } else {        } else {
2983          !!!cp (221.4);          !!!cp (221.4);
2984          $self->{current_token}->{data} .= chr $self->{next_char};          $self->{current_token}->{data} .= chr $self->{next_char};
2985            $self->{read_until}->($self->{current_token}->{data},
2986                                  q<]>,
2987                                  length $self->{current_token}->{data});
2988    
2989          ## Stay in the state.          ## Stay in the state.
2990          !!!next-input-character;          !!!next-input-character;
2991          redo A;          redo A;
# Line 2979  sub _get_next_token ($) { Line 3030  sub _get_next_token ($) {
3030          ## Reconsume.          ## Reconsume.
3031          redo A;          redo A;
3032        }        }
   
3033      } elsif ($self->{state} == ENTITY_STATE) {      } elsif ($self->{state} == ENTITY_STATE) {
3034        my $in_attr = $self->{entity_in_attr};        if ({
3035        my $additional = $self->{entity_additional};          0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
3036            0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, &
3037            $self->{entity_additional} => 1,
3038          }->{$self->{next_char}}) {
3039            !!!cp (1001);
3040            ## Don't consume
3041            ## No error
3042            ## Return nothing.
3043            #
3044          } elsif ($self->{next_char} == 0x0023) { # #
3045            !!!cp (999);
3046            $self->{state} = ENTITY_HASH_STATE;
3047            $self->{state_keyword} = '#';
3048            !!!next-input-character;
3049            redo A;
3050          } elsif ((0x0041 <= $self->{next_char} and
3051                    $self->{next_char} <= 0x005A) or # A..Z
3052                   (0x0061 <= $self->{next_char} and
3053                    $self->{next_char} <= 0x007A)) { # a..z
3054            !!!cp (998);
3055            require Whatpm::_NamedEntityList;
3056            $self->{state} = ENTITY_NAME_STATE;
3057            $self->{state_keyword} = chr $self->{next_char};
3058            $self->{entity__value} = $self->{state_keyword};
3059            $self->{entity__match} = 0;
3060            !!!next-input-character;
3061            redo A;
3062          } else {
3063            !!!cp (1027);
3064            !!!parse-error (type => 'bare ero');
3065            ## Return nothing.
3066            #
3067          }
3068    
3069    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        ## NOTE: No character is consumed by the "consume a character
3070          ## reference" algorithm.  In other word, there is an "&" character
3071          ## that does not introduce a character reference, which would be
3072          ## appended to the parent element or the attribute value in later
3073          ## process of the tokenizer.
3074    
3075          if ($self->{prev_state} == DATA_STATE) {
3076            !!!cp (997);
3077            $self->{state} = $self->{prev_state};
3078            ## Reconsume.
3079            !!!emit ({type => CHARACTER_TOKEN, data => '&',
3080                      line => $self->{line_prev},
3081                      column => $self->{column_prev},
3082                     });
3083            redo A;
3084          } else {
3085            !!!cp (996);
3086            $self->{current_attribute}->{value} .= '&';
3087            $self->{state} = $self->{prev_state};
3088            ## Reconsume.
3089            redo A;
3090          }
3091        } elsif ($self->{state} == ENTITY_HASH_STATE) {
3092          if ($self->{next_char} == 0x0078 or # x
3093              $self->{next_char} == 0x0058) { # X
3094            !!!cp (995);
3095            $self->{state} = HEXREF_X_STATE;
3096            $self->{state_keyword} .= chr $self->{next_char};
3097            !!!next-input-character;
3098            redo A;
3099          } elsif (0x0030 <= $self->{next_char} and
3100                   $self->{next_char} <= 0x0039) { # 0..9
3101            !!!cp (994);
3102            $self->{state} = NCR_NUM_STATE;
3103            $self->{state_keyword} = $self->{next_char} - 0x0030;
3104            !!!next-input-character;
3105            redo A;
3106          } else {
3107            !!!parse-error (type => 'bare nero',
3108                            line => $self->{line_prev},
3109                            column => $self->{column_prev} - 1);
3110    
3111    if ({          ## NOTE: According to the spec algorithm, nothing is returned,
3112         0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,          ## and then "&#" is appended to the parent element or the attribute
3113         0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR          ## value in the later processing.
3114         $additional => 1,  
3115        }->{$self->{next_char}}) {          if ($self->{prev_state} == DATA_STATE) {
3116      !!!cp (1001);            !!!cp (1019);
3117      ## Don't consume            $self->{state} = $self->{prev_state};
3118      ## No error            ## Reconsume.
3119      $self->{entity_return} = undef;            !!!emit ({type => CHARACTER_TOKEN,
3120      $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;                      data => '&#',
3121      redo A;                      line => $self->{line_prev},
3122    } elsif ($self->{next_char} == 0x0023) { # #                      column => $self->{column_prev} - 1,
3123      !!!next-input-character;                     });
     if ($self->{next_char} == 0x0078 or # x  
         $self->{next_char} == 0x0058) { # X  
       my $code;  
       X: {  
         my $x_char = $self->{next_char};  
         !!!next-input-character;  
         if (0x0030 <= $self->{next_char} and  
             $self->{next_char} <= 0x0039) { # 0..9  
           !!!cp (1002);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0030;  
           redo X;  
         } elsif (0x0061 <= $self->{next_char} and  
                  $self->{next_char} <= 0x0066) { # a..f  
           !!!cp (1003);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0060 + 9;  
           redo X;  
         } elsif (0x0041 <= $self->{next_char} and  
                  $self->{next_char} <= 0x0046) { # A..F  
           !!!cp (1004);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0040 + 9;  
           redo X;  
         } elsif (not defined $code) { # no hexadecimal digit  
           !!!cp (1005);  
           !!!parse-error (type => 'bare hcro', line => $l, column => $c);  
           !!!back-next-input-character ($x_char, $self->{next_char});  
           $self->{next_char} = 0x0023; # #  
           $self->{entity_return} = undef;  
           $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;  
3124            redo A;            redo A;
         } elsif ($self->{next_char} == 0x003B) { # ;  
           !!!cp (1006);  
           !!!next-input-character;  
3125          } else {          } else {
3126            !!!cp (1007);            !!!cp (993);
3127            !!!parse-error (type => 'no refc', line => $l, column => $c);            $self->{current_attribute}->{value} .= '&#';
3128              $self->{state} = $self->{prev_state};
3129              ## Reconsume.
3130              redo A;
3131          }          }
3132          }
3133          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {      } elsif ($self->{state} == NCR_NUM_STATE) {
3134            !!!cp (1008);        if (0x0030 <= $self->{next_char} and
3135            !!!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};  
         }  
   
         $self->{entity_return} = {type => CHARACTER_TOKEN, data => chr $code,  
                 has_reference => 1,  
                 line => $l, column => $c,  
                };  
         $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;  
         redo A;  
       } # 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  
3136          !!!cp (1012);          !!!cp (1012);
3137          $code *= 10;          $self->{state_keyword} *= 10;
3138          $code += $self->{next_char} - 0x0030;          $self->{state_keyword} += $self->{next_char} - 0x0030;
3139                    
3140            ## Stay in the state.
3141          !!!next-input-character;          !!!next-input-character;
3142        }          redo A;
3143          } elsif ($self->{next_char} == 0x003B) { # ;
       if ($self->{next_char} == 0x003B) { # ;  
3144          !!!cp (1013);          !!!cp (1013);
3145          !!!next-input-character;          !!!next-input-character;
3146            #
3147        } else {        } else {
3148          !!!cp (1014);          !!!cp (1014);
3149          !!!parse-error (type => 'no refc', line => $l, column => $c);          !!!parse-error (type => 'no refc');
3150            ## Reconsume.
3151            #
3152        }        }
3153    
3154          my $code = $self->{state_keyword};
3155          my $l = $self->{line_prev};
3156          my $c = $self->{column_prev};
3157        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3158          !!!cp (1015);          !!!cp (1015);
3159          !!!parse-error (type => 'invalid character reference',          !!!parse-error (type => 'invalid character reference',
# Line 3117  sub _get_next_token ($) { Line 3178  sub _get_next_token ($) {
3178                          line => $l, column => $c);                          line => $l, column => $c);
3179          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3180        }        }
3181          
3182        $self->{entity_return} = {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        if ($self->{prev_state} == DATA_STATE) {
3183                line => $l, column => $c,          !!!cp (992);
3184               };          $self->{state} = $self->{prev_state};
3185        $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;          ## Reconsume.
3186        redo A;          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3187      } else {                    line => $l, column => $c,
3188        !!!cp (1019);                   });
3189        !!!parse-error (type => 'bare nero', line => $l, column => $c);          redo A;
3190        !!!back-next-input-character ($self->{next_char});        } else {
3191        $self->{next_char} = 0x0023; # #          !!!cp (991);
3192        $self->{entity_return} = undef;          $self->{current_attribute}->{value} .= chr $code;
3193        $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;          $self->{current_attribute}->{has_reference} = 1;
3194        redo A;          $self->{state} = $self->{prev_state};
3195      }          ## Reconsume.
3196    } elsif ((0x0041 <= $self->{next_char} and          redo A;
3197              $self->{next_char} <= 0x005A) or        }
3198             (0x0061 <= $self->{next_char} and      } elsif ($self->{state} == HEXREF_X_STATE) {
3199              $self->{next_char} <= 0x007A)) {        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3200      my $entity_name = chr $self->{next_char};            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3201      !!!next-input-character;            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3202            # 0..9, A..F, a..f
3203      my $value = $entity_name;          !!!cp (990);
3204      my $match = 0;          $self->{state} = HEXREF_HEX_STATE;
3205      require Whatpm::_NamedEntityList;          $self->{state_keyword} = 0;
3206      our $EntityChar;          ## Reconsume.
3207            redo A;
3208      while (length $entity_name < 30 and        } else {
3209             ## NOTE: Some number greater than the maximum length of entity name          !!!parse-error (type => 'bare hcro',
3210             ((0x0041 <= $self->{next_char} and # a                          line => $self->{line_prev},
3211               $self->{next_char} <= 0x005A) or # x                          column => $self->{column_prev} - 2);
3212              (0x0061 <= $self->{next_char} and # a  
3213               $self->{next_char} <= 0x007A) or # z          ## NOTE: According to the spec algorithm, nothing is returned,
3214              (0x0030 <= $self->{next_char} and # 0          ## and then "&#" followed by "X" or "x" is appended to the parent
3215               $self->{next_char} <= 0x0039) or # 9          ## element or the attribute value in the later processing.
3216              $self->{next_char} == 0x003B)) { # ;  
3217        $entity_name .= chr $self->{next_char};          if ($self->{prev_state} == DATA_STATE) {
3218        if (defined $EntityChar->{$entity_name}) {            !!!cp (1005);
3219          if ($self->{next_char} == 0x003B) { # ;            $self->{state} = $self->{prev_state};
3220            !!!cp (1020);            ## Reconsume.
3221            $value = $EntityChar->{$entity_name};            !!!emit ({type => CHARACTER_TOKEN,
3222            $match = 1;                      data => '&' . $self->{state_keyword},
3223            !!!next-input-character;                      line => $self->{line_prev},
3224            last;                      column => $self->{column_prev} - length $self->{state_keyword},
3225                       });
3226              redo A;
3227          } else {          } else {
3228            !!!cp (1021);            !!!cp (989);
3229            $value = $EntityChar->{$entity_name};            $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3230            $match = -1;            $self->{state} = $self->{prev_state};
3231            !!!next-input-character;            ## Reconsume.
3232              redo A;
3233          }          }
3234        } else {        }
3235          !!!cp (1022);      } elsif ($self->{state} == HEXREF_HEX_STATE) {
3236          $value .= chr $self->{next_char};        if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) {
3237          $match *= 2;          # 0..9
3238            !!!cp (1002);
3239            $self->{state_keyword} *= 0x10;
3240            $self->{state_keyword} += $self->{next_char} - 0x0030;
3241            ## Stay in the state.
3242          !!!next-input-character;          !!!next-input-character;
3243            redo A;
3244          } elsif (0x0061 <= $self->{next_char} and
3245                   $self->{next_char} <= 0x0066) { # a..f
3246            !!!cp (1003);
3247            $self->{state_keyword} *= 0x10;
3248            $self->{state_keyword} += $self->{next_char} - 0x0060 + 9;
3249            ## Stay in the state.
3250            !!!next-input-character;
3251            redo A;
3252          } elsif (0x0041 <= $self->{next_char} and
3253                   $self->{next_char} <= 0x0046) { # A..F
3254            !!!cp (1004);
3255            $self->{state_keyword} *= 0x10;
3256            $self->{state_keyword} += $self->{next_char} - 0x0040 + 9;
3257            ## Stay in the state.
3258            !!!next-input-character;
3259            redo A;
3260          } elsif ($self->{next_char} == 0x003B) { # ;
3261            !!!cp (1006);
3262            !!!next-input-character;
3263            #
3264          } else {
3265            !!!cp (1007);
3266            !!!parse-error (type => 'no refc',
3267                            line => $self->{line},
3268                            column => $self->{column});
3269            ## Reconsume.
3270            #
3271        }        }
3272      }  
3273              my $code = $self->{state_keyword};
3274      if ($match > 0) {        my $l = $self->{line_prev};
3275        !!!cp (1023);        my $c = $self->{column_prev};
3276        $self->{entity_return} = {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3277                line => $l, column => $c,          !!!cp (1008);
3278               };          !!!parse-error (type => 'invalid character reference',
3279        $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;                          text => (sprintf 'U+%04X', $code),
3280        redo A;                          line => $l, column => $c);
3281      } elsif ($match < 0) {          $code = 0xFFFD;
3282        !!!parse-error (type => 'no refc', line => $l, column => $c);        } elsif ($code > 0x10FFFF) {
3283        if ($in_attr and $match < -1) {          !!!cp (1009);
3284          !!!cp (1024);          !!!parse-error (type => 'invalid character reference',
3285          $self->{entity_return} = {type => CHARACTER_TOKEN, data => '&'.$entity_name,                          text => (sprintf 'U-%08X', $code),
3286                  line => $l, column => $c,                          line => $l, column => $c);
3287                 };          $code = 0xFFFD;
3288          $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;        } elsif ($code == 0x000D) {
3289            !!!cp (1010);
3290            !!!parse-error (type => 'CR character reference', line => $l, column => $c);
3291            $code = 0x000A;
3292          } elsif (0x80 <= $code and $code <= 0x9F) {
3293            !!!cp (1011);
3294            !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);
3295            $code = $c1_entity_char->{$code};
3296          }
3297    
3298          if ($self->{prev_state} == DATA_STATE) {
3299            !!!cp (988);
3300            $self->{state} = $self->{prev_state};
3301            ## Reconsume.
3302            !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3303                      line => $l, column => $c,
3304                     });
3305          redo A;          redo A;
3306        } else {        } else {
3307          !!!cp (1025);          !!!cp (987);
3308          $self->{entity_return} = {type => CHARACTER_TOKEN, data => $value, has_reference => 1,          $self->{current_attribute}->{value} .= chr $code;
3309                  line => $l, column => $c,          $self->{current_attribute}->{has_reference} = 1;
3310                 };          $self->{state} = $self->{prev_state};
3311          $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;          ## Reconsume.
3312          redo A;          redo A;
3313        }        }
3314      } else {      } elsif ($self->{state} == ENTITY_NAME_STATE) {
3315        !!!cp (1026);        if (length $self->{state_keyword} < 30 and
3316        !!!parse-error (type => 'bare ero', line => $l, column => $c);            ## NOTE: Some number greater than the maximum length of entity name
3317        ## NOTE: "No characters are consumed" in the spec.            ((0x0041 <= $self->{next_char} and # a
3318        $self->{entity_return} = {type => CHARACTER_TOKEN, data => '&'.$value,              $self->{next_char} <= 0x005A) or # x
3319                line => $l, column => $c,             (0x0061 <= $self->{next_char} and # a
3320               };              $self->{next_char} <= 0x007A) or # z
3321        $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;             (0x0030 <= $self->{next_char} and # 0
3322        redo A;              $self->{next_char} <= 0x0039) or # 9
3323      }             $self->{next_char} == 0x003B)) { # ;
3324    } else {          our $EntityChar;
3325      !!!cp (1027);          $self->{state_keyword} .= chr $self->{next_char};
3326      ## no characters are consumed          if (defined $EntityChar->{$self->{state_keyword}}) {
3327      !!!parse-error (type => 'bare ero', line => $l, column => $c);            if ($self->{next_char} == 0x003B) { # ;
3328      $self->{entity_return} = undef;              !!!cp (1020);
3329      $self->{state} = $self->{entity_in_attr} ? ENTITY_IN_ATTRIBUTE_VALUE_STATE : ENTITY_DATA_STATE;              $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3330      redo A;              $self->{entity__match} = 1;
3331    }              !!!next-input-character;
3332                #
3333              } else {
3334                !!!cp (1021);
3335                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3336                $self->{entity__match} = -1;
3337                ## Stay in the state.
3338                !!!next-input-character;
3339                redo A;
3340              }
3341            } else {
3342              !!!cp (1022);
3343              $self->{entity__value} .= chr $self->{next_char};
3344              $self->{entity__match} *= 2;
3345              ## Stay in the state.
3346              !!!next-input-character;
3347              redo A;
3348            }
3349          }
3350    
3351          my $data;
3352          my $has_ref;
3353          if ($self->{entity__match} > 0) {
3354            !!!cp (1023);
3355            $data = $self->{entity__value};
3356            $has_ref = 1;
3357            #
3358          } elsif ($self->{entity__match} < 0) {
3359            !!!parse-error (type => 'no refc');
3360            if ($self->{prev_state} != DATA_STATE and # in attribute
3361                $self->{entity__match} < -1) {
3362              !!!cp (1024);
3363              $data = '&' . $self->{state_keyword};
3364              #
3365            } else {
3366              !!!cp (1025);
3367              $data = $self->{entity__value};
3368              $has_ref = 1;
3369              #
3370            }
3371          } else {
3372            !!!cp (1026);
3373            !!!parse-error (type => 'bare ero',
3374                            line => $self->{line_prev},
3375                            column => $self->{column_prev} - length $self->{state_keyword});
3376            $data = '&' . $self->{state_keyword};
3377            #
3378          }
3379      
3380          ## NOTE: In these cases, when a character reference is found,
3381          ## it is consumed and a character token is returned, or, otherwise,
3382          ## nothing is consumed and returned, according to the spec algorithm.
3383          ## In this implementation, anything that has been examined by the
3384          ## tokenizer is appended to the parent element or the attribute value
3385          ## as string, either literal string when no character reference or
3386          ## entity-replaced string otherwise, in this stage, since any characters
3387          ## that would not be consumed are appended in the data state or in an
3388          ## appropriate attribute value state anyway.
3389    
3390          if ($self->{prev_state} == DATA_STATE) {
3391            !!!cp (986);
3392            $self->{state} = $self->{prev_state};
3393            ## Reconsume.
3394            !!!emit ({type => CHARACTER_TOKEN,
3395                      data => $data,
3396                      line => $self->{line_prev},
3397                      column => $self->{column_prev} + 1 - length $self->{state_keyword},
3398                     });
3399            redo A;
3400          } else {
3401            !!!cp (985);
3402            $self->{current_attribute}->{value} .= $data;
3403            $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3404            $self->{state} = $self->{prev_state};
3405            ## Reconsume.
3406            redo A;
3407          }
3408      } else {      } else {
3409        die "$0: $self->{state}: Unknown state";        die "$0: $self->{state}: Unknown state";
3410      }      }
# Line 4323  sub _tree_construction_main ($) { Line 4510  sub _tree_construction_main ($) {
4510            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4511              !!!cp ('t88.2');              !!!cp ('t88.2');
4512              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4513                #
4514            } else {            } else {
4515              !!!cp ('t88.1');              !!!cp ('t88.1');
4516              ## Ignore the token.              ## Ignore the token.
4517              !!!next-token;              #
             next B;  
4518            }            }
4519            unless (length $token->{data}) {            unless (length $token->{data}) {
4520              !!!cp ('t88');              !!!cp ('t88');
4521              !!!next-token;              !!!next-token;
4522              next B;              next B;
4523            }            }
4524    ## TODO: set $token->{column} appropriately
4525          }          }
4526    
4527          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {
# Line 7578  sub _tree_construction_main ($) { Line 7766  sub _tree_construction_main ($) {
7766    ## TODO: script stuffs    ## TODO: script stuffs
7767  } # _tree_construct_main  } # _tree_construct_main
7768    
7769  sub set_inner_html ($$$;$) {  sub set_inner_html ($$$$;$) {
7770    my $class = shift;    my $class = shift;
7771    my $node = shift;    my $node = shift;
7772    my $s = \$_[0];    #my $s = \$_[0];
7773    my $onerror = $_[1];    my $onerror = $_[1];
7774    my $get_wrapper = $_[2] || sub ($) { return $_[0] };    my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7775    
# Line 7602  sub set_inner_html ($$$;$) { Line 7790  sub set_inner_html ($$$;$) {
7790      }      }
7791    
7792      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7793      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);      $class->parse_char_string ($_[0] => $node, $onerror, $get_wrapper);
7794    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7795      ## TODO: If non-html element      ## TODO: If non-html element
7796    
# Line 7621  sub set_inner_html ($$$;$) { Line 7809  sub set_inner_html ($$$;$) {
7809      my $i = 0;      my $i = 0;
7810      $p->{line_prev} = $p->{line} = 1;      $p->{line_prev} = $p->{line} = 1;
7811      $p->{column_prev} = $p->{column} = 0;      $p->{column_prev} = $p->{column} = 0;
7812        require Whatpm::Charset::DecodeHandle;
7813        my $input = Whatpm::Charset::DecodeHandle::CharString->new (\($_[0]));
7814        $input = $get_wrapper->($input);
7815      $p->{set_next_char} = sub {      $p->{set_next_char} = sub {
7816        my $self = shift;        my $self = shift;
7817    
7818        pop @{$self->{prev_char}};        my $char = '';
7819        unshift @{$self->{prev_char}}, $self->{next_char};        if (defined $self->{next_next_char}) {
7820            $char = $self->{next_next_char};
7821        $self->{next_char} = -1 and return if $i >= length $$s;          delete $self->{next_next_char};
7822        $self->{next_char} = ord substr $$s, $i++, 1;          $self->{next_char} = ord $char;
7823          } else {
7824            $self->{char_buffer} = '';
7825            $self->{char_buffer_pos} = 0;
7826            
7827            my $count = $input->manakai_read_until
7828                ($self->{char_buffer}, qr/[^\x00\x0A\x0D]/,
7829                 $self->{char_buffer_pos});
7830            if ($count) {
7831              $self->{line_prev} = $self->{line};
7832              $self->{column_prev} = $self->{column};
7833              $self->{column}++;
7834              $self->{next_char}
7835                  = ord substr ($self->{char_buffer},
7836                                $self->{char_buffer_pos}++, 1);
7837              return;
7838            }
7839            
7840            if ($input->read ($char, 1)) {
7841              $self->{next_char} = ord $char;
7842            } else {
7843              $self->{next_char} = -1;
7844              return;
7845            }
7846          }
7847    
7848        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});
7849        $p->{column}++;        $p->{column}++;
# Line 7638  sub set_inner_html ($$$;$) { Line 7853  sub set_inner_html ($$$;$) {
7853          $p->{column} = 0;          $p->{column} = 0;
7854          !!!cp ('i1');          !!!cp ('i1');
7855        } elsif ($self->{next_char} == 0x000D) { # CR        } elsif ($self->{next_char} == 0x000D) { # CR
7856          $i++ if substr ($$s, $i, 1) eq "\x0A";  ## TODO: support for abort/streaming
7857            my $next = '';
7858            if ($input->read ($next, 1) and $next ne "\x0A") {
7859              $self->{next_next_char} = $next;
7860            }
7861          $self->{next_char} = 0x000A; # LF # MUST          $self->{next_char} = 0x000A; # LF # MUST
7862          $p->{line}++;          $p->{line}++;
7863          $p->{column} = 0;          $p->{column} = 0;
7864          !!!cp ('i2');          !!!cp ('i2');
       } elsif ($self->{next_char} > 0x10FFFF) {  
         $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST  
         !!!cp ('i3');  
7865        } elsif ($self->{next_char} == 0x0000) { # NULL        } elsif ($self->{next_char} == 0x0000) { # NULL
7866          !!!cp ('i4');          !!!cp ('i4');
7867          !!!parse-error (type => 'NULL');          !!!parse-error (type => 'NULL');
7868          $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST          $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
       } elsif ($self->{next_char} <= 0x0008 or  
                (0x000E <= $self->{next_char} and  
                 $self->{next_char} <= 0x001F) or  
                (0x007F <= $self->{next_char} and  
                 $self->{next_char} <= 0x009F) or  
                (0xD800 <= $self->{next_char} and  
                 $self->{next_char} <= 0xDFFF) or  
                (0xFDD0 <= $self->{next_char} and  
                 $self->{next_char} <= 0xFDDF) or  
                {  
                 0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,  
                 0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,  
                 0x4FFFE => 1, 0x4FFFF => 1, 0x5FFFE => 1, 0x5FFFF => 1,  
                 0x6FFFE => 1, 0x6FFFF => 1, 0x7FFFE => 1, 0x7FFFF => 1,  
                 0x8FFFE => 1, 0x8FFFF => 1, 0x9FFFE => 1, 0x9FFFF => 1,  
                 0xAFFFE => 1, 0xAFFFF => 1, 0xBFFFE => 1, 0xBFFFF => 1,  
                 0xCFFFE => 1, 0xCFFFF => 1, 0xDFFFE => 1, 0xDFFFF => 1,  
                 0xEFFFE => 1, 0xEFFFF => 1, 0xFFFFE => 1, 0xFFFFF => 1,  
                 0x10FFFE => 1, 0x10FFFF => 1,  
                }->{$self->{next_char}}) {  
         !!!cp ('i4.1');  
         if ($self->{next_char} < 0x10000) {  
           !!!parse-error (type => 'control char',  
                           text => (sprintf 'U+%04X', $self->{next_char}));  
         } else {  
           !!!parse-error (type => 'control char',  
                           text => (sprintf 'U-%08X', $self->{next_char}));  
         }  
7869        }        }
7870      };      };
7871      $p->{prev_char} = [-1, -1, -1];  
7872      $p->{next_char} = -1;      $p->{read_until} = sub {
7873              #my ($scalar, $specials_range, $offset) = @_;
7874          return 0 if defined $p->{next_next_char};
7875    
7876          my $pattern = qr/[^$_[1]\x00\x0A\x0D]/;
7877          my $offset = $_[2] || 0;
7878          
7879          if ($p->{char_buffer_pos} < length $p->{char_buffer}) {
7880            pos ($p->{char_buffer}) = $p->{char_buffer_pos};
7881            if ($p->{char_buffer} =~ /\G(?>$pattern)+/) {
7882              substr ($_[0], $offset)
7883                  = substr ($p->{char_buffer}, $-[0], $+[0] - $-[0]);
7884              my $count = $+[0] - $-[0];
7885              if ($count) {
7886                $p->{column} += $count;
7887                $p->{char_buffer_pos} += $count;
7888                $p->{line_prev} = $p->{line};
7889                $p->{column_prev} = $p->{column} - 1;
7890                $p->{prev_char} = [-1, -1, -1];
7891                $p->{next_char} = -1;
7892              }
7893              return $count;
7894            } else {
7895              return 0;
7896            }
7897          } else {
7898            my $count = $input->manakai_read_until ($_[0], $pattern, $_[2]);
7899            if ($count) {
7900              $p->{column} += $count;
7901              $p->{column_prev} += $count;
7902              $p->{prev_char} = [-1, -1, -1];
7903              $p->{next_char} = -1;
7904            }
7905            return $count;
7906          }
7907        }; # $p->{read_until}
7908    
7909      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7910        my (%opt) = @_;        my (%opt) = @_;
7911        my $line = $opt{line};        my $line = $opt{line};
# Line 7697  sub set_inner_html ($$$;$) { Line 7920  sub set_inner_html ($$$;$) {
7920        $ponerror->(line => $p->{line}, column => $p->{column}, @_);        $ponerror->(line => $p->{line}, column => $p->{column}, @_);
7921      };      };
7922            
7923        my $char_onerror = sub {
7924          my (undef, $type, %opt) = @_;
7925          $ponerror->(layer => 'encode',
7926                      line => $p->{line}, column => $p->{column} + 1,
7927                      %opt, type => $type);
7928        }; # $char_onerror
7929        $input->onerror ($char_onerror);
7930    
7931      $p->_initialize_tokenizer;      $p->_initialize_tokenizer;
7932      $p->_initialize_tree_constructor;      $p->_initialize_tree_constructor;
7933    
Legend:
Removed from v.1.167  
changed lines
  Added in v.1.182
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24