/[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.168 by wakaba, Sat Sep 13 10:49:21 2008 UTC revision 1.179 by wakaba, Sun Sep 14 13:09:01 2008 UTC
# Line 496  sub parse_byte_stream ($$$$;$$) { Line 496  sub parse_byte_stream ($$$$;$$) {
496                      line => 1, column => 1,                      line => 1, column => 1,
497                      layer => 'encode');                      layer => 'encode');
498    } elsif (not ($e_status &    } elsif (not ($e_status &
499                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL ())) {
500      $self->{input_encoding} = $charset->get_iana_name;      $self->{input_encoding} = $charset->get_iana_name;
501      !!!parse-error (type => 'chardecode:no error',      !!!parse-error (type => 'chardecode:no error',
502                      text => $self->{input_encoding},                      text => $self->{input_encoding},
# Line 561  sub parse_byte_stream ($$$$;$$) { Line 561  sub parse_byte_stream ($$$$;$$) {
561    my $char_onerror = sub {    my $char_onerror = sub {
562      my (undef, $type, %opt) = @_;      my (undef, $type, %opt) = @_;
563      !!!parse-error (layer => 'encode',      !!!parse-error (layer => 'encode',
564                      %opt, type => $type,                      line => $self->{line}, column => $self->{column} + 1,
565                      line => $self->{line}, column => $self->{column} + 1);                      %opt, type => $type);
566      if ($opt{octets}) {      if ($opt{octets}) {
567        ${$opt{octets}} = "\x{FFFD}"; # relacement character        ${$opt{octets}} = "\x{FFFD}"; # relacement character
568      }      }
# Line 586  sub parse_byte_stream ($$$$;$$) { Line 586  sub parse_byte_stream ($$$$;$$) {
586                        line => 1, column => 1,                        line => 1, column => 1,
587                        layer => 'encode');                        layer => 'encode');
588      } elsif (not ($e_status &      } elsif (not ($e_status &
589                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL ())) {
590        $self->{input_encoding} = $charset->get_iana_name;        $self->{input_encoding} = $charset->get_iana_name;
591        !!!parse-error (type => 'chardecode:no error',        !!!parse-error (type => 'chardecode:no error',
592                        text => $self->{input_encoding},                        text => $self->{input_encoding},
# Line 618  sub parse_byte_stream ($$$$;$$) { Line 618  sub parse_byte_stream ($$$$;$$) {
618  sub parse_char_string ($$$;$$) {  sub parse_char_string ($$$;$$) {
619    #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;    #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
620    my $self = shift;    my $self = shift;
   require utf8;  
621    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $s = ref $_[0] ? $_[0] : \($_[0]);
622    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;    require Whatpm::Charset::DecodeHandle;
623      my $input = Whatpm::Charset::DecodeHandle::CharString->new ($s);
624    if ($_[3]) {    if ($_[3]) {
625      $input = $_[3]->($input);      $input = $_[3]->($input);
626    }    }
# Line 639  sub parse_char_stream ($$$;$) { Line 639  sub parse_char_stream ($$$;$) {
639    $self->{confident} = 1 unless exists $self->{confident};    $self->{confident} = 1 unless exists $self->{confident};
640    $self->{document}->input_encoding ($self->{input_encoding})    $self->{document}->input_encoding ($self->{input_encoding})
641        if defined $self->{input_encoding};        if defined $self->{input_encoding};
642    ## TODO: |{input_encoding}| is needless?
643    
644    my $i = 0;    my $i = 0;
645    $self->{line_prev} = $self->{line} = 1;    $self->{line_prev} = $self->{line} = 1;
646    $self->{column_prev} = $self->{column} = 0;    $self->{column_prev} = -1;
647      $self->{column} = 0;
648    $self->{set_next_char} = sub {    $self->{set_next_char} = sub {
649      my $self = shift;      my $self = shift;
650    
651      pop @{$self->{prev_char}};      my $char = '';
     unshift @{$self->{prev_char}}, $self->{next_char};  
   
     my $char;  
652      if (defined $self->{next_next_char}) {      if (defined $self->{next_next_char}) {
653        $char = $self->{next_next_char};        $char = $self->{next_next_char};
654        delete $self->{next_next_char};        delete $self->{next_next_char};
655          $self->{next_char} = ord $char;
656      } else {      } else {
657        $char = $input->getc;        $self->{char_buffer} = '';
658          $self->{char_buffer_pos} = 0;
659    
660          my $count = $input->manakai_read_until
661             ($self->{char_buffer},
662              qr/(?!\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
663              $self->{char_buffer_pos});
664          if ($count) {
665            $self->{line_prev} = $self->{line};
666            $self->{column_prev} = $self->{column};
667            $self->{column}++;
668            $self->{next_char}
669                = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
670            return;
671          }
672    
673          if ($input->read ($char, 1)) {
674            $self->{next_char} = ord $char;
675          } else {
676            $self->{next_char} = -1;
677            return;
678          }
679      }      }
     $self->{next_char} = -1 and return unless defined $char;  
     $self->{next_char} = ord $char;  
680    
681      ($self->{line_prev}, $self->{column_prev})      ($self->{line_prev}, $self->{column_prev})
682          = ($self->{line}, $self->{column});          = ($self->{line}, $self->{column});
# Line 669  sub parse_char_stream ($$$;$) { Line 688  sub parse_char_stream ($$$;$) {
688        $self->{column} = 0;        $self->{column} = 0;
689      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
690        !!!cp ('j2');        !!!cp ('j2');
691        my $next = $input->getc;  ## TODO: support for abort/streaming
692        if (defined $next and $next ne "\x0A") {        my $next = '';
693          if ($input->read ($next, 1) and $next ne "\x0A") {
694          $self->{next_next_char} = $next;          $self->{next_next_char} = $next;
695        }        }
696        $self->{next_char} = 0x000A; # LF # MUST        $self->{next_char} = 0x000A; # LF # MUST
# Line 688  sub parse_char_stream ($$$;$) { Line 708  sub parse_char_stream ($$$;$) {
708               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or
709               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or
710               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or
711    ## ISSUE: U+FDE0-U+FDEF are not excluded
712               {               {
713                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,
714                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
# Line 712  sub parse_char_stream ($$$;$) { Line 733  sub parse_char_stream ($$$;$) {
733    $self->{prev_char} = [-1, -1, -1];    $self->{prev_char} = [-1, -1, -1];
734    $self->{next_char} = -1;    $self->{next_char} = -1;
735    
736      $self->{read_until} = sub {
737        #my ($scalar, $specials_range, $offset) = @_;
738        my $specials_range = $_[1];
739        return 0 if defined $self->{next_next_char};
740        my $count = $input->manakai_read_until
741           ($_[0],
742            qr/(?![$specials_range\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
743            $_[2]);
744        if ($count) {
745          $self->{column} += $count;
746          $self->{column_prev} += $count;
747          $self->{prev_char} = [-1, -1, -1];
748          $self->{next_char} = -1;
749        }
750        return $count;
751      }; # $self->{read_until}
752    $self->{read_until}=sub{0};
753    
754    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
755      my (%opt) = @_;      my (%opt) = @_;
756      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};
# Line 874  sub _initialize_tokenizer ($) { Line 913  sub _initialize_tokenizer ($) {
913    my $self = shift;    my $self = shift;
914    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
915    #$self->{state_keyword}; # initialized when used    #$self->{state_keyword}; # initialized when used
916      #$self->{entity__value}; # initialized when used
917      #$self->{entity__match}; # initialized when used
918    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
919    undef $self->{current_token};    undef $self->{current_token};
920    undef $self->{current_attribute};    undef $self->{current_attribute};
921    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
922    undef $self->{last_attribute_value_state};    #$self->{prev_state}; # initialized when used
923    delete $self->{self_closing};    delete $self->{self_closing};
924    $self->{char} = [];    $self->{char_buffer} = '';
925      $self->{char_buffer_pos} = 0;
926    # $self->{next_char}    # $self->{next_char}
927    !!!next-input-character;    !!!next-input-character;
928    $self->{token} = [];    $self->{token} = [];
# Line 912  sub _initialize_tokenizer ($) { Line 954  sub _initialize_tokenizer ($) {
954  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
955  ## and removed from the list.  ## and removed from the list.
956    
957  ## NOTE: HTML5 "Writing HTML documents" section, applied to  ## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.)
958  ## documents and not to user agents and conformance checkers,  ## (This requirement was dropped from HTML5 spec, unfortunately.)
 ## contains some requirements that are not detected by the  
 ## parsing algorithm:  
 ## - Some requirements on character encoding declarations. ## TODO  
 ## - "Elements MUST NOT contain content that their content model disallows."  
 ##   ... Some are parse error, some are not (will be reported by c.c.).  
 ## - Polytheistic slash SHOULD NOT be used. (Applied only to atheists.) ## TODO  
 ## - Text (in elements, attributes, and comments) SHOULD NOT contain  
 ##   control characters other than space characters. ## TODO: (what is control character? C0, C1 and DEL?  Unicode control character?)  
   
 ## TODO: HTML5 poses authors two SHOULD-level requirements that cannot  
 ## be detected by the HTML5 parsing algorithm:  
 ## - Text,  
959    
960  sub _get_next_token ($) {  sub _get_next_token ($) {
961    my $self = shift;    my $self = shift;
# Line 953  sub _get_next_token ($) { Line 983  sub _get_next_token ($) {
983            ## "entity data state".  In this implementation, the tokenizer            ## "entity data state".  In this implementation, the tokenizer
984            ## is switched to the |ENTITY_STATE|, which is an implementation            ## is switched to the |ENTITY_STATE|, which is an implementation
985            ## of the "consume a character reference" algorithm.            ## of the "consume a character reference" algorithm.
           $self->{entity_in_attr} = 0;  
986            $self->{entity_additional} = -1;            $self->{entity_additional} = -1;
987              $self->{prev_state} = DATA_STATE;
988            $self->{state} = ENTITY_STATE;            $self->{state} = ENTITY_STATE;
989            !!!next-input-character;            !!!next-input-character;
990            redo A;            redo A;
# Line 1019  sub _get_next_token ($) { Line 1049  sub _get_next_token ($) {
1049                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1050                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1051                    };                    };
1052          $self->{read_until}->($token->{data}, q[-!<>&], length $token->{data});
1053    
1054        ## Stay in the data state        ## Stay in the data state
1055        !!!next-input-character;        !!!next-input-character;
1056    
# Line 1698  sub _get_next_token ($) { Line 1730  sub _get_next_token ($) {
1730          redo A;          redo A;
1731        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1732          !!!cp (96);          !!!cp (96);
         $self->{last_attribute_value_state} = $self->{state};  
1733          ## NOTE: In the spec, the tokenizer is switched to the          ## NOTE: In the spec, the tokenizer is switched to the
1734          ## "entity in attribute value state".  In this implementation, the          ## "entity in attribute value state".  In this implementation, the
1735          ## tokenizer is switched to the |ENTITY_STATE|, which is an          ## tokenizer is switched to the |ENTITY_STATE|, which is an
1736          ## implementation of the "consume a character reference" algorithm.          ## implementation of the "consume a character reference" algorithm.
1737          $self->{entity_in_attr} = 1;          $self->{prev_state} = $self->{state};
1738          $self->{entity_additional} = 0x0022; # "          $self->{entity_additional} = 0x0022; # "
1739          $self->{state} = ENTITY_STATE;          $self->{state} = ENTITY_STATE;
1740          !!!next-input-character;          !!!next-input-character;
# Line 1734  sub _get_next_token ($) { Line 1765  sub _get_next_token ($) {
1765        } else {        } else {
1766          !!!cp (100);          !!!cp (100);
1767          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1768            $self->{read_until}->($self->{current_attribute}->{value},
1769                                  q["&],
1770                                  length $self->{current_attribute}->{value});
1771    
1772          ## Stay in the state          ## Stay in the state
1773          !!!next-input-character;          !!!next-input-character;
1774          redo A;          redo A;
# Line 1746  sub _get_next_token ($) { Line 1781  sub _get_next_token ($) {
1781          redo A;          redo A;
1782        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1783          !!!cp (102);          !!!cp (102);
         $self->{last_attribute_value_state} = $self->{state};  
1784          ## NOTE: In the spec, the tokenizer is switched to the          ## NOTE: In the spec, the tokenizer is switched to the
1785          ## "entity in attribute value state".  In this implementation, the          ## "entity in attribute value state".  In this implementation, the
1786          ## tokenizer is switched to the |ENTITY_STATE|, which is an          ## tokenizer is switched to the |ENTITY_STATE|, which is an
1787          ## implementation of the "consume a character reference" algorithm.          ## implementation of the "consume a character reference" algorithm.
         $self->{entity_in_attr} = 1;  
1788          $self->{entity_additional} = 0x0027; # '          $self->{entity_additional} = 0x0027; # '
1789            $self->{prev_state} = $self->{state};
1790          $self->{state} = ENTITY_STATE;          $self->{state} = ENTITY_STATE;
1791          !!!next-input-character;          !!!next-input-character;
1792          redo A;          redo A;
# Line 1782  sub _get_next_token ($) { Line 1816  sub _get_next_token ($) {
1816        } else {        } else {
1817          !!!cp (106);          !!!cp (106);
1818          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1819            $self->{read_until}->($self->{current_attribute}->{value},
1820                                  q['&],
1821                                  length $self->{current_attribute}->{value});
1822    
1823          ## Stay in the state          ## Stay in the state
1824          !!!next-input-character;          !!!next-input-character;
1825          redo A;          redo A;
# Line 1798  sub _get_next_token ($) { Line 1836  sub _get_next_token ($) {
1836          redo A;          redo A;
1837        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1838          !!!cp (108);          !!!cp (108);
         $self->{last_attribute_value_state} = $self->{state};  
1839          ## NOTE: In the spec, the tokenizer is switched to the          ## NOTE: In the spec, the tokenizer is switched to the
1840          ## "entity in attribute value state".  In this implementation, the          ## "entity in attribute value state".  In this implementation, the
1841          ## tokenizer is switched to the |ENTITY_STATE|, which is an          ## tokenizer is switched to the |ENTITY_STATE|, which is an
1842          ## implementation of the "consume a character reference" algorithm.          ## implementation of the "consume a character reference" algorithm.
         $self->{entity_in_attr} = 1;  
1843          $self->{entity_additional} = -1;          $self->{entity_additional} = -1;
1844            $self->{prev_state} = $self->{state};
1845          $self->{state} = ENTITY_STATE;          $self->{state} = ENTITY_STATE;
1846          !!!next-input-character;          !!!next-input-character;
1847          redo A;          redo A;
# Line 1865  sub _get_next_token ($) { Line 1902  sub _get_next_token ($) {
1902            !!!cp (116);            !!!cp (116);
1903          }          }
1904          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1905            $self->{read_until}->($self->{current_attribute}->{value},
1906                                  q["'=& >],
1907                                  length $self->{current_attribute}->{value});
1908    
1909          ## Stay in the state          ## Stay in the state
1910          !!!next-input-character;          !!!next-input-character;
1911          redo A;          redo A;
# Line 2009  sub _get_next_token ($) { Line 2050  sub _get_next_token ($) {
2050        } else {        } else {
2051          !!!cp (126);          !!!cp (126);
2052          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2053            $self->{read_until}->($self->{current_token}->{data},
2054                                  q[>],
2055                                  length $self->{current_token}->{data});
2056    
2057          ## Stay in the state.          ## Stay in the state.
2058          !!!next-input-character;          !!!next-input-character;
2059          redo A;          redo A;
# Line 2243  sub _get_next_token ($) { Line 2288  sub _get_next_token ($) {
2288        } else {        } else {
2289          !!!cp (147);          !!!cp (147);
2290          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2291            $self->{read_until}->($self->{current_token}->{data},
2292                                  q[-],
2293                                  length $self->{current_token}->{data});
2294    
2295          ## Stay in the state          ## Stay in the state
2296          !!!next-input-character;          !!!next-input-character;
2297          redo A;          redo A;
# Line 2608  sub _get_next_token ($) { Line 2657  sub _get_next_token ($) {
2657          !!!cp (190);          !!!cp (190);
2658          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2659              .= chr $self->{next_char};              .= chr $self->{next_char};
2660            $self->{read_until}->($self->{current_token}->{public_identifier},
2661                                  q[">],
2662                                  length $self->{current_token}->{public_identifier});
2663    
2664          ## Stay in the state          ## Stay in the state
2665          !!!next-input-character;          !!!next-input-character;
2666          redo A;          redo A;
# Line 2644  sub _get_next_token ($) { Line 2697  sub _get_next_token ($) {
2697          !!!cp (194);          !!!cp (194);
2698          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2699              .= chr $self->{next_char};              .= chr $self->{next_char};
2700            $self->{read_until}->($self->{current_token}->{public_identifier},
2701                                  q['>],
2702                                  length $self->{current_token}->{public_identifier});
2703    
2704          ## Stay in the state          ## Stay in the state
2705          !!!next-input-character;          !!!next-input-character;
2706          redo A;          redo A;
# Line 2780  sub _get_next_token ($) { Line 2837  sub _get_next_token ($) {
2837          !!!cp (210);          !!!cp (210);
2838          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2839              .= chr $self->{next_char};              .= chr $self->{next_char};
2840            $self->{read_until}->($self->{current_token}->{system_identifier},
2841                                  q[">],
2842                                  length $self->{current_token}->{system_identifier});
2843    
2844          ## Stay in the state          ## Stay in the state
2845          !!!next-input-character;          !!!next-input-character;
2846          redo A;          redo A;
# Line 2816  sub _get_next_token ($) { Line 2877  sub _get_next_token ($) {
2877          !!!cp (214);          !!!cp (214);
2878          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2879              .= chr $self->{next_char};              .= chr $self->{next_char};
2880            $self->{read_until}->($self->{current_token}->{system_identifier},
2881                                  q['>],
2882                                  length $self->{current_token}->{system_identifier});
2883    
2884          ## Stay in the state          ## Stay in the state
2885          !!!next-input-character;          !!!next-input-character;
2886          redo A;          redo A;
# Line 2876  sub _get_next_token ($) { Line 2941  sub _get_next_token ($) {
2941          redo A;          redo A;
2942        } else {        } else {
2943          !!!cp (221);          !!!cp (221);
2944            my $s = '';
2945            $self->{read_until}->($s, q[>], 0);
2946    
2947          ## Stay in the state          ## Stay in the state
2948          !!!next-input-character;          !!!next-input-character;
2949          redo A;          redo A;
# Line 2904  sub _get_next_token ($) { Line 2972  sub _get_next_token ($) {
2972        } else {        } else {
2973          !!!cp (221.4);          !!!cp (221.4);
2974          $self->{current_token}->{data} .= chr $self->{next_char};          $self->{current_token}->{data} .= chr $self->{next_char};
2975            $self->{read_until}->($self->{current_token}->{data},
2976                                  q<]>,
2977                                  length $self->{current_token}->{data});
2978    
2979          ## Stay in the state.          ## Stay in the state.
2980          !!!next-input-character;          !!!next-input-character;
2981          redo A;          redo A;
# Line 2960  sub _get_next_token ($) { Line 3032  sub _get_next_token ($) {
3032          ## Return nothing.          ## Return nothing.
3033          #          #
3034        } elsif ($self->{next_char} == 0x0023) { # #        } elsif ($self->{next_char} == 0x0023) { # #
3035            !!!cp (999);
3036          $self->{state} = ENTITY_HASH_STATE;          $self->{state} = ENTITY_HASH_STATE;
3037          $self->{state_keyword} = '#';          $self->{state_keyword} = '#';
3038          !!!next-input-character;          !!!next-input-character;
# Line 2968  sub _get_next_token ($) { Line 3041  sub _get_next_token ($) {
3041                  $self->{next_char} <= 0x005A) or # A..Z                  $self->{next_char} <= 0x005A) or # A..Z
3042                 (0x0061 <= $self->{next_char} and                 (0x0061 <= $self->{next_char} and
3043                  $self->{next_char} <= 0x007A)) { # a..z                  $self->{next_char} <= 0x007A)) { # a..z
3044            !!!cp (998);
3045          require Whatpm::_NamedEntityList;          require Whatpm::_NamedEntityList;
3046          $self->{state} = ENTITY_NAME_STATE;          $self->{state} = ENTITY_NAME_STATE;
3047          $self->{state_keyword} = chr $self->{next_char};          $self->{state_keyword} = chr $self->{next_char};
# Line 2988  sub _get_next_token ($) { Line 3062  sub _get_next_token ($) {
3062        ## appended to the parent element or the attribute value in later        ## appended to the parent element or the attribute value in later
3063        ## process of the tokenizer.        ## process of the tokenizer.
3064    
3065        if ($self->{entity_in_attr}) {        if ($self->{prev_state} == DATA_STATE) {
3066          $self->{current_attribute}->{value} .= '&';          !!!cp (997);
3067          $self->{state} = $self->{last_attribute_value_state};          $self->{state} = $self->{prev_state};
         ## Reconsume.  
         redo A;  
       } else {  
         $self->{state} = DATA_STATE;  
3068          ## Reconsume.          ## Reconsume.
3069          !!!emit ({type => CHARACTER_TOKEN, data => '&',          !!!emit ({type => CHARACTER_TOKEN, data => '&',
3070                    line => $self->{line_prev},                    line => $self->{line_prev},
3071                    column => $self->{column_prev},                    column => $self->{column_prev},
3072                   });                   });
3073          redo A;          redo A;
3074          } else {
3075            !!!cp (996);
3076            $self->{current_attribute}->{value} .= '&';
3077            $self->{state} = $self->{prev_state};
3078            ## Reconsume.
3079            redo A;
3080        }        }
3081      } elsif ($self->{state} == ENTITY_HASH_STATE) {      } elsif ($self->{state} == ENTITY_HASH_STATE) {
3082        if ($self->{next_char} == 0x0078 or # x        if ($self->{next_char} == 0x0078 or # x
3083            $self->{next_char} == 0x0058) { # X            $self->{next_char} == 0x0058) { # X
3084            !!!cp (995);
3085          $self->{state} = HEXREF_X_STATE;          $self->{state} = HEXREF_X_STATE;
3086          $self->{state_keyword} .= chr $self->{next_char};          $self->{state_keyword} .= chr $self->{next_char};
3087          !!!next-input-character;          !!!next-input-character;
3088          redo A;          redo A;
3089        } elsif (0x0030 <= $self->{next_char} and        } elsif (0x0030 <= $self->{next_char} and
3090                 $self->{next_char} <= 0x0039) { # 0..9                 $self->{next_char} <= 0x0039) { # 0..9
3091            !!!cp (994);
3092          $self->{state} = NCR_NUM_STATE;          $self->{state} = NCR_NUM_STATE;
3093          $self->{state_keyword} = $self->{next_char} - 0x0030;          $self->{state_keyword} = $self->{next_char} - 0x0030;
3094          !!!next-input-character;          !!!next-input-character;
3095          redo A;          redo A;
3096        } else {        } else {
         !!!cp (1019);  
3097          !!!parse-error (type => 'bare nero',          !!!parse-error (type => 'bare nero',
3098                          line => $self->{line_prev},                          line => $self->{line_prev},
3099                          column => $self->{column_prev} - 1);                          column => $self->{column_prev} - 1);
# Line 3025  sub _get_next_token ($) { Line 3102  sub _get_next_token ($) {
3102          ## and then "&#" is appended to the parent element or the attribute          ## and then "&#" is appended to the parent element or the attribute
3103          ## value in the later processing.          ## value in the later processing.
3104    
3105          if ($self->{entity_in_attr}) {          if ($self->{prev_state} == DATA_STATE) {
3106            $self->{current_attribute}->{value} .= '&#';            !!!cp (1019);
3107            $self->{state} = $self->{last_attribute_value_state};            $self->{state} = $self->{prev_state};
           ## Reconsume.  
           redo A;  
         } else {  
           $self->{state} = DATA_STATE;  
3108            ## Reconsume.            ## Reconsume.
3109            !!!emit ({type => CHARACTER_TOKEN,            !!!emit ({type => CHARACTER_TOKEN,
3110                      data => '&#',                      data => '&#',
# Line 3039  sub _get_next_token ($) { Line 3112  sub _get_next_token ($) {
3112                      column => $self->{column_prev} - 1,                      column => $self->{column_prev} - 1,
3113                     });                     });
3114            redo A;            redo A;
3115            } else {
3116              !!!cp (993);
3117              $self->{current_attribute}->{value} .= '&#';
3118              $self->{state} = $self->{prev_state};
3119              ## Reconsume.
3120              redo A;
3121          }          }
3122        }        }
3123      } elsif ($self->{state} == NCR_NUM_STATE) {      } elsif ($self->{state} == NCR_NUM_STATE) {
# Line 3090  sub _get_next_token ($) { Line 3169  sub _get_next_token ($) {
3169          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3170        }        }
3171    
3172        if ($self->{entity_in_attr}) {        if ($self->{prev_state} == DATA_STATE) {
3173          $self->{current_attribute}->{value} .= chr $code;          !!!cp (992);
3174          $self->{current_attribute}->{has_reference} = 1;          $self->{state} = $self->{prev_state};
         $self->{state} = $self->{last_attribute_value_state};  
         ## Reconsume.  
         redo A;  
       } else {  
         $self->{state} = DATA_STATE;  
3175          ## Reconsume.          ## Reconsume.
3176          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
                   has_reference => 1,  
3177                    line => $l, column => $c,                    line => $l, column => $c,
3178                   });                   });
3179          redo A;          redo A;
3180          } else {
3181            !!!cp (991);
3182            $self->{current_attribute}->{value} .= chr $code;
3183            $self->{current_attribute}->{has_reference} = 1;
3184            $self->{state} = $self->{prev_state};
3185            ## Reconsume.
3186            redo A;
3187        }        }
3188      } elsif ($self->{state} == HEXREF_X_STATE) {      } elsif ($self->{state} == HEXREF_X_STATE) {
3189        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3190            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3191            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3192          # 0..9, A..F, a..f          # 0..9, A..F, a..f
3193            !!!cp (990);
3194          $self->{state} = HEXREF_HEX_STATE;          $self->{state} = HEXREF_HEX_STATE;
3195          $self->{state_keyword} = 0;          $self->{state_keyword} = 0;
3196          ## Reconsume.          ## Reconsume.
3197          redo A;          redo A;
3198        } else {        } else {
         !!!cp (1005);  
3199          !!!parse-error (type => 'bare hcro',          !!!parse-error (type => 'bare hcro',
3200                          line => $self->{line_prev},                          line => $self->{line_prev},
3201                          column => $self->{column_prev} - 2);                          column => $self->{column_prev} - 2);
# Line 3124  sub _get_next_token ($) { Line 3204  sub _get_next_token ($) {
3204          ## and then "&#" followed by "X" or "x" is appended to the parent          ## and then "&#" followed by "X" or "x" is appended to the parent
3205          ## element or the attribute value in the later processing.          ## element or the attribute value in the later processing.
3206    
3207          if ($self->{entity_in_attr}) {          if ($self->{prev_state} == DATA_STATE) {
3208            $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};            !!!cp (1005);
3209            $self->{state} = $self->{last_attribute_value_state};            $self->{state} = $self->{prev_state};
           ## Reconsume.  
           redo A;  
         } else {  
           $self->{state} = DATA_STATE;  
3210            ## Reconsume.            ## Reconsume.
3211            !!!emit ({type => CHARACTER_TOKEN,            !!!emit ({type => CHARACTER_TOKEN,
3212                      data => '&' . $self->{state_keyword},                      data => '&' . $self->{state_keyword},
# Line 3138  sub _get_next_token ($) { Line 3214  sub _get_next_token ($) {
3214                      column => $self->{column_prev} - length $self->{state_keyword},                      column => $self->{column_prev} - length $self->{state_keyword},
3215                     });                     });
3216            redo A;            redo A;
3217            } else {
3218              !!!cp (989);
3219              $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3220              $self->{state} = $self->{prev_state};
3221              ## Reconsume.
3222              redo A;
3223          }          }
3224        }        }
3225      } elsif ($self->{state} == HEXREF_HEX_STATE) {      } elsif ($self->{state} == HEXREF_HEX_STATE) {
# Line 3203  sub _get_next_token ($) { Line 3285  sub _get_next_token ($) {
3285          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3286        }        }
3287    
3288        if ($self->{entity_in_attr}) {        if ($self->{prev_state} == DATA_STATE) {
3289          $self->{current_attribute}->{value} .= chr $code;          !!!cp (988);
3290          $self->{current_attribute}->{has_reference} = 1;          $self->{state} = $self->{prev_state};
         $self->{state} = $self->{last_attribute_value_state};  
         ## Reconsume.  
         redo A;  
       } else {  
         $self->{state} = DATA_STATE;  
3291          ## Reconsume.          ## Reconsume.
3292          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
                   has_reference => 1,  
3293                    line => $l, column => $c,                    line => $l, column => $c,
3294                   });                   });
3295          redo A;          redo A;
3296          } else {
3297            !!!cp (987);
3298            $self->{current_attribute}->{value} .= chr $code;
3299            $self->{current_attribute}->{has_reference} = 1;
3300            $self->{state} = $self->{prev_state};
3301            ## Reconsume.
3302            redo A;
3303        }        }
3304      } elsif ($self->{state} == ENTITY_NAME_STATE) {      } elsif ($self->{state} == ENTITY_NAME_STATE) {
3305        if (length $self->{state_keyword} < 30 and        if (length $self->{state_keyword} < 30 and
# Line 3264  sub _get_next_token ($) { Line 3347  sub _get_next_token ($) {
3347          #          #
3348        } elsif ($self->{entity__match} < 0) {        } elsif ($self->{entity__match} < 0) {
3349          !!!parse-error (type => 'no refc');          !!!parse-error (type => 'no refc');
3350          if ($self->{entity_in_attr} and $self->{entity__match} < -1) {          if ($self->{prev_state} != DATA_STATE and # in attribute
3351                $self->{entity__match} < -1) {
3352            !!!cp (1024);            !!!cp (1024);
3353            $data = '&' . $self->{state_keyword};            $data = '&' . $self->{state_keyword};
3354            #            #
# Line 3278  sub _get_next_token ($) { Line 3362  sub _get_next_token ($) {
3362          !!!cp (1026);          !!!cp (1026);
3363          !!!parse-error (type => 'bare ero',          !!!parse-error (type => 'bare ero',
3364                          line => $self->{line_prev},                          line => $self->{line_prev},
3365                          column => $self->{column_prev});                          column => $self->{column_prev} - length $self->{state_keyword});
3366          $data = '&' . $self->{state_keyword};          $data = '&' . $self->{state_keyword};
3367          #          #
3368        }        }
# Line 3293  sub _get_next_token ($) { Line 3377  sub _get_next_token ($) {
3377        ## that would not be consumed are appended in the data state or in an        ## that would not be consumed are appended in the data state or in an
3378        ## appropriate attribute value state anyway.        ## appropriate attribute value state anyway.
3379    
3380        if ($self->{entity_in_attr}) {        if ($self->{prev_state} == DATA_STATE) {
3381          $self->{current_attribute}->{value} .= $data;          !!!cp (986);
3382          $self->{current_attribute}->{has_reference} = 1 if $has_ref;          $self->{state} = $self->{prev_state};
         $self->{state} = $self->{last_attribute_value_state};  
         ## Reconsume.  
         redo A;  
       } else {  
         $self->{state} = DATA_STATE;  
3383          ## Reconsume.          ## Reconsume.
3384          !!!emit ({type => CHARACTER_TOKEN,          !!!emit ({type => CHARACTER_TOKEN,
3385                    data => $data, has_reference => $has_ref,                    data => $data,
3386                    line => $self->{line_prev},                    line => $self->{line_prev},
3387                    column => $self->{column_prev} + 1 - length $self->{state_keyword},                    column => $self->{column_prev} + 1 - length $self->{state_keyword},
3388                   });                   });
3389          redo A;          redo A;
3390          } else {
3391            !!!cp (985);
3392            $self->{current_attribute}->{value} .= $data;
3393            $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3394            $self->{state} = $self->{prev_state};
3395            ## Reconsume.
3396            redo A;
3397        }        }
3398      } else {      } else {
3399        die "$0: $self->{state}: Unknown state";        die "$0: $self->{state}: Unknown state";
# Line 4414  sub _tree_construction_main ($) { Line 4500  sub _tree_construction_main ($) {
4500            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4501              !!!cp ('t88.2');              !!!cp ('t88.2');
4502              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4503                #
4504            } else {            } else {
4505              !!!cp ('t88.1');              !!!cp ('t88.1');
4506              ## Ignore the token.              ## Ignore the token.
4507              !!!next-token;              #
             next B;  
4508            }            }
4509            unless (length $token->{data}) {            unless (length $token->{data}) {
4510              !!!cp ('t88');              !!!cp ('t88');
4511              !!!next-token;              !!!next-token;
4512              next B;              next B;
4513            }            }
4514    ## TODO: set $token->{column} appropriately
4515          }          }
4516    
4517          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {
# Line 7669  sub _tree_construction_main ($) { Line 7756  sub _tree_construction_main ($) {
7756    ## TODO: script stuffs    ## TODO: script stuffs
7757  } # _tree_construct_main  } # _tree_construct_main
7758    
7759  sub set_inner_html ($$$;$) {  sub set_inner_html ($$$$;$) {
7760    my $class = shift;    my $class = shift;
7761    my $node = shift;    my $node = shift;
7762    my $s = \$_[0];    #my $s = \$_[0];
7763    my $onerror = $_[1];    my $onerror = $_[1];
7764    my $get_wrapper = $_[2] || sub ($) { return $_[0] };    my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7765    
# Line 7693  sub set_inner_html ($$$;$) { Line 7780  sub set_inner_html ($$$;$) {
7780      }      }
7781    
7782      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7783      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);      $class->parse_char_string ($_[0] => $node, $onerror, $get_wrapper);
7784    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7785      ## TODO: If non-html element      ## TODO: If non-html element
7786    
# Line 7712  sub set_inner_html ($$$;$) { Line 7799  sub set_inner_html ($$$;$) {
7799      my $i = 0;      my $i = 0;
7800      $p->{line_prev} = $p->{line} = 1;      $p->{line_prev} = $p->{line} = 1;
7801      $p->{column_prev} = $p->{column} = 0;      $p->{column_prev} = $p->{column} = 0;
7802        require Whatpm::Charset::DecodeHandle;
7803        my $input = Whatpm::Charset::DecodeHandle::CharString->new (\($_[0]));
7804        $input = $get_wrapper->($input);
7805      $p->{set_next_char} = sub {      $p->{set_next_char} = sub {
7806        my $self = shift;        my $self = shift;
7807    
7808        pop @{$self->{prev_char}};        pop @{$self->{prev_char}};
7809        unshift @{$self->{prev_char}}, $self->{next_char};        unshift @{$self->{prev_char}}, $self->{next_char};
7810    
7811        $self->{next_char} = -1 and return if $i >= length $$s;        my $char = '';
7812        $self->{next_char} = ord substr $$s, $i++, 1;        if (defined $self->{next_next_char}) {
7813            $char = $self->{next_next_char};
7814            delete $self->{next_next_char};
7815            $self->{next_char} = ord $char;
7816          } else {
7817            if ($input->read ($char, 1)) {
7818              $self->{next_char} = ord $char;
7819            } else {
7820              $self->{next_char} = -1;
7821              return;
7822            }
7823          }
7824    
7825        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});
7826        $p->{column}++;        $p->{column}++;
# Line 7729  sub set_inner_html ($$$;$) { Line 7830  sub set_inner_html ($$$;$) {
7830          $p->{column} = 0;          $p->{column} = 0;
7831          !!!cp ('i1');          !!!cp ('i1');
7832        } elsif ($self->{next_char} == 0x000D) { # CR        } elsif ($self->{next_char} == 0x000D) { # CR
7833          $i++ if substr ($$s, $i, 1) eq "\x0A";  ## TODO: support for abort/streaming
7834            my $next = '';
7835            if ($input->read ($next, 1) and $next ne "\x0A") {
7836              $self->{next_next_char} = $next;
7837            }
7838          $self->{next_char} = 0x000A; # LF # MUST          $self->{next_char} = 0x000A; # LF # MUST
7839          $p->{line}++;          $p->{line}++;
7840          $p->{column} = 0;          $p->{column} = 0;
# Line 7773  sub set_inner_html ($$$;$) { Line 7878  sub set_inner_html ($$$;$) {
7878      };      };
7879      $p->{prev_char} = [-1, -1, -1];      $p->{prev_char} = [-1, -1, -1];
7880      $p->{next_char} = -1;      $p->{next_char} = -1;
7881        
7882        $p->{read_until} = sub {
7883          #my ($scalar, $specials_range, $offset) = @_;
7884          my $specials_range = $_[1];
7885          return 0 if defined $p->{next_next_char};
7886          my $count = $input->manakai_read_until
7887            ($_[0],
7888             qr/(?![$specials_range\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
7889             $_[2]);
7890          if ($count) {
7891            $p->{column} += $count;
7892            $p->{column_prev} += $count;
7893            $p->{prev_char} = [-1, -1, -1];
7894            $p->{next_char} = -1;
7895          }
7896          return $count;
7897        }; # $p->{read_until}
7898    
7899      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7900        my (%opt) = @_;        my (%opt) = @_;
7901        my $line = $opt{line};        my $line = $opt{line};
# Line 7788  sub set_inner_html ($$$;$) { Line 7910  sub set_inner_html ($$$;$) {
7910        $ponerror->(line => $p->{line}, column => $p->{column}, @_);        $ponerror->(line => $p->{line}, column => $p->{column}, @_);
7911      };      };
7912            
7913        my $char_onerror = sub {
7914          my (undef, $type, %opt) = @_;
7915          $ponerror->(layer => 'encode',
7916                      line => $p->{line}, column => $p->{column} + 1,
7917                      %opt, type => $type);
7918        }; # $char_onerror
7919        $input->onerror ($char_onerror);
7920    
7921      $p->_initialize_tokenizer;      $p->_initialize_tokenizer;
7922      $p->_initialize_tree_constructor;      $p->_initialize_tree_constructor;
7923    
Legend:
Removed from v.1.168  
changed lines
  Added in v.1.179
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24