/[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.135 by wakaba, Sat May 17 07:31:49 2008 UTC revision 1.141 by wakaba, Sat May 24 10:18:26 2008 UTC
# Line 11  use Error qw(:try); Line 11  use Error qw(:try);
11  ## TODO: 1252 parse error (revision 1264)  ## TODO: 1252 parse error (revision 1264)
12  ## TODO: 8859-11 = 874 (revision 1271)  ## TODO: 8859-11 = 874 (revision 1271)
13    
14    require IO::Handle;
15    
16  my $HTML_NS = q<http://www.w3.org/1999/xhtml>;  my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
17  my $MML_NS = q<http://www.w3.org/1998/Math/MathML>;  my $MML_NS = q<http://www.w3.org/1998/Math/MathML>;
18  my $SVG_NS = q<http://www.w3.org/2000/svg>;  my $SVG_NS = q<http://www.w3.org/2000/svg>;
# Line 332  my $c1_entity_char = { Line 334  my $c1_entity_char = {
334  }; # $c1_entity_char  }; # $c1_entity_char
335    
336  sub parse_byte_string ($$$$;$) {  sub parse_byte_string ($$$$;$) {
337      my $self = shift;
338      my $charset_name = shift;
339      open my $input, '<', ref $_[0] ? $_[0] : \($_[0]);
340      return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);
341    } # parse_byte_string
342    
343    sub parse_byte_stream ($$$$;$) {
344    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
345    my $charset_name = shift;    my $charset_name = shift;
346    my $bytes_s = ref $_[0] ? $_[0] : \($_[0]);    my $byte_stream = $_[0];
   my $s;  
347    
348    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
349      my (%opt) = @_;      my (%opt) = @_;
# Line 346  sub parse_byte_string ($$$$;$) { Line 354  sub parse_byte_string ($$$$;$) {
354    ## HTML5 encoding sniffing algorithm    ## HTML5 encoding sniffing algorithm
355    require Message::Charset::Info;    require Message::Charset::Info;
356    my $charset;    my $charset;
357    my ($e, $e_status);    my $buffer;
358      my ($char_stream, $e_status);
359    
360    SNIFFING: {    SNIFFING: {
361    
# Line 355  sub parse_byte_string ($$$$;$) { Line 364  sub parse_byte_string ($$$$;$) {
364        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);
365    
366        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
367        ($e, $e_status) = $charset->get_perl_encoding        ($char_stream, $e_status) = $charset->get_decode_handle
368            (allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
369             allow_fallback => 1);             allow_fallback => 1);
370        if ($e) {        if ($char_stream) {
371          $self->{confident} = 1;          $self->{confident} = 1;
372          last SNIFFING;          last SNIFFING;
373          } else {
374            ## TODO: unsupported error
375        }        }
376      }      }
377    
378      ## Step 2      ## Step 2
379      # wait      my $byte_buffer = '';
380        for (1..1024) {
381          my $char = $byte_stream->getc;
382          last unless defined $char;
383          $byte_buffer .= $char;
384        } ## TODO: timeout
385    
386      ## Step 3      ## Step 3
387      my $head = substr ($$bytes_s, 0, 3);      if ($byte_buffer =~ /^\xFE\xFF/) {
     if ($head =~ /^\xFE\xFF/) {  
388        $charset = Message::Charset::Info->get_by_iana_name ('utf-16be');        $charset = Message::Charset::Info->get_by_iana_name ('utf-16be');
389        ($e, $e_status) = $charset->get_perl_encoding        ($char_stream, $e_status) = $charset->get_decode_handle
390            (allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
391             allow_fallback => 1);             allow_fallback => 1, byte_buffer => \$byte_buffer);
392        $self->{confident} = 1;        $self->{confident} = 1;
393        last SNIFFING;        last SNIFFING;
394      } elsif ($head =~ /^\xFF\xFE/) {      } elsif ($byte_buffer =~ /^\xFF\xFE/) {
395        $charset = Message::Charset::Info->get_by_iana_name ('utf-16le');        $charset = Message::Charset::Info->get_by_iana_name ('utf-16le');
396        ($e, $e_status) = $charset->get_perl_encoding        ($char_stream, $e_status) = $charset->get_decode_handle
397            (allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
398             allow_fallback => 1);             allow_fallback => 1, byte_buffer => \$byte_buffer);
399        $self->{confident} = 1;        $self->{confident} = 1;
400        last SNIFFING;        last SNIFFING;
401      } elsif ($head eq "\xEF\xBB\xBF") {      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {
402        $charset = Message::Charset::Info->get_by_iana_name ('utf-8');        $charset = Message::Charset::Info->get_by_iana_name ('utf-8');
403        ($e, $e_status) = $charset->get_perl_encoding        ($char_stream, $e_status) = $charset->get_decode_handle
404            (allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
405             allow_fallback => 1);             allow_fallback => 1, byte_buffer => \$byte_buffer);
406        $self->{confident} = 1;        $self->{confident} = 1;
407        last SNIFFING;        last SNIFFING;
408      }      }
# Line 401  sub parse_byte_string ($$$$;$) { Line 416  sub parse_byte_string ($$$$;$) {
416      ## Step 6      ## Step 6
417      require Whatpm::Charset::UniversalCharDet;      require Whatpm::Charset::UniversalCharDet;
418      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string
419          (substr ($$bytes_s, 0, 1024));          ($byte_buffer);
420      if (defined $charset_name) {      if (defined $charset_name) {
421        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);
422    
423        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
424        ($e, $e_status) = $charset->get_perl_encoding        require Whatpm::Charset::DecodeHandle;
425            (allow_error_reporting => 1,        $buffer = Whatpm::Charset::DecodeHandle::ByteBuffer->new
426             allow_fallback => 1);            ($byte_stream);
427        if ($e) {        ($char_stream, $e_status) = $charset->get_decode_handle
428              ($buffer, allow_error_reporting => 1,
429               allow_fallback => 1, byte_buffer => \$byte_buffer);
430          if ($char_stream) {
431            $buffer->{buffer} = $byte_buffer;
432          !!!parse-error (type => 'sniffing:chardet', ## TODO: type name          !!!parse-error (type => 'sniffing:chardet', ## TODO: type name
433                          value => $charset_name,                          value => $charset_name,
434                          level => $self->{info_level},                          level => $self->{info_level},
# Line 424  sub parse_byte_string ($$$$;$) { Line 443  sub parse_byte_string ($$$$;$) {
443      $charset = Message::Charset::Info->get_by_iana_name ('windows-1252');      $charset = Message::Charset::Info->get_by_iana_name ('windows-1252');
444          ## NOTE: We choose |windows-1252| here, since |utf-8| should be          ## NOTE: We choose |windows-1252| here, since |utf-8| should be
445          ## detectable in the step 6.          ## detectable in the step 6.
446      ($e, $e_status) = $charset->get_perl_encoding (allow_error_reporting => 1,      require Whatpm::Charset::DecodeHandle;
447                                                     allow_fallback => 1);      $buffer = Whatpm::Charset::DecodeHandle::ByteBuffer->new
448            ($byte_stream);
449        ($char_stream, $e_status)
450            = $charset->get_decode_handle ($buffer,
451                                           allow_error_reporting => 1,
452                                           allow_fallback => 1,
453                                           byte_buffer => \$byte_buffer);
454        $buffer->{buffer} = $byte_buffer;
455      !!!parse-error (type => 'sniffing:default', ## TODO: type name      !!!parse-error (type => 'sniffing:default', ## TODO: type name
456                      value => 'windows-1252',                      value => 'windows-1252',
457                      level => $self->{info_level},                      level => $self->{info_level},
# Line 436  sub parse_byte_string ($$$$;$) { Line 462  sub parse_byte_string ($$$$;$) {
462    $self->{input_encoding} = $charset->get_iana_name;    $self->{input_encoding} = $charset->get_iana_name;
463    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
464      !!!parse-error (type => 'chardecode:fallback', ## TODO: type name      !!!parse-error (type => 'chardecode:fallback', ## TODO: type name
465                      value => $e->name,                      value => $self->{input_encoding},
466                      level => $self->{unsupported_level},                      level => $self->{unsupported_level},
467                      line => 1, column => 1);                      line => 1, column => 1);
468    } elsif (not ($e_status &    } elsif (not ($e_status &
# Line 446  sub parse_byte_string ($$$$;$) { Line 472  sub parse_byte_string ($$$$;$) {
472                      level => $self->{unsupported_level},                      level => $self->{unsupported_level},
473                      line => 1, column => 1);                      line => 1, column => 1);
474    }    }
   $s = \ $e->decode ($$bytes_s);  
475    
476    $self->{change_encoding} = sub {    $self->{change_encoding} = sub {
477      my $self = shift;      my $self = shift;
# Line 454  sub parse_byte_string ($$$$;$) { Line 479  sub parse_byte_string ($$$$;$) {
479      my $token = shift;      my $token = shift;
480    
481      $charset = Message::Charset::Info->get_by_iana_name ($charset_name);      $charset = Message::Charset::Info->get_by_iana_name ($charset_name);
482      ($e, $e_status) = $charset->get_perl_encoding      ($char_stream, $e_status) = $charset->get_decode_handle
483          (allow_error_reporting => 1, allow_fallback => 1);          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,
484             byte_buffer => \ $buffer->{buffer});
485            
486      if ($e) { # if supported      if ($char_stream) { # if supported
487        ## "Change the encoding" algorithm:        ## "Change the encoding" algorithm:
488    
489        ## Step 1            ## Step 1    
490        if ($charset->{iana_names}->{'utf-16'}) { ## ISSUE: UTF-16BE -> UTF-8? UTF-16LE -> UTF-8?        if ($charset->{iana_names}->{'utf-16'}) { ## ISSUE: UTF-16BE -> UTF-8? UTF-16LE -> UTF-8?
491          $charset = Message::Charset::Info->get_by_iana_name ('utf-8');          $charset = Message::Charset::Info->get_by_iana_name ('utf-8');
492          ($e, $e_status) = $charset->get_perl_encoding;          ($char_stream, $e_status) = $charset->get_decode_handle
493                ($byte_stream,
494                 byte_buffer => \ $buffer->{buffer});
495        }        }
496        $charset_name = $charset->get_iana_name;        $charset_name = $charset->get_iana_name;
497                
# Line 492  sub parse_byte_string ($$$$;$) { Line 520  sub parse_byte_string ($$$$;$) {
520      }      }
521    }; # $self->{change_encoding}    }; # $self->{change_encoding}
522    
523      my $char_onerror = sub {
524        my (undef, $type, %opt) = @_;
525        !!!parse-error (%opt, type => $type,
526                        line => $self->{line}, column => $self->{column} + 1);
527        if ($opt{octets}) {
528          ${$opt{octets}} = "\x{FFFD}"; # relacement character
529        }
530      };
531      $char_stream->onerror ($char_onerror);
532    
533    my @args = @_; shift @args; # $s    my @args = @_; shift @args; # $s
534    my $return;    my $return;
535    try {    try {
536      $return = $self->parse_char_string ($s, @args);        $return = $self->parse_char_stream ($char_stream, @args);  
537    } catch Whatpm::HTML::RestartParser with {    } catch Whatpm::HTML::RestartParser with {
538      ## NOTE: Invoked after {change_encoding}.      ## NOTE: Invoked after {change_encoding}.
539    
540      $self->{input_encoding} = $charset->get_iana_name;      $self->{input_encoding} = $charset->get_iana_name;
541      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
542        !!!parse-error (type => 'chardecode:fallback', ## TODO: type name        !!!parse-error (type => 'chardecode:fallback', ## TODO: type name
543                        value => $e->name,                        value => $self->{input_encoding},
544                        level => $self->{unsupported_level},                        level => $self->{unsupported_level},
545                        line => 1, column => 1);                        line => 1, column => 1);
546      } elsif (not ($e_status &      } elsif (not ($e_status &
# Line 512  sub parse_byte_string ($$$$;$) { Line 550  sub parse_byte_string ($$$$;$) {
550                        level => $self->{unsupported_level},                        level => $self->{unsupported_level},
551                        line => 1, column => 1);                        line => 1, column => 1);
552      }      }
     $s = \ $e->decode ($$bytes_s);  
553      $self->{confident} = 1;      $self->{confident} = 1;
554      $return = $self->parse_char_string ($s, @args);      $char_stream->onerror ($char_onerror);
555        $return = $self->parse_char_stream ($char_stream, @args);
556    };    };
557    return $return;    return $return;
558  } # parse_byte_string  } # parse_byte_stream
559    
560  ## NOTE: HTML5 spec says that the encoding layer MUST NOT strip BOM  ## NOTE: HTML5 spec says that the encoding layer MUST NOT strip BOM
561  ## and the HTML layer MUST ignore it.  However, we does strip BOM in  ## and the HTML layer MUST ignore it.  However, we does strip BOM in
# Line 530  sub parse_byte_string ($$$$;$) { Line 568  sub parse_byte_string ($$$$;$) {
568    
569  sub parse_char_string ($$$;$) {  sub parse_char_string ($$$;$) {
570    my $self = shift;    my $self = shift;
571    open my $input, '<:utf8', ref $_[0] ? $_[0] : \($_[0]);    require utf8;
572      my $s = ref $_[0] ? $_[0] : \($_[0]);
573      open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;
574    return $self->parse_char_stream ($input, @_[1..$#_]);    return $self->parse_char_stream ($input, @_[1..$#_]);
575  } # parse_char_string  } # parse_char_string
576  *parse_string = \&parse_char_string;  *parse_string = \&parse_char_string;
# Line 556  sub parse_char_stream ($$$;$) { Line 596  sub parse_char_stream ($$$;$) {
596      pop @{$self->{prev_char}};      pop @{$self->{prev_char}};
597      unshift @{$self->{prev_char}}, $self->{next_char};      unshift @{$self->{prev_char}}, $self->{next_char};
598    
599      my $char = $input->getc;      my $char;
600        if (defined $self->{next_next_char}) {
601          $char = $self->{next_next_char};
602          delete $self->{next_next_char};
603        } else {
604          $char = $input->getc;
605        }
606      $self->{next_char} = -1 and return unless defined $char;      $self->{next_char} = -1 and return unless defined $char;
607      $self->{next_char} = ord $char;      $self->{next_char} = ord $char;
608    
# Line 571  sub parse_char_stream ($$$;$) { Line 617  sub parse_char_stream ($$$;$) {
617      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
618        !!!cp ('j2');        !!!cp ('j2');
619        my $next = $input->getc;        my $next = $input->getc;
620        if ($next ne "\x0A") {        if (defined $next and $next ne "\x0A") {
621          $input->ungetc ($next);          $self->{next_next_char} = $next;
622        }        }
623        $self->{next_char} = 0x000A; # LF # MUST        $self->{next_char} = 0x000A; # LF # MUST
624        $self->{line}++;        $self->{line}++;
# Line 1002  sub _get_next_token ($) { Line 1048  sub _get_next_token ($) {
1048            redo A;            redo A;
1049          } else {          } else {
1050            !!!cp (23);            !!!cp (23);
1051            !!!parse-error (type => 'bare stago');            !!!parse-error (type => 'bare stago',
1052                              line => $self->{line_prev},
1053                              column => $self->{column_prev});
1054            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1055            ## reconsume            ## reconsume
1056    
# Line 1779  sub _get_next_token ($) { Line 1827  sub _get_next_token ($) {
1827          $self->{state} = SELF_CLOSING_START_TAG_STATE;          $self->{state} = SELF_CLOSING_START_TAG_STATE;
1828          !!!next-input-character;          !!!next-input-character;
1829          redo A;          redo A;
1830          } elsif ($self->{next_char} == -1) {
1831            !!!parse-error (type => 'unclosed tag');
1832            if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1833              !!!cp (122.3);
1834              $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1835            } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
1836              if ($self->{current_token}->{attributes}) {
1837                !!!cp (122.1);
1838                !!!parse-error (type => 'end tag attribute');
1839              } else {
1840                ## NOTE: This state should never be reached.
1841                !!!cp (122.2);
1842              }
1843            } else {
1844              die "$0: $self->{current_token}->{type}: Unknown token type";
1845            }
1846            $self->{state} = DATA_STATE;
1847            ## Reconsume.
1848            !!!emit ($self->{current_token}); # start tag or end tag
1849            redo A;
1850        } else {        } else {
1851          !!!cp ('124.1');          !!!cp ('124.1');
1852          !!!parse-error (type => 'no space between attributes');          !!!parse-error (type => 'no space between attributes');
# Line 1811  sub _get_next_token ($) { Line 1879  sub _get_next_token ($) {
1879          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
1880    
1881          redo A;          redo A;
1882          } elsif ($self->{next_char} == -1) {
1883            !!!parse-error (type => 'unclosed tag');
1884            if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1885              !!!cp (124.7);
1886              $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1887            } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
1888              if ($self->{current_token}->{attributes}) {
1889                !!!cp (124.5);
1890                !!!parse-error (type => 'end tag attribute');
1891              } else {
1892                ## NOTE: This state should never be reached.
1893                !!!cp (124.6);
1894              }
1895            } else {
1896              die "$0: $self->{current_token}->{type}: Unknown token type";
1897            }
1898            $self->{state} = DATA_STATE;
1899            ## Reconsume.
1900            !!!emit ($self->{current_token}); # start tag or end tag
1901            redo A;
1902        } else {        } else {
1903          !!!cp ('124.4');          !!!cp ('124.4');
1904          !!!parse-error (type => 'nestc');          !!!parse-error (type => 'nestc');
# Line 3326  sub _reset_insertion_mode ($) { Line 3414  sub _reset_insertion_mode ($) {
3414        if ($self->{open_elements}->[0]->[0] eq $node->[0]) {        if ($self->{open_elements}->[0]->[0] eq $node->[0]) {
3415          $last = 1;          $last = 1;
3416          if (defined $self->{inner_html_node}) {          if (defined $self->{inner_html_node}) {
3417            if ($self->{inner_html_node}->[1] & TABLE_CELL_EL) {            !!!cp ('t28');
3418              !!!cp ('t27');            $node = $self->{inner_html_node};
3419              #          } else {
3420            } else {            die "_reset_insertion_mode: t27";
             !!!cp ('t28');  
             $node = $self->{inner_html_node};  
           }  
3421          }          }
3422        }        }
3423              
3424      ## Step 4..14        ## Step 4..14
3425      my $new_mode;        my $new_mode;
3426      if ($node->[1] & FOREIGN_EL) {        if ($node->[1] & FOREIGN_EL) {
3427        ## NOTE: Strictly spaking, the line below only applies to MathML and          !!!cp ('t28.1');
3428        ## SVG elements.  Currently the HTML syntax supports only MathML and          ## NOTE: Strictly spaking, the line below only applies to MathML and
3429        ## SVG elements as foreigners.          ## SVG elements.  Currently the HTML syntax supports only MathML and
3430        $new_mode = $self->{insertion_mode} | IN_FOREIGN_CONTENT_IM;          ## SVG elements as foreigners.
3431        ## ISSUE: What is set as the secondary insertion mode?          $new_mode = $self->{insertion_mode} | IN_FOREIGN_CONTENT_IM;
3432      } else {          ## ISSUE: What is set as the secondary insertion mode?
3433        $new_mode = {        } elsif ($node->[1] & TABLE_CELL_EL) {
3434            if ($last) {
3435              !!!cp ('t28.2');
3436              #
3437            } else {
3438              !!!cp ('t28.3');
3439              $new_mode = IN_CELL_IM;
3440            }
3441          } else {
3442            !!!cp ('t28.4');
3443            $new_mode = {
3444                        select => IN_SELECT_IM,                        select => IN_SELECT_IM,
3445                        ## NOTE: |option| and |optgroup| do not set                        ## NOTE: |option| and |optgroup| do not set
3446                        ## insertion mode to "in select" by themselves.                        ## insertion mode to "in select" by themselves.
                       td => IN_CELL_IM,  
                       th => IN_CELL_IM,  
3447                        tr => IN_ROW_IM,                        tr => IN_ROW_IM,
3448                        tbody => IN_TABLE_BODY_IM,                        tbody => IN_TABLE_BODY_IM,
3449                        thead => IN_TABLE_BODY_IM,                        thead => IN_TABLE_BODY_IM,
# Line 3362  sub _reset_insertion_mode ($) { Line 3455  sub _reset_insertion_mode ($) {
3455                        body => IN_BODY_IM,                        body => IN_BODY_IM,
3456                        frameset => IN_FRAMESET_IM,                        frameset => IN_FRAMESET_IM,
3457                       }->{$node->[0]->manakai_local_name};                       }->{$node->[0]->manakai_local_name};
3458      }        }
3459      $self->{insertion_mode} = $new_mode and return if defined $new_mode;        $self->{insertion_mode} = $new_mode and return if defined $new_mode;
3460                
3461        ## Step 15        ## Step 15
3462        if ($node->[1] & HTML_EL) {        if ($node->[1] & HTML_EL) {
# Line 4106  sub _tree_construction_main ($) { Line 4199  sub _tree_construction_main ($) {
4199              !!!next-token;              !!!next-token;
4200              next B;              next B;
4201            } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {            } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4202              !!!cp ('t94');              !!!cp ('t93.2');
4203              #              !!!parse-error (type => 'after head:head', token => $token); ## TODO: error type
4204                ## Ignore the token
4205                !!!nack ('t93.3');
4206                !!!next-token;
4207                next B;
4208            } else {            } else {
4209              !!!cp ('t95');              !!!cp ('t95');
4210              !!!parse-error (type => 'in head:head', token => $token); # or in head noscript              !!!parse-error (type => 'in head:head', token => $token); # or in head noscript
# Line 4429  sub _tree_construction_main ($) { Line 4526  sub _tree_construction_main ($) {
4526                  $self->{insertion_mode} = AFTER_HEAD_IM;                  $self->{insertion_mode} = AFTER_HEAD_IM;
4527                  !!!next-token;                  !!!next-token;
4528                  next B;                  next B;
4529                  } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4530                    !!!cp ('t134.1');
4531                    !!!parse-error (type => 'unmatched end tag:head', token => $token);
4532                    ## Ignore the token
4533                    !!!next-token;
4534                    next B;
4535                } else {                } else {
4536                  !!!cp ('t135');                  die "$0: $self->{insertion_mode}: Unknown insertion mode";
                 #  
4537                }                }
4538              } elsif ($token->{tag_name} eq 'noscript') {              } elsif ($token->{tag_name} eq 'noscript') {
4539                if ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {                if ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
# Line 4440  sub _tree_construction_main ($) { Line 4542  sub _tree_construction_main ($) {
4542                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4543                  !!!next-token;                  !!!next-token;
4544                  next B;                  next B;
4545                } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM) {                } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM or
4546                           $self->{insertion_mode} == AFTER_HEAD_IM) {
4547                  !!!cp ('t137');                  !!!cp ('t137');
4548                  !!!parse-error (type => 'unmatched end tag:noscript', token => $token);                  !!!parse-error (type => 'unmatched end tag:noscript', token => $token);
4549                  ## Ignore the token ## ISSUE: An issue in the spec.                  ## Ignore the token ## ISSUE: An issue in the spec.
# Line 4453  sub _tree_construction_main ($) { Line 4556  sub _tree_construction_main ($) {
4556              } elsif ({              } elsif ({
4557                        body => 1, html => 1,                        body => 1, html => 1,
4558                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4559                if ($self->{insertion_mode} == BEFORE_HEAD_IM) {                if ($self->{insertion_mode} == BEFORE_HEAD_IM or
4560                  !!!cp ('t139');                    $self->{insertion_mode} == IN_HEAD_IM or
4561                  ## As if <head>                    $self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
                 !!!create-element ($self->{head_element}, $HTML_NS, 'head',, $token);  
                 $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});  
                 push @{$self->{open_elements}},  
                     [$self->{head_element}, $el_category->{head}];  
   
                 $self->{insertion_mode} = IN_HEAD_IM;  
                 ## Reprocess in the "in head" insertion mode...  
               } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {  
4562                  !!!cp ('t140');                  !!!cp ('t140');
4563                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);
4564                  ## Ignore the token                  ## Ignore the token
4565                  !!!next-token;                  !!!next-token;
4566                  next B;                  next B;
4567                  } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4568                    !!!cp ('t140.1');
4569                    !!!parse-error (type => 'unmatched end tag:' . $token->{tag_name}, token => $token);
4570                    ## Ignore the token
4571                    !!!next-token;
4572                    next B;
4573                } else {                } else {
4574                  !!!cp ('t141');                  die "$0: $self->{insertion_mode}: Unknown insertion mode";
4575                }                }
4576                              } elsif ($token->{tag_name} eq 'p') {
4577                #                !!!cp ('t142');
4578              } elsif ({                !!!parse-error (type => 'unmatched end tag:p', token => $token);
4579                        p => 1, br => 1,                ## Ignore the token
4580                       }->{$token->{tag_name}}) {                !!!next-token;
4581                  next B;
4582                } elsif ($token->{tag_name} eq 'br') {
4583                if ($self->{insertion_mode} == BEFORE_HEAD_IM) {                if ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4584                  !!!cp ('t142');                  !!!cp ('t142.2');
4585                  ## As if <head>                  ## (before head) as if <head>, (in head) as if </head>
4586                  !!!create-element ($self->{head_element}, $HTML_NS, 'head',, $token);                  !!!create-element ($self->{head_element}, $HTML_NS, 'head',, $token);
4587                  $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});                  $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
4588                  push @{$self->{open_elements}},                  $self->{insertion_mode} = AFTER_HEAD_IM;
4589                      [$self->{head_element}, $el_category->{head}];    
4590                    ## Reprocess in the "after head" insertion mode...
4591                  } elsif ($self->{insertion_mode} == IN_HEAD_IM) {
4592                    !!!cp ('t143.2');
4593                    ## As if </head>
4594                    pop @{$self->{open_elements}};
4595                    $self->{insertion_mode} = AFTER_HEAD_IM;
4596      
4597                    ## Reprocess in the "after head" insertion mode...
4598                  } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
4599                    !!!cp ('t143.3');
4600                    ## ISSUE: Two parse errors for <head><noscript></br>
4601                    !!!parse-error (type => 'unmatched end tag:br', token => $token);
4602                    ## As if </noscript>
4603                    pop @{$self->{open_elements}};
4604                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4605    
4606                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4607                } else {                  ## As if </head>
4608                  !!!cp ('t143');                  pop @{$self->{open_elements}};
4609                }                  $self->{insertion_mode} = AFTER_HEAD_IM;
4610    
4611                #                  ## Reprocess in the "after head" insertion mode...
4612              } else {                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4613                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                  !!!cp ('t143.4');
                 !!!cp ('t144');  
4614                  #                  #
4615                } else {                } else {
4616                  !!!cp ('t145');                  die "$0: $self->{insertion_mode}: Unknown insertion mode";
                 !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);  
                 ## Ignore the token  
                 !!!next-token;  
                 next B;  
4617                }                }
4618    
4619                  ## ISSUE: does not agree with IE7 - it doesn't ignore </br>.
4620                  !!!parse-error (type => 'unmatched end tag:br', token => $token);
4621                  ## Ignore the token
4622                  !!!next-token;
4623                  next B;
4624                } else {
4625                  !!!cp ('t145');
4626                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);
4627                  ## Ignore the token
4628                  !!!next-token;
4629                  next B;
4630              }              }
4631    
4632              if ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {              if ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
Legend:
Removed from v.1.135  
changed lines
  Added in v.1.141
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24