/[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.155 by wakaba, Sat Aug 30 12:57:05 2008 UTC revision 1.164 by wakaba, Sat Sep 13 06:33:39 2008 UTC
# Line 354  sub parse_byte_string ($$$$;$) { Line 354  sub parse_byte_string ($$$$;$) {
354    return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);    return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);
355  } # parse_byte_string  } # parse_byte_string
356    
357  sub parse_byte_stream ($$$$;$) {  sub parse_byte_stream ($$$$;$$) {
358      # my ($self, $charset_name, $byte_stream, $doc, $onerror, $get_wrapper) = @_;
359    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
360    my $charset_name = shift;    my $charset_name = shift;
361    my $byte_stream = $_[0];    my $byte_stream = $_[0];
# Line 365  sub parse_byte_stream ($$$$;$) { Line 366  sub parse_byte_stream ($$$$;$) {
366    };    };
367    $self->{parse_error} = $onerror; # updated later by parse_char_string    $self->{parse_error} = $onerror; # updated later by parse_char_string
368    
369      my $get_wrapper = $_[3] || sub ($) {
370        return $_[0]; # $_[0] = byte stream handle, returned = arg to char handle
371      };
372    
373    ## HTML5 encoding sniffing algorithm    ## HTML5 encoding sniffing algorithm
374    require Message::Charset::Info;    require Message::Charset::Info;
375    my $charset;    my $charset;
# Line 372  sub parse_byte_stream ($$$$;$) { Line 377  sub parse_byte_stream ($$$$;$) {
377    my ($char_stream, $e_status);    my ($char_stream, $e_status);
378    
379    SNIFFING: {    SNIFFING: {
380        ## NOTE: By setting |allow_fallback| option true when the
381        ## |get_decode_handle| method is invoked, we ignore what the HTML5
382        ## spec requires, i.e. unsupported encoding should be ignored.
383          ## TODO: We should not do this unless the parser is invoked
384          ## in the conformance checking mode, in which this behavior
385          ## would be useful.
386    
387      ## Step 1      ## Step 1
388      if (defined $charset_name) {      if (defined $charset_name) {
389        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
390              ## TODO: Is this ok?  Transfer protocol's parameter should be
391              ## interpreted in its semantics?
392    
393        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
394        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
# Line 399  sub parse_byte_stream ($$$$;$) { Line 412  sub parse_byte_stream ($$$$;$) {
412    
413      ## Step 3      ## Step 3
414      if ($byte_buffer =~ /^\xFE\xFF/) {      if ($byte_buffer =~ /^\xFE\xFF/) {
415        $charset = Message::Charset::Info->get_by_iana_name ('utf-16be');        $charset = Message::Charset::Info->get_by_html_name ('utf-16be');
416        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
417            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
418             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
419        $self->{confident} = 1;        $self->{confident} = 1;
420        last SNIFFING;        last SNIFFING;
421      } elsif ($byte_buffer =~ /^\xFF\xFE/) {      } elsif ($byte_buffer =~ /^\xFF\xFE/) {
422        $charset = Message::Charset::Info->get_by_iana_name ('utf-16le');        $charset = Message::Charset::Info->get_by_html_name ('utf-16le');
423        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
424            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
425             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
426        $self->{confident} = 1;        $self->{confident} = 1;
427        last SNIFFING;        last SNIFFING;
428      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {
429        $charset = Message::Charset::Info->get_by_iana_name ('utf-8');        $charset = Message::Charset::Info->get_by_html_name ('utf-8');
430        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
431            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
432             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
# Line 432  sub parse_byte_stream ($$$$;$) { Line 445  sub parse_byte_stream ($$$$;$) {
445      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string
446          ($byte_buffer);          ($byte_buffer);
447      if (defined $charset_name) {      if (defined $charset_name) {
448        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
449    
450        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
451        require Whatpm::Charset::DecodeHandle;        require Whatpm::Charset::DecodeHandle;
# Line 455  sub parse_byte_stream ($$$$;$) { Line 468  sub parse_byte_stream ($$$$;$) {
468    
469      ## Step 7: default      ## Step 7: default
470      ## TODO: Make this configurable.      ## TODO: Make this configurable.
471      $charset = Message::Charset::Info->get_by_iana_name ('windows-1252');      $charset = Message::Charset::Info->get_by_html_name ('windows-1252');
472          ## NOTE: We choose |windows-1252| here, since |utf-8| should be          ## NOTE: We choose |windows-1252| here, since |utf-8| should be
473          ## detectable in the step 6.          ## detectable in the step 6.
474      require Whatpm::Charset::DecodeHandle;      require Whatpm::Charset::DecodeHandle;
# Line 475  sub parse_byte_stream ($$$$;$) { Line 488  sub parse_byte_stream ($$$$;$) {
488      $self->{confident} = 0;      $self->{confident} = 0;
489    } # SNIFFING    } # SNIFFING
490    
   $self->{input_encoding} = $charset->get_iana_name;  
491    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
492        $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
493      !!!parse-error (type => 'chardecode:fallback',      !!!parse-error (type => 'chardecode:fallback',
494                      text => $self->{input_encoding},                      #text => $self->{input_encoding},
495                      level => $self->{level}->{uncertain},                      level => $self->{level}->{uncertain},
496                      line => 1, column => 1,                      line => 1, column => 1,
497                      layer => 'encode');                      layer => 'encode');
498    } elsif (not ($e_status &    } elsif (not ($e_status &
499                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
500        $self->{input_encoding} = $charset->get_iana_name;
501      !!!parse-error (type => 'chardecode:no error',      !!!parse-error (type => 'chardecode:no error',
502                      text => $self->{input_encoding},                      text => $self->{input_encoding},
503                      level => $self->{level}->{uncertain},                      level => $self->{level}->{uncertain},
504                      line => 1, column => 1,                      line => 1, column => 1,
505                      layer => 'encode');                      layer => 'encode');
506      } else {
507        $self->{input_encoding} = $charset->get_iana_name;
508    }    }
509    
510    $self->{change_encoding} = sub {    $self->{change_encoding} = sub {
# Line 496  sub parse_byte_stream ($$$$;$) { Line 512  sub parse_byte_stream ($$$$;$) {
512      $charset_name = shift;      $charset_name = shift;
513      my $token = shift;      my $token = shift;
514    
515      $charset = Message::Charset::Info->get_by_iana_name ($charset_name);      $charset = Message::Charset::Info->get_by_html_name ($charset_name);
516      ($char_stream, $e_status) = $charset->get_decode_handle      ($char_stream, $e_status) = $charset->get_decode_handle
517          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,
518           byte_buffer => \ $buffer->{buffer});           byte_buffer => \ $buffer->{buffer});
# Line 507  sub parse_byte_stream ($$$$;$) { Line 523  sub parse_byte_stream ($$$$;$) {
523        ## Step 1            ## Step 1    
524        if ($charset->{category} &        if ($charset->{category} &
525            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {
526          $charset = Message::Charset::Info->get_by_iana_name ('utf-8');          $charset = Message::Charset::Info->get_by_html_name ('utf-8');
527          ($char_stream, $e_status) = $charset->get_decode_handle          ($char_stream, $e_status) = $charset->get_decode_handle
528              ($byte_stream,              ($byte_stream,
529               byte_buffer => \ $buffer->{buffer});               byte_buffer => \ $buffer->{buffer});
# Line 551  sub parse_byte_stream ($$$$;$) { Line 567  sub parse_byte_stream ($$$$;$) {
567        ${$opt{octets}} = "\x{FFFD}"; # relacement character        ${$opt{octets}} = "\x{FFFD}"; # relacement character
568      }      }
569    };    };
570    $char_stream->onerror ($char_onerror);  
571      my $wrapped_char_stream = $get_wrapper->($char_stream);
572      $wrapped_char_stream->onerror ($char_onerror);
573    
574    my @args = @_; shift @args; # $s    my @args = @_; shift @args; # $s
575    my $return;    my $return;
576    try {    try {
577      $return = $self->parse_char_stream ($char_stream, @args);        $return = $self->parse_char_stream ($wrapped_char_stream, @args);  
578    } catch Whatpm::HTML::RestartParser with {    } catch Whatpm::HTML::RestartParser with {
579      ## NOTE: Invoked after {change_encoding}.      ## NOTE: Invoked after {change_encoding}.
580    
     $self->{input_encoding} = $charset->get_iana_name;  
581      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
582          $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
583        !!!parse-error (type => 'chardecode:fallback',        !!!parse-error (type => 'chardecode:fallback',
                       text => $self->{input_encoding},  
584                        level => $self->{level}->{uncertain},                        level => $self->{level}->{uncertain},
585                          #text => $self->{input_encoding},
586                        line => 1, column => 1,                        line => 1, column => 1,
587                        layer => 'encode');                        layer => 'encode');
588      } elsif (not ($e_status &      } elsif (not ($e_status &
589                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
590          $self->{input_encoding} = $charset->get_iana_name;
591        !!!parse-error (type => 'chardecode:no error',        !!!parse-error (type => 'chardecode:no error',
592                        text => $self->{input_encoding},                        text => $self->{input_encoding},
593                        level => $self->{level}->{uncertain},                        level => $self->{level}->{uncertain},
594                        line => 1, column => 1,                        line => 1, column => 1,
595                        layer => 'encode');                        layer => 'encode');
596        } else {
597          $self->{input_encoding} = $charset->get_iana_name;
598      }      }
599      $self->{confident} = 1;      $self->{confident} = 1;
600      $char_stream->onerror ($char_onerror);  
601      $return = $self->parse_char_stream ($char_stream, @args);      $wrapped_char_stream = $get_wrapper->($char_stream);
602        $wrapped_char_stream->onerror ($char_onerror);
603    
604        $return = $self->parse_char_stream ($wrapped_char_stream, @args);
605    };    };
606    return $return;    return $return;
607  } # parse_byte_stream  } # parse_byte_stream
# Line 591  sub parse_byte_stream ($$$$;$) { Line 615  sub parse_byte_stream ($$$$;$) {
615  ## such as |parse_byte_string| in this module, must ensure that it does  ## such as |parse_byte_string| in this module, must ensure that it does
616  ## strip the BOM and never strip any ZWNBSP.  ## strip the BOM and never strip any ZWNBSP.
617    
618  sub parse_char_string ($$$;$) {  sub parse_char_string ($$$;$$) {
619      #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
620    my $self = shift;    my $self = shift;
621    require utf8;    require utf8;
622    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $s = ref $_[0] ? $_[0] : \($_[0]);
623    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;
624      if ($_[3]) {
625        $input = $_[3]->($input);
626      }
627    return $self->parse_char_stream ($input, @_[1..$#_]);    return $self->parse_char_stream ($input, @_[1..$#_]);
628  } # parse_char_string  } # parse_char_string
629  *parse_string = \&parse_char_string;  *parse_string = \&parse_char_string; ## NOTE: Alias for backward compatibility.
630    
631  sub parse_char_stream ($$$;$) {  sub parse_char_stream ($$$;$) {
632    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
# Line 708  sub new ($) { Line 736  sub new ($) {
736    my $class = shift;    my $class = shift;
737    my $self = bless {    my $self = bless {
738      level => {must => 'm',      level => {must => 'm',
739                  should => 's',
740                warn => 'w',                warn => 'w',
741                info => 'i',                info => 'i',
742                uncertain => 'u'},                uncertain => 'u'},
# Line 775  sub BOGUS_DOCTYPE_STATE () { 32 } Line 804  sub BOGUS_DOCTYPE_STATE () { 32 }
804  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }
805  sub SELF_CLOSING_START_TAG_STATE () { 34 }  sub SELF_CLOSING_START_TAG_STATE () { 34 }
806  sub CDATA_BLOCK_STATE () { 35 }  sub CDATA_BLOCK_STATE () { 35 }
807    sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec
808    sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec
809    sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec
810    sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec
811    
812  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
813  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 827  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 860  sub IN_COLUMN_GROUP_IM () { 0b10 }
860  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
861    my $self = shift;    my $self = shift;
862    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
863      #$self->{state_keyword}; # initialized when used
864    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
865    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE
866    undef $self->{current_attribute};    undef $self->{current_attribute};
# Line 1089  sub _get_next_token ($) { Line 1123  sub _get_next_token ($) {
1123          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1124        }        }
1125      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1126          ## NOTE: The "close tag open state" in the spec is implemented as
1127          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1128    
1129        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1130        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1131          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1132              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1133            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1134            my @next_char;            ## Reconsume.
1135            TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {            redo A;
             push @next_char, $self->{next_char};  
             my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);  
             my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;  
             if ($self->{next_char} == $c or $self->{next_char} == $C) {  
               !!!cp (24);  
               !!!next-input-character;  
               next TAGNAME;  
             } else {  
               !!!cp (25);  
               $self->{next_char} = shift @next_char; # reconsume  
               !!!back-next-input-character (@next_char);  
               $self->{state} = DATA_STATE;  
   
               !!!emit ({type => CHARACTER_TOKEN, data => '</',  
                         line => $l, column => $c,  
                        });  
     
               redo A;  
             }  
           }  
           push @next_char, $self->{next_char};  
         
           unless ($self->{next_char} == 0x0009 or # HT  
                   $self->{next_char} == 0x000A or # LF  
                   $self->{next_char} == 0x000B or # VT  
                   $self->{next_char} == 0x000C or # FF  
                   $self->{next_char} == 0x0020 or # SP  
                   $self->{next_char} == 0x003E or # >  
                   $self->{next_char} == 0x002F or # /  
                   $self->{next_char} == -1) {  
             !!!cp (26);  
             $self->{next_char} = shift @next_char; # reconsume  
             !!!back-next-input-character (@next_char);  
             $self->{state} = DATA_STATE;  
             !!!emit ({type => CHARACTER_TOKEN, data => '</',  
                       line => $l, column => $c,  
                      });  
             redo A;  
           } else {  
             !!!cp (27);  
             $self->{next_char} = shift @next_char;  
             !!!back-next-input-character (@next_char);  
             # and consume...  
           }  
1136          } else {          } else {
1137            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1138              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1139            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1140            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1141              ## Reconsume.
1142            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1143                      line => $l, column => $c,                      line => $l, column => $c,
1144                     });                     });
1145            redo A;            redo A;
1146          }          }
1147        }        }
1148          
1149        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1150            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1151          !!!cp (29);          !!!cp (29);
# Line 1198  sub _get_next_token ($) { Line 1192  sub _get_next_token ($) {
1192                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1193                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1194                                   };                                   };
1195          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1196          redo A;          ## Although the "anything else" case of the spec not explicitly
1197            ## states that the next input character is to be reconsumed,
1198            ## it will be included to the |data| of the comment token
1199            ## generated from the bogus end tag, as defined in the
1200            ## "bogus comment state" entry.
1201            redo A;
1202          }
1203        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1204          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1205          if (length $ch) {
1206            my $CH = $ch;
1207            $ch =~ tr/a-z/A-Z/;
1208            my $nch = chr $self->{next_char};
1209            if ($nch eq $ch or $nch eq $CH) {
1210              !!!cp (24);
1211              ## Stay in the state.
1212              $self->{state_keyword} .= $nch;
1213              !!!next-input-character;
1214              redo A;
1215            } else {
1216              !!!cp (25);
1217              $self->{state} = DATA_STATE;
1218              ## Reconsume.
1219              !!!emit ({type => CHARACTER_TOKEN,
1220                        data => '</' . $self->{state_keyword},
1221                        line => $self->{line_prev},
1222                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1223                       });
1224              redo A;
1225            }
1226          } else { # after "<{tag-name}"
1227            unless ({
1228                     0x0009 => 1, # HT
1229                     0x000A => 1, # LF
1230                     0x000B => 1, # VT
1231                     0x000C => 1, # FF
1232                     0x0020 => 1, # SP
1233                     0x003E => 1, # >
1234                     0x002F => 1, # /
1235                     -1 => 1, # EOF
1236                    }->{$self->{next_char}}) {
1237              !!!cp (26);
1238              ## Reconsume.
1239              $self->{state} = DATA_STATE;
1240              !!!emit ({type => CHARACTER_TOKEN,
1241                        data => '</' . $self->{state_keyword},
1242                        line => $self->{line_prev},
1243                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1244                       });
1245              redo A;
1246            } else {
1247              !!!cp (27);
1248              $self->{current_token}
1249                  = {type => END_TAG_TOKEN,
1250                     tag_name => $self->{last_emitted_start_tag_name},
1251                     line => $self->{line_prev},
1252                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1253              $self->{state} = TAG_NAME_STATE;
1254              ## Reconsume.
1255              redo A;
1256            }
1257        }        }
1258      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1259        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1540  sub _get_next_token ($) { Line 1594  sub _get_next_token ($) {
1594    
1595          redo A;          redo A;
1596        } else {        } else {
1597          !!!cp (82);          if ($self->{next_char} == 0x0022 or # "
1598                $self->{next_char} == 0x0027) { # '
1599              !!!cp (78);
1600              !!!parse-error (type => 'bad attribute name');
1601            } else {
1602              !!!cp (82);
1603            }
1604          $self->{current_attribute}          $self->{current_attribute}
1605              = {name => chr ($self->{next_char}),              = {name => chr ($self->{next_char}),
1606                 value => '',                 value => '',
# Line 1575  sub _get_next_token ($) { Line 1635  sub _get_next_token ($) {
1635          !!!next-input-character;          !!!next-input-character;
1636          redo A;          redo A;
1637        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
1638            !!!parse-error (type => 'empty unquoted attribute value');
1639          if ($self->{current_token}->{type} == START_TAG_TOKEN) {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1640            !!!cp (87);            !!!cp (87);
1641            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 1965  sub _get_next_token ($) { Line 2026  sub _get_next_token ($) {
2026        die "$0: _get_next_token: unexpected case [BC]";        die "$0: _get_next_token: unexpected case [BC]";
2027      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2028        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
   
       my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1);  
   
       my @next_char;  
       push @next_char, $self->{next_char};  
2029                
2030        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2031            !!!cp (133);
2032            $self->{state} = MD_HYPHEN_STATE;
2033          !!!next-input-character;          !!!next-input-character;
2034          push @next_char, $self->{next_char};          redo A;
         if ($self->{next_char} == 0x002D) { # -  
           !!!cp (127);  
           $self->{current_token} = {type => COMMENT_TOKEN, data => '',  
                                     line => $l, column => $c,  
                                    };  
           $self->{state} = COMMENT_START_STATE;  
           !!!next-input-character;  
           redo A;  
         } else {  
           !!!cp (128);  
         }  
2035        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2036                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2037            ## ASCII case-insensitive.
2038            !!!cp (130);
2039            $self->{state} = MD_DOCTYPE_STATE;
2040            $self->{state_keyword} = chr $self->{next_char};
2041          !!!next-input-character;          !!!next-input-character;
2042          push @next_char, $self->{next_char};          redo A;
         if ($self->{next_char} == 0x004F or # O  
             $self->{next_char} == 0x006F) { # o  
           !!!next-input-character;  
           push @next_char, $self->{next_char};  
           if ($self->{next_char} == 0x0043 or # C  
               $self->{next_char} == 0x0063) { # c  
             !!!next-input-character;  
             push @next_char, $self->{next_char};  
             if ($self->{next_char} == 0x0054 or # T  
                 $self->{next_char} == 0x0074) { # t  
               !!!next-input-character;  
               push @next_char, $self->{next_char};  
               if ($self->{next_char} == 0x0059 or # Y  
                   $self->{next_char} == 0x0079) { # y  
                 !!!next-input-character;  
                 push @next_char, $self->{next_char};  
                 if ($self->{next_char} == 0x0050 or # P  
                     $self->{next_char} == 0x0070) { # p  
                   !!!next-input-character;  
                   push @next_char, $self->{next_char};  
                   if ($self->{next_char} == 0x0045 or # E  
                       $self->{next_char} == 0x0065) { # e  
                     !!!cp (129);  
                     ## TODO: What a stupid code this is!  
                     $self->{state} = DOCTYPE_STATE;  
                     $self->{current_token} = {type => DOCTYPE_TOKEN,  
                                               quirks => 1,  
                                               line => $l, column => $c,  
                                              };  
                     !!!next-input-character;  
                     redo A;  
                   } else {  
                     !!!cp (130);  
                   }  
                 } else {  
                   !!!cp (131);  
                 }  
               } else {  
                 !!!cp (132);  
               }  
             } else {  
               !!!cp (133);  
             }  
           } else {  
             !!!cp (134);  
           }  
         } else {  
           !!!cp (135);  
         }  
2043        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2044                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2045                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2046            !!!cp (135.4);                
2047            $self->{state} = MD_CDATA_STATE;
2048            $self->{state_keyword} = '[';
2049          !!!next-input-character;          !!!next-input-character;
2050          push @next_char, $self->{next_char};          redo A;
         if ($self->{next_char} == 0x0043) { # C  
           !!!next-input-character;  
           push @next_char, $self->{next_char};  
           if ($self->{next_char} == 0x0044) { # D  
             !!!next-input-character;  
             push @next_char, $self->{next_char};  
             if ($self->{next_char} == 0x0041) { # A  
               !!!next-input-character;  
               push @next_char, $self->{next_char};  
               if ($self->{next_char} == 0x0054) { # T  
                 !!!next-input-character;  
                 push @next_char, $self->{next_char};  
                 if ($self->{next_char} == 0x0041) { # A  
                   !!!next-input-character;  
                   push @next_char, $self->{next_char};  
                   if ($self->{next_char} == 0x005B) { # [  
                     !!!cp (135.1);  
                     $self->{state} = CDATA_BLOCK_STATE;  
                     !!!next-input-character;  
                     redo A;  
                   } else {  
                     !!!cp (135.2);  
                   }  
                 } else {  
                   !!!cp (135.3);  
                 }  
               } else {  
                 !!!cp (135.4);                  
               }  
             } else {  
               !!!cp (135.5);  
             }  
           } else {  
             !!!cp (135.6);  
           }  
         } else {  
           !!!cp (135.7);  
         }  
2051        } else {        } else {
2052          !!!cp (136);          !!!cp (136);
2053        }        }
2054    
2055        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2056        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2057        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2058          ## Reconsume.
2059        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2060        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2061                                  line => $l, column => $c,                                  line => $self->{line_prev},
2062                                    column => $self->{column_prev} - 1,
2063                                 };                                 };
2064        redo A;        redo A;
2065              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2066        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2067        ## ISSUE: spec is somewhat unclear on "is the first character that will be in the comment"; what is "that will be in the comment" is what the algorithm defines, isn't it?          !!!cp (127);
2068            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2069                                      line => $self->{line_prev},
2070                                      column => $self->{column_prev} - 2,
2071                                     };
2072            $self->{state} = COMMENT_START_STATE;
2073            !!!next-input-character;
2074            redo A;
2075          } else {
2076            !!!cp (128);
2077            !!!parse-error (type => 'bogus comment',
2078                            line => $self->{line_prev},
2079                            column => $self->{column_prev} - 2);
2080            $self->{state} = BOGUS_COMMENT_STATE;
2081            ## Reconsume.
2082            $self->{current_token} = {type => COMMENT_TOKEN,
2083                                      data => '-',
2084                                      line => $self->{line_prev},
2085                                      column => $self->{column_prev} - 2,
2086                                     };
2087            redo A;
2088          }
2089        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2090          ## ASCII case-insensitive.
2091          if ($self->{next_char} == [
2092                undef,
2093                0x004F, # O
2094                0x0043, # C
2095                0x0054, # T
2096                0x0059, # Y
2097                0x0050, # P
2098              ]->[length $self->{state_keyword}] or
2099              $self->{next_char} == [
2100                undef,
2101                0x006F, # o
2102                0x0063, # c
2103                0x0074, # t
2104                0x0079, # y
2105                0x0070, # p
2106              ]->[length $self->{state_keyword}]) {
2107            !!!cp (131);
2108            ## Stay in the state.
2109            $self->{state_keyword} .= chr $self->{next_char};
2110            !!!next-input-character;
2111            redo A;
2112          } elsif ((length $self->{state_keyword}) == 6 and
2113                   ($self->{next_char} == 0x0045 or # E
2114                    $self->{next_char} == 0x0065)) { # e
2115            !!!cp (129);
2116            $self->{state} = DOCTYPE_STATE;
2117            $self->{current_token} = {type => DOCTYPE_TOKEN,
2118                                      quirks => 1,
2119                                      line => $self->{line_prev},
2120                                      column => $self->{column_prev} - 7,
2121                                     };
2122            !!!next-input-character;
2123            redo A;
2124          } else {
2125            !!!cp (132);        
2126            !!!parse-error (type => 'bogus comment',
2127                            line => $self->{line_prev},
2128                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2129            $self->{state} = BOGUS_COMMENT_STATE;
2130            ## Reconsume.
2131            $self->{current_token} = {type => COMMENT_TOKEN,
2132                                      data => $self->{state_keyword},
2133                                      line => $self->{line_prev},
2134                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2135                                     };
2136            redo A;
2137          }
2138        } elsif ($self->{state} == MD_CDATA_STATE) {
2139          if ($self->{next_char} == {
2140                '[' => 0x0043, # C
2141                '[C' => 0x0044, # D
2142                '[CD' => 0x0041, # A
2143                '[CDA' => 0x0054, # T
2144                '[CDAT' => 0x0041, # A
2145              }->{$self->{state_keyword}}) {
2146            !!!cp (135.1);
2147            ## Stay in the state.
2148            $self->{state_keyword} .= chr $self->{next_char};
2149            !!!next-input-character;
2150            redo A;
2151          } elsif ($self->{state_keyword} eq '[CDATA' and
2152                   $self->{next_char} == 0x005B) { # [
2153            !!!cp (135.2);
2154            $self->{state} = CDATA_BLOCK_STATE;
2155            !!!next-input-character;
2156            redo A;
2157          } else {
2158            !!!cp (135.3);
2159            !!!parse-error (type => 'bogus comment',
2160                            line => $self->{line_prev},
2161                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2162            $self->{state} = BOGUS_COMMENT_STATE;
2163            ## Reconsume.
2164            $self->{current_token} = {type => COMMENT_TOKEN,
2165                                      data => $self->{state_keyword},
2166                                      line => $self->{line_prev},
2167                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2168                                     };
2169            redo A;
2170          }
2171      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2172        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2173          !!!cp (137);          !!!cp (137);
# Line 3147  sub _tree_construction_initial ($) { Line 3219  sub _tree_construction_initial ($) {
3219        ## language.        ## language.
3220        my $doctype_name = $token->{name};        my $doctype_name = $token->{name};
3221        $doctype_name = '' unless defined $doctype_name;        $doctype_name = '' unless defined $doctype_name;
3222        $doctype_name =~ tr/a-z/A-Z/;        $doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive
3223        if (not defined $token->{name} or # <!DOCTYPE>        if (not defined $token->{name} or # <!DOCTYPE>
           defined $token->{public_identifier} or  
3224            defined $token->{system_identifier}) {            defined $token->{system_identifier}) {
3225          !!!cp ('t1');          !!!cp ('t1');
3226          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3227        } elsif ($doctype_name ne 'HTML') {        } elsif ($doctype_name ne 'HTML') {
3228          !!!cp ('t2');          !!!cp ('t2');
         ## ISSUE: ASCII case-insensitive? (in fact it does not matter)  
3229          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3230          } elsif (defined $token->{public_identifier}) {
3231            if ($token->{public_identifier} eq 'XSLT-compat') {
3232              !!!cp ('t1.2');
3233              !!!parse-error (type => 'XSLT-compat', token => $token,
3234                              level => $self->{level}->{should});
3235            } else {
3236              !!!parse-error (type => 'not HTML5', token => $token);
3237            }
3238        } else {        } else {
3239          !!!cp ('t3');          !!!cp ('t3');
3240            #
3241        }        }
3242                
3243        my $doctype = $self->{document}->create_document_type_definition        my $doctype = $self->{document}->create_document_type_definition
# Line 6294  sub _tree_construction_main ($) { Line 6373  sub _tree_construction_main ($) {
6373            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6374              !!!cp ('t312');              !!!cp ('t312');
6375              !!!parse-error (type => 'after frameset:#text', token => $token);              !!!parse-error (type => 'after frameset:#text', token => $token);
6376            } else { # "after html frameset"            } else { # "after after frameset"
6377              !!!cp ('t313');              !!!cp ('t313');
6378              !!!parse-error (type => 'after html:#text', token => $token);              !!!parse-error (type => 'after html:#text', token => $token);
   
             $self->{insertion_mode} = AFTER_FRAMESET_IM;  
             ## Reprocess in the "after frameset" insertion mode.  
             !!!parse-error (type => 'after frameset:#text', token => $token);  
6379            }            }
6380                        
6381            ## Ignore the token.            ## Ignore the token.
# Line 6316  sub _tree_construction_main ($) { Line 6391  sub _tree_construction_main ($) {
6391                    
6392          die qq[$0: Character "$token->{data}"];          die qq[$0: Character "$token->{data}"];
6393        } elsif ($token->{type} == START_TAG_TOKEN) {        } elsif ($token->{type} == START_TAG_TOKEN) {
         if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {  
           !!!cp ('t316');  
           !!!parse-error (type => 'after html',  
                           text => $token->{tag_name}, token => $token);  
   
           $self->{insertion_mode} = AFTER_FRAMESET_IM;  
           ## Process in the "after frameset" insertion mode.  
         } else {  
           !!!cp ('t317');  
         }  
   
6394          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6395              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6396            !!!cp ('t318');            !!!cp ('t318');
# Line 6347  sub _tree_construction_main ($) { Line 6411  sub _tree_construction_main ($) {
6411            ## NOTE: As if in head.            ## NOTE: As if in head.
6412            $parse_rcdata->(CDATA_CONTENT_MODEL);            $parse_rcdata->(CDATA_CONTENT_MODEL);
6413            next B;            next B;
6414    
6415              ## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>|
6416              ## has no parse error.
6417          } else {          } else {
6418            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6419              !!!cp ('t321');              !!!cp ('t321');
6420              !!!parse-error (type => 'in frameset',              !!!parse-error (type => 'in frameset',
6421                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6422            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6423              !!!cp ('t322');              !!!cp ('t322');
6424              !!!parse-error (type => 'after frameset',              !!!parse-error (type => 'after frameset',
6425                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6426              } else { # "after after frameset"
6427                !!!cp ('t322.2');
6428                !!!parse-error (type => 'after after frameset',
6429                                text => $token->{tag_name}, token => $token);
6430            }            }
6431            ## Ignore the token            ## Ignore the token
6432            !!!nack ('t322.1');            !!!nack ('t322.1');
# Line 6363  sub _tree_construction_main ($) { Line 6434  sub _tree_construction_main ($) {
6434            next B;            next B;
6435          }          }
6436        } elsif ($token->{type} == END_TAG_TOKEN) {        } elsif ($token->{type} == END_TAG_TOKEN) {
         if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {  
           !!!cp ('t323');  
           !!!parse-error (type => 'after html:/',  
                           text => $token->{tag_name}, token => $token);  
   
           $self->{insertion_mode} = AFTER_FRAMESET_IM;  
           ## Process in the "after frameset" insertion mode.  
         } else {  
           !!!cp ('t324');  
         }  
   
6437          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6438              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6439            if ($self->{open_elements}->[-1]->[1] & HTML_EL and            if ($self->{open_elements}->[-1]->[1] & HTML_EL and
# Line 6408  sub _tree_construction_main ($) { Line 6468  sub _tree_construction_main ($) {
6468              !!!cp ('t330');              !!!cp ('t330');
6469              !!!parse-error (type => 'in frameset:/',              !!!parse-error (type => 'in frameset:/',
6470                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6471            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6472              !!!cp ('t331');              !!!cp ('t330.1');
6473              !!!parse-error (type => 'after frameset:/',              !!!parse-error (type => 'after frameset:/',
6474                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6475              } else { # "after after html"
6476                !!!cp ('t331');
6477                !!!parse-error (type => 'after after frameset:/',
6478                                text => $token->{tag_name}, token => $token);
6479            }            }
6480            ## Ignore the token            ## Ignore the token
6481            !!!next-token;            !!!next-token;
# Line 7134  sub _tree_construction_main ($) { Line 7198  sub _tree_construction_main ($) {
7198            !!!cp ('t413');            !!!cp ('t413');
7199            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7200                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7201              ## NOTE: Ignore the token.
7202          } else {          } else {
7203            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7204            while ({            while ({
# Line 7193  sub _tree_construction_main ($) { Line 7258  sub _tree_construction_main ($) {
7258            !!!cp ('t421');            !!!cp ('t421');
7259            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7260                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7261              ## NOTE: Ignore the token.
7262          } else {          } else {
7263            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7264            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7239  sub _tree_construction_main ($) { Line 7305  sub _tree_construction_main ($) {
7305            !!!cp ('t425.1');            !!!cp ('t425.1');
7306            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7307                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7308              ## NOTE: Ignore the token.
7309          } else {          } else {
7310            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7311            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7441  sub _tree_construction_main ($) { Line 7508  sub _tree_construction_main ($) {
7508    ## TODO: script stuffs    ## TODO: script stuffs
7509  } # _tree_construct_main  } # _tree_construct_main
7510    
7511  sub set_inner_html ($$$) {  sub set_inner_html ($$$;$) {
7512    my $class = shift;    my $class = shift;
7513    my $node = shift;    my $node = shift;
7514    my $s = \$_[0];    my $s = \$_[0];
7515    my $onerror = $_[1];    my $onerror = $_[1];
7516      my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7517    
7518    ## ISSUE: Should {confident} be true?    ## ISSUE: Should {confident} be true?
7519    
# Line 7464  sub set_inner_html ($$$) { Line 7532  sub set_inner_html ($$$) {
7532      }      }
7533    
7534      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7535      $class->parse_string ($$s => $node, $onerror);      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);
7536    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7537      ## TODO: If non-html element      ## TODO: If non-html element
7538    
7539      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
7540    
7541    ## TODO: Support for $get_wrapper
7542    
7543      ## Step 1 # MUST      ## Step 1 # MUST
7544      my $this_doc = $node->owner_document;      my $this_doc = $node->owner_document;
7545      my $doc = $this_doc->implementation->create_document;      my $doc = $this_doc->implementation->create_document;
Legend:
Removed from v.1.155  
changed lines
  Added in v.1.164
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24