/[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.161 by wakaba, Wed Sep 10 10:46:50 2008 UTC
# Line 372  sub parse_byte_stream ($$$$;$) { Line 372  sub parse_byte_stream ($$$$;$) {
372    my ($char_stream, $e_status);    my ($char_stream, $e_status);
373    
374    SNIFFING: {    SNIFFING: {
375        ## NOTE: By setting |allow_fallback| option true when the
376        ## |get_decode_handle| method is invoked, we ignore what the HTML5
377        ## spec requires, i.e. unsupported encoding should be ignored.
378          ## TODO: We should not do this unless the parser is invoked
379          ## in the conformance checking mode, in which this behavior
380          ## would be useful.
381    
382      ## Step 1      ## Step 1
383      if (defined $charset_name) {      if (defined $charset_name) {
384        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
385              ## TODO: Is this ok?  Transfer protocol's parameter should be
386              ## interpreted in its semantics?
387    
388        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
389        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
# Line 399  sub parse_byte_stream ($$$$;$) { Line 407  sub parse_byte_stream ($$$$;$) {
407    
408      ## Step 3      ## Step 3
409      if ($byte_buffer =~ /^\xFE\xFF/) {      if ($byte_buffer =~ /^\xFE\xFF/) {
410        $charset = Message::Charset::Info->get_by_iana_name ('utf-16be');        $charset = Message::Charset::Info->get_by_html_name ('utf-16be');
411        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
412            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
413             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
414        $self->{confident} = 1;        $self->{confident} = 1;
415        last SNIFFING;        last SNIFFING;
416      } elsif ($byte_buffer =~ /^\xFF\xFE/) {      } elsif ($byte_buffer =~ /^\xFF\xFE/) {
417        $charset = Message::Charset::Info->get_by_iana_name ('utf-16le');        $charset = Message::Charset::Info->get_by_html_name ('utf-16le');
418        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
419            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
420             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
421        $self->{confident} = 1;        $self->{confident} = 1;
422        last SNIFFING;        last SNIFFING;
423      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {
424        $charset = Message::Charset::Info->get_by_iana_name ('utf-8');        $charset = Message::Charset::Info->get_by_html_name ('utf-8');
425        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
426            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
427             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
# Line 432  sub parse_byte_stream ($$$$;$) { Line 440  sub parse_byte_stream ($$$$;$) {
440      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string
441          ($byte_buffer);          ($byte_buffer);
442      if (defined $charset_name) {      if (defined $charset_name) {
443        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
444    
445        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
446        require Whatpm::Charset::DecodeHandle;        require Whatpm::Charset::DecodeHandle;
# Line 455  sub parse_byte_stream ($$$$;$) { Line 463  sub parse_byte_stream ($$$$;$) {
463    
464      ## Step 7: default      ## Step 7: default
465      ## TODO: Make this configurable.      ## TODO: Make this configurable.
466      $charset = Message::Charset::Info->get_by_iana_name ('windows-1252');      $charset = Message::Charset::Info->get_by_html_name ('windows-1252');
467          ## NOTE: We choose |windows-1252| here, since |utf-8| should be          ## NOTE: We choose |windows-1252| here, since |utf-8| should be
468          ## detectable in the step 6.          ## detectable in the step 6.
469      require Whatpm::Charset::DecodeHandle;      require Whatpm::Charset::DecodeHandle;
# Line 475  sub parse_byte_stream ($$$$;$) { Line 483  sub parse_byte_stream ($$$$;$) {
483      $self->{confident} = 0;      $self->{confident} = 0;
484    } # SNIFFING    } # SNIFFING
485    
   $self->{input_encoding} = $charset->get_iana_name;  
486    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
487        $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
488      !!!parse-error (type => 'chardecode:fallback',      !!!parse-error (type => 'chardecode:fallback',
489                      text => $self->{input_encoding},                      #text => $self->{input_encoding},
490                      level => $self->{level}->{uncertain},                      level => $self->{level}->{uncertain},
491                      line => 1, column => 1,                      line => 1, column => 1,
492                      layer => 'encode');                      layer => 'encode');
493    } elsif (not ($e_status &    } elsif (not ($e_status &
494                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
495        $self->{input_encoding} = $charset->get_iana_name;
496      !!!parse-error (type => 'chardecode:no error',      !!!parse-error (type => 'chardecode:no error',
497                      text => $self->{input_encoding},                      text => $self->{input_encoding},
498                      level => $self->{level}->{uncertain},                      level => $self->{level}->{uncertain},
499                      line => 1, column => 1,                      line => 1, column => 1,
500                      layer => 'encode');                      layer => 'encode');
501      } else {
502        $self->{input_encoding} = $charset->get_iana_name;
503    }    }
504    
505    $self->{change_encoding} = sub {    $self->{change_encoding} = sub {
# Line 496  sub parse_byte_stream ($$$$;$) { Line 507  sub parse_byte_stream ($$$$;$) {
507      $charset_name = shift;      $charset_name = shift;
508      my $token = shift;      my $token = shift;
509    
510      $charset = Message::Charset::Info->get_by_iana_name ($charset_name);      $charset = Message::Charset::Info->get_by_html_name ($charset_name);
511      ($char_stream, $e_status) = $charset->get_decode_handle      ($char_stream, $e_status) = $charset->get_decode_handle
512          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,
513           byte_buffer => \ $buffer->{buffer});           byte_buffer => \ $buffer->{buffer});
# Line 507  sub parse_byte_stream ($$$$;$) { Line 518  sub parse_byte_stream ($$$$;$) {
518        ## Step 1            ## Step 1    
519        if ($charset->{category} &        if ($charset->{category} &
520            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {
521          $charset = Message::Charset::Info->get_by_iana_name ('utf-8');          $charset = Message::Charset::Info->get_by_html_name ('utf-8');
522          ($char_stream, $e_status) = $charset->get_decode_handle          ($char_stream, $e_status) = $charset->get_decode_handle
523              ($byte_stream,              ($byte_stream,
524               byte_buffer => \ $buffer->{buffer});               byte_buffer => \ $buffer->{buffer});
# Line 560  sub parse_byte_stream ($$$$;$) { Line 571  sub parse_byte_stream ($$$$;$) {
571    } catch Whatpm::HTML::RestartParser with {    } catch Whatpm::HTML::RestartParser with {
572      ## NOTE: Invoked after {change_encoding}.      ## NOTE: Invoked after {change_encoding}.
573    
     $self->{input_encoding} = $charset->get_iana_name;  
574      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
575          $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
576        !!!parse-error (type => 'chardecode:fallback',        !!!parse-error (type => 'chardecode:fallback',
                       text => $self->{input_encoding},  
577                        level => $self->{level}->{uncertain},                        level => $self->{level}->{uncertain},
578                          #text => $self->{input_encoding},
579                        line => 1, column => 1,                        line => 1, column => 1,
580                        layer => 'encode');                        layer => 'encode');
581      } elsif (not ($e_status &      } elsif (not ($e_status &
582                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
583          $self->{input_encoding} = $charset->get_iana_name;
584        !!!parse-error (type => 'chardecode:no error',        !!!parse-error (type => 'chardecode:no error',
585                        text => $self->{input_encoding},                        text => $self->{input_encoding},
586                        level => $self->{level}->{uncertain},                        level => $self->{level}->{uncertain},
587                        line => 1, column => 1,                        line => 1, column => 1,
588                        layer => 'encode');                        layer => 'encode');
589        } else {
590          $self->{input_encoding} = $charset->get_iana_name;
591      }      }
592      $self->{confident} = 1;      $self->{confident} = 1;
593      $char_stream->onerror ($char_onerror);      $char_stream->onerror ($char_onerror);
# Line 708  sub new ($) { Line 722  sub new ($) {
722    my $class = shift;    my $class = shift;
723    my $self = bless {    my $self = bless {
724      level => {must => 'm',      level => {must => 'm',
725                  should => 's',
726                warn => 'w',                warn => 'w',
727                info => 'i',                info => 'i',
728                uncertain => 'u'},                uncertain => 'u'},
# Line 1540  sub _get_next_token ($) { Line 1555  sub _get_next_token ($) {
1555    
1556          redo A;          redo A;
1557        } else {        } else {
1558          !!!cp (82);          if ($self->{next_char} == 0x0022 or # "
1559                $self->{next_char} == 0x0027) { # '
1560              !!!cp (78);
1561              !!!parse-error (type => 'bad attribute name');
1562            } else {
1563              !!!cp (82);
1564            }
1565          $self->{current_attribute}          $self->{current_attribute}
1566              = {name => chr ($self->{next_char}),              = {name => chr ($self->{next_char}),
1567                 value => '',                 value => '',
# Line 1575  sub _get_next_token ($) { Line 1596  sub _get_next_token ($) {
1596          !!!next-input-character;          !!!next-input-character;
1597          redo A;          redo A;
1598        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
1599            !!!parse-error (type => 'empty unquoted attribute value');
1600          if ($self->{current_token}->{type} == START_TAG_TOKEN) {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1601            !!!cp (87);            !!!cp (87);
1602            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 3147  sub _tree_construction_initial ($) { Line 3169  sub _tree_construction_initial ($) {
3169        ## language.        ## language.
3170        my $doctype_name = $token->{name};        my $doctype_name = $token->{name};
3171        $doctype_name = '' unless defined $doctype_name;        $doctype_name = '' unless defined $doctype_name;
3172        $doctype_name =~ tr/a-z/A-Z/;        $doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive
3173        if (not defined $token->{name} or # <!DOCTYPE>        if (not defined $token->{name} or # <!DOCTYPE>
           defined $token->{public_identifier} or  
3174            defined $token->{system_identifier}) {            defined $token->{system_identifier}) {
3175          !!!cp ('t1');          !!!cp ('t1');
3176          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3177        } elsif ($doctype_name ne 'HTML') {        } elsif ($doctype_name ne 'HTML') {
3178          !!!cp ('t2');          !!!cp ('t2');
         ## ISSUE: ASCII case-insensitive? (in fact it does not matter)  
3179          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3180          } elsif (defined $token->{public_identifier}) {
3181            if ($token->{public_identifier} eq 'XSLT-compat') {
3182              !!!cp ('t1.2');
3183              !!!parse-error (type => 'XSLT-compat', token => $token,
3184                              level => $self->{level}->{should});
3185            } else {
3186              !!!parse-error (type => 'not HTML5', token => $token);
3187            }
3188        } else {        } else {
3189          !!!cp ('t3');          !!!cp ('t3');
3190            #
3191        }        }
3192                
3193        my $doctype = $self->{document}->create_document_type_definition        my $doctype = $self->{document}->create_document_type_definition
# Line 6294  sub _tree_construction_main ($) { Line 6323  sub _tree_construction_main ($) {
6323            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6324              !!!cp ('t312');              !!!cp ('t312');
6325              !!!parse-error (type => 'after frameset:#text', token => $token);              !!!parse-error (type => 'after frameset:#text', token => $token);
6326            } else { # "after html frameset"            } else { # "after after frameset"
6327              !!!cp ('t313');              !!!cp ('t313');
6328              !!!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);  
6329            }            }
6330                        
6331            ## Ignore the token.            ## Ignore the token.
# Line 6316  sub _tree_construction_main ($) { Line 6341  sub _tree_construction_main ($) {
6341                    
6342          die qq[$0: Character "$token->{data}"];          die qq[$0: Character "$token->{data}"];
6343        } 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');  
         }  
   
6344          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6345              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6346            !!!cp ('t318');            !!!cp ('t318');
# Line 6347  sub _tree_construction_main ($) { Line 6361  sub _tree_construction_main ($) {
6361            ## NOTE: As if in head.            ## NOTE: As if in head.
6362            $parse_rcdata->(CDATA_CONTENT_MODEL);            $parse_rcdata->(CDATA_CONTENT_MODEL);
6363            next B;            next B;
6364    
6365              ## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>|
6366              ## has no parse error.
6367          } else {          } else {
6368            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6369              !!!cp ('t321');              !!!cp ('t321');
6370              !!!parse-error (type => 'in frameset',              !!!parse-error (type => 'in frameset',
6371                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6372            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6373              !!!cp ('t322');              !!!cp ('t322');
6374              !!!parse-error (type => 'after frameset',              !!!parse-error (type => 'after frameset',
6375                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6376              } else { # "after after frameset"
6377                !!!cp ('t322.2');
6378                !!!parse-error (type => 'after after frameset',
6379                                text => $token->{tag_name}, token => $token);
6380            }            }
6381            ## Ignore the token            ## Ignore the token
6382            !!!nack ('t322.1');            !!!nack ('t322.1');
# Line 6363  sub _tree_construction_main ($) { Line 6384  sub _tree_construction_main ($) {
6384            next B;            next B;
6385          }          }
6386        } 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');  
         }  
   
6387          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6388              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6389            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 6418  sub _tree_construction_main ($) {
6418              !!!cp ('t330');              !!!cp ('t330');
6419              !!!parse-error (type => 'in frameset:/',              !!!parse-error (type => 'in frameset:/',
6420                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6421            } else {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6422              !!!cp ('t331');              !!!cp ('t330.1');
6423              !!!parse-error (type => 'after frameset:/',              !!!parse-error (type => 'after frameset:/',
6424                              text => $token->{tag_name}, token => $token);                              text => $token->{tag_name}, token => $token);
6425              } else { # "after after html"
6426                !!!cp ('t331');
6427                !!!parse-error (type => 'after after frameset:/',
6428                                text => $token->{tag_name}, token => $token);
6429            }            }
6430            ## Ignore the token            ## Ignore the token
6431            !!!next-token;            !!!next-token;
# Line 7134  sub _tree_construction_main ($) { Line 7148  sub _tree_construction_main ($) {
7148            !!!cp ('t413');            !!!cp ('t413');
7149            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7150                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7151              ## NOTE: Ignore the token.
7152          } else {          } else {
7153            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7154            while ({            while ({
# Line 7193  sub _tree_construction_main ($) { Line 7208  sub _tree_construction_main ($) {
7208            !!!cp ('t421');            !!!cp ('t421');
7209            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7210                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7211              ## NOTE: Ignore the token.
7212          } else {          } else {
7213            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7214            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 7255  sub _tree_construction_main ($) {
7255            !!!cp ('t425.1');            !!!cp ('t425.1');
7256            !!!parse-error (type => 'unmatched end tag',            !!!parse-error (type => 'unmatched end tag',
7257                            text => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7258              ## NOTE: Ignore the token.
7259          } else {          } else {
7260            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7261            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
Legend:
Removed from v.1.155  
changed lines
  Added in v.1.161
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24