/[suikacvs]/markup/html/whatpm/Whatpm/HTML.pm.src

Diff of /markup/html/whatpm/Whatpm/HTML.pm.src

Parent Directory | Revision Log | View Patch Patch

-revision 1.149 by wakaba,
Sun May 25 08:53:49 2008 UTC
+revision 1.172 by wakaba,
Sun Sep 14 03:07:58 2008 UTC
 Line 45 
 sub MISC_SPECIAL_EL () { 0b1000000000000
  sub FOREIGN_EL () { 0b10000000000000000000000000 }
  sub FOREIGN_FLOW_CONTENT_EL () { 0b100000000000000000000000000 }
  sub MML_AXML_EL () { 0b1000000000000000000000000000 }
+ sub RUBY_EL () { 0b10000000000000000000000000000 }
+ sub RUBY_COMPONENT_EL () { 0b100000000000000000000000000000 }
  sub TABLE_ROWS_EL () {
    TABLE_EL |
-Line 52 
 sub TABLE_ROWS_EL () {
+Line 54 
 sub TABLE_ROWS_EL () {
    TABLE_ROW_GROUP_EL
  }
+ ## NOTE: Used in "generate implied end tags" algorithm.
+ ## NOTE: There is a code where a modified version of END_TAG_OPTIONAL_EL
+ ## is used in "generate implied end tags" implementation (search for the
+ ## function mae).
  sub END_TAG_OPTIONAL_EL () {
    DD_EL |
    DT_EL |
    LI_EL |
-   P_EL
+   P_EL |
+   RUBY_COMPONENT_EL
  }
+ ## NOTE: Used in </body> and EOF algorithms.
  sub ALL_END_TAG_OPTIONAL_EL () {
-   END_TAG_OPTIONAL_EL |
+   DD_EL |
+   DT_EL |
+   LI_EL |
+   P_EL |
    BODY_EL |
    HTML_EL |
    TABLE_CELL_EL |
-Line 96 
 sub SPECIAL_EL () {
+Line 108 
 sub SPECIAL_EL () {
    ADDRESS_EL |
    BODY_EL |
    DIV_EL |
-   END_TAG_OPTIONAL_EL |
+   DD_EL |
+   DT_EL |
+   LI_EL |
+   P_EL |
    FORM_EL |
    FRAMESET_EL |
    HEADING_EL |
-Line 170 
 my $el_category = {
+Line 187 
 my $el_category = {
    param => MISC_SPECIAL_EL,
    plaintext => MISC_SPECIAL_EL,
    pre => MISC_SPECIAL_EL,
+   rp => RUBY_COMPONENT_EL,
+   rt => RUBY_COMPONENT_EL,
+   ruby => RUBY_EL,
    s => FORMATTING_EL,
    script => MISC_SPECIAL_EL,
    select => SELECT_EL,
-Line 334 
 sub parse_byte_string ($$$$;$) {
+Line 354 
 sub parse_byte_string ($$$$;$) {
    return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);
  } # parse_byte_string
- sub parse_byte_stream ($$$$;$) {
+ sub parse_byte_stream ($$$$;$$) {
+   # my ($self, $charset_name, $byte_stream, $doc, $onerror, $get_wrapper) = @_;
    my $self = ref $_[0] ? shift : shift->new;
    my $charset_name = shift;
    my $byte_stream = $_[0];
-Line 345 
 sub parse_byte_stream ($$$$;$) {
+Line 366 
 sub parse_byte_stream ($$$$;$) {
    };
    $self->{parse_error} = $onerror; # updated later by parse_char_string
+   my $get_wrapper = $_[3] || sub ($) {
+     return $_[0]; # $_[0] = byte stream handle, returned = arg to char handle
+   };
    ## HTML5 encoding sniffing algorithm
    require Message::Charset::Info;
    my $charset;
-Line 352 
 sub parse_byte_stream ($$$$;$) {
+Line 377 
 sub parse_byte_stream ($$$$;$) {
    my ($char_stream, $e_status);
    SNIFFING: {
+     ## NOTE: By setting |allow_fallback| option true when the
+     ## |get_decode_handle| method is invoked, we ignore what the HTML5
+     ## spec requires, i.e. unsupported encoding should be ignored.
+       ## TODO: We should not do this unless the parser is invoked
+       ## in the conformance checking mode, in which this behavior
+       ## would be useful.
      ## Step 1
      if (defined $charset_name) {
-       $charset = Message::Charset::Info->get_by_iana_name ($charset_name);
+       $charset = Message::Charset::Info->get_by_html_name ($charset_name);
+           ## TODO: Is this ok?  Transfer protocol's parameter should be
+           ## interpreted in its semantics?
        ## ISSUE: Unsupported encoding is not ignored according to the spec.
        ($char_stream, $e_status) = $charset->get_decode_handle
-Line 379 
 sub parse_byte_stream ($$$$;$) {
+Line 412 
 sub parse_byte_stream ($$$$;$) {
      ## Step 3
      if ($byte_buffer =~ /^\xFE\xFF/) {
-       $charset = Message::Charset::Info->get_by_iana_name ('utf-16be');
+       $charset = Message::Charset::Info->get_by_html_name ('utf-16be');
        ($char_stream, $e_status) = $charset->get_decode_handle
            ($byte_stream, allow_error_reporting => 1,
             allow_fallback => 1, byte_buffer => \$byte_buffer);
        $self->{confident} = 1;
        last SNIFFING;
      } elsif ($byte_buffer =~ /^\xFF\xFE/) {
-       $charset = Message::Charset::Info->get_by_iana_name ('utf-16le');
+       $charset = Message::Charset::Info->get_by_html_name ('utf-16le');
        ($char_stream, $e_status) = $charset->get_decode_handle
            ($byte_stream, allow_error_reporting => 1,
             allow_fallback => 1, byte_buffer => \$byte_buffer);
        $self->{confident} = 1;
        last SNIFFING;
      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {
-       $charset = Message::Charset::Info->get_by_iana_name ('utf-8');
+       $charset = Message::Charset::Info->get_by_html_name ('utf-8');
        ($char_stream, $e_status) = $charset->get_decode_handle
            ($byte_stream, allow_error_reporting => 1,
             allow_fallback => 1, byte_buffer => \$byte_buffer);
-Line 412 
 sub parse_byte_stream ($$$$;$) {
+Line 445 
 sub parse_byte_stream ($$$$;$) {
      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string
          ($byte_buffer);
      if (defined $charset_name) {
-       $charset = Message::Charset::Info->get_by_iana_name ($charset_name);
+       $charset = Message::Charset::Info->get_by_html_name ($charset_name);
        ## ISSUE: Unsupported encoding is not ignored according to the spec.
        require Whatpm::Charset::DecodeHandle;
-Line 423 
 sub parse_byte_stream ($$$$;$) {
+Line 456 
 sub parse_byte_stream ($$$$;$) {
             allow_fallback => 1, byte_buffer => \$byte_buffer);
        if ($char_stream) {
          $buffer->{buffer} = $byte_buffer;
-         !!!parse-error (type => 'sniffing:chardet', ## TODO: type name
+         !!!parse-error (type => 'sniffing:chardet',
-                         value => $charset_name,
+                         text => $charset_name,
-                         level => $self->{info_level},
+                         level => $self->{level}->{info},
+                         layer => 'encode',
                          line => 1, column => 1);
          $self->{confident} = 0;
          last SNIFFING;
-Line 434 
 sub parse_byte_stream ($$$$;$) {
+Line 468 
 sub parse_byte_stream ($$$$;$) {
      ## Step 7: default
      ## TODO: Make this configurable.
-     $charset = Message::Charset::Info->get_by_iana_name ('windows-1252');
+     $charset = Message::Charset::Info->get_by_html_name ('windows-1252');
          ## NOTE: We choose |windows-1252| here, since |utf-8| should be
          ## detectable in the step 6.
      require Whatpm::Charset::DecodeHandle;
-Line 446 
 sub parse_byte_stream ($$$$;$) {
+Line 480 
 sub parse_byte_stream ($$$$;$) {
                                         allow_fallback => 1,
                                         byte_buffer => \$byte_buffer);
      $buffer->{buffer} = $byte_buffer;
-     !!!parse-error (type => 'sniffing:default', ## TODO: type name
+     !!!parse-error (type => 'sniffing:default',
-                     value => 'windows-1252',
+                     text => 'windows-1252',
-                     level => $self->{info_level},
+                     level => $self->{level}->{info},
-                     line => 1, column => 1);
+                     line => 1, column => 1,
+                     layer => 'encode');
      $self->{confident} = 0;
    } # SNIFFING
-   $self->{input_encoding} = $charset->get_iana_name;
    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
-     !!!parse-error (type => 'chardecode:fallback', ## TODO: type name
+     $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
-                     value => $self->{input_encoding},
+     !!!parse-error (type => 'chardecode:fallback',
-                     level => $self->{unsupported_level},
+                     #text => $self->{input_encoding},
-                     line => 1, column => 1);
+                     level => $self->{level}->{uncertain},
+                     line => 1, column => 1,
+                     layer => 'encode');
    } elsif (not ($e_status &
                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
-     !!!parse-error (type => 'chardecode:no error', ## TODO: type name
+     $self->{input_encoding} = $charset->get_iana_name;
-                     value => $self->{input_encoding},
+     !!!parse-error (type => 'chardecode:no error',
-                     level => $self->{unsupported_level},
+                     text => $self->{input_encoding},
-                     line => 1, column => 1);
+                     level => $self->{level}->{uncertain},
+                     line => 1, column => 1,
+                     layer => 'encode');
+   } else {
+     $self->{input_encoding} = $charset->get_iana_name;
    }
    $self->{change_encoding} = sub {
-Line 472 
 sub parse_byte_stream ($$$$;$) {
+Line 512 
 sub parse_byte_stream ($$$$;$) {
      $charset_name = shift;
      my $token = shift;
-     $charset = Message::Charset::Info->get_by_iana_name ($charset_name);
+     $charset = Message::Charset::Info->get_by_html_name ($charset_name);
      ($char_stream, $e_status) = $charset->get_decode_handle
          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,
           byte_buffer => \ $buffer->{buffer});
-Line 483 
 sub parse_byte_stream ($$$$;$) {
+Line 523 
 sub parse_byte_stream ($$$$;$) {
        ## Step 1
        if ($charset->{category} &
            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {
-         $charset = Message::Charset::Info->get_by_iana_name ('utf-8');
+         $charset = Message::Charset::Info->get_by_html_name ('utf-8');
          ($char_stream, $e_status) = $charset->get_decode_handle
              ($byte_stream,
               byte_buffer => \ $buffer->{buffer});
-Line 493 
 sub parse_byte_stream ($$$$;$) {
+Line 533 
 sub parse_byte_stream ($$$$;$) {
        ## Step 2
        if (defined $self->{input_encoding} and
            $self->{input_encoding} eq $charset_name) {
-         !!!parse-error (type => 'charset label:matching', ## TODO: type
+         !!!parse-error (type => 'charset label:matching',
-                         value => $charset_name,
+                         text => $charset_name,
-                         level => $self->{info_level});
+                         level => $self->{level}->{info});
          $self->{confident} = 1;
          return;
        }
-       !!!parse-error (type => 'charset label detected:'.$self->{input_encoding}.
+       !!!parse-error (type => 'charset label detected',
-           ':'.$charset_name, level => 'w', token => $token);
+                       text => $self->{input_encoding},
+                       value => $charset_name,
+                       level => $self->{level}->{warn},
+                       token => $token);
        ## Step 3
        # if (can) {
-Line 517 
 sub parse_byte_stream ($$$$;$) {
+Line 560 
 sub parse_byte_stream ($$$$;$) {
    my $char_onerror = sub {
      my (undef, $type, %opt) = @_;
-     !!!parse-error (%opt, type => $type,
+     !!!parse-error (layer => 'encode',
+                     %opt, type => $type,
                      line => $self->{line}, column => $self->{column} + 1);
      if ($opt{octets}) {
        ${$opt{octets}} = "\x{FFFD}"; # relacement character
      }
    };
-   $char_stream->onerror ($char_onerror);
+   my $wrapped_char_stream = $get_wrapper->($char_stream);
+   $wrapped_char_stream->onerror ($char_onerror);
    my @args = @_; shift @args; # $s
    my $return;
    try {
-     $return = $self->parse_char_stream ($char_stream, @args);
+     $return = $self->parse_char_stream ($wrapped_char_stream, @args);
    } catch Whatpm::HTML::RestartParser with {
      ## NOTE: Invoked after {change_encoding}.
-     $self->{input_encoding} = $charset->get_iana_name;
      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
-       !!!parse-error (type => 'chardecode:fallback', ## TODO: type name
+       $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
-                       value => $self->{input_encoding},
+       !!!parse-error (type => 'chardecode:fallback',
-                       level => $self->{unsupported_level},
+                       level => $self->{level}->{uncertain},
-                       line => 1, column => 1);
+                       #text => $self->{input_encoding},
+                       line => 1, column => 1,
+                       layer => 'encode');
      } elsif (not ($e_status &
                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
-       !!!parse-error (type => 'chardecode:no error', ## TODO: type name
+       $self->{input_encoding} = $charset->get_iana_name;
-                       value => $self->{input_encoding},
+       !!!parse-error (type => 'chardecode:no error',
-                       level => $self->{unsupported_level},
+                       text => $self->{input_encoding},
-                       line => 1, column => 1);
+                       level => $self->{level}->{uncertain},
+                       line => 1, column => 1,
+                       layer => 'encode');
+     } else {
+       $self->{input_encoding} = $charset->get_iana_name;
      }
      $self->{confident} = 1;
-     $char_stream->onerror ($char_onerror);
-     $return = $self->parse_char_stream ($char_stream, @args);
+     $wrapped_char_stream = $get_wrapper->($char_stream);
+     $wrapped_char_stream->onerror ($char_onerror);
+     $return = $self->parse_char_stream ($wrapped_char_stream, @args);
    };
    return $return;
  } # parse_byte_stream
-Line 561 
 sub parse_byte_stream ($$$$;$) {
+Line 615 
 sub parse_byte_stream ($$$$;$) {
  ## such as |parse_byte_string| in this module, must ensure that it does
  ## strip the BOM and never strip any ZWNBSP.
- sub parse_char_string ($$$;$) {
+ sub parse_char_string ($$$;$$) {
+   #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
    my $self = shift;
-   require utf8;
    my $s = ref $_[0] ? $_[0] : \($_[0]);
-   open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;
+   require Whatpm::Charset::DecodeHandle;
+   my $input = Whatpm::Charset::DecodeHandle::CharString->new ($s);
+   if ($_[3]) {
+     $input = $_[3]->($input);
+   }
    return $self->parse_char_stream ($input, @_[1..$#_]);
  } # parse_char_string
- *parse_string = \&parse_char_string;
+ *parse_string = \&parse_char_string; ## NOTE: Alias for backward compatibility.
  sub parse_char_stream ($$$;$) {
    my $self = ref $_[0] ? shift : shift->new;
-Line 611 
 sub parse_char_stream ($$$;$) {
+Line 669 
 sub parse_char_stream ($$$;$) {
        $self->{column} = 0;
      } elsif ($self->{next_char} == 0x000D) { # CR
        !!!cp ('j2');
+ ## TODO: support for abort/streaming
        my $next = $input->getc;
        if (defined $next and $next ne "\x0A") {
          $self->{next_next_char} = $next;
-Line 630 
 sub parse_char_stream ($$$;$) {
+Line 689 
 sub parse_char_stream ($$$;$) {
               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or
               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or
               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or
+ ## ISSUE: U+FDE0-U+FDEF are not excluded
               {
 xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,
 x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
-Line 642 
 sub parse_char_stream ($$$;$) {
+Line 702 
 sub parse_char_stream ($$$;$) {
 x10FFFE => 1, 0x10FFFF => 1,
               }->{$self->{next_char}}) {
        !!!cp ('j5');
-       !!!parse-error (type => 'control char', level => $self->{must_level});
+       if ($self->{next_char} < 0x10000) {
- ## TODO: error type documentation
+         !!!parse-error (type => 'control char',
+                         text => (sprintf 'U+%04X', $self->{next_char}));
+       } else {
+         !!!parse-error (type => 'control char',
+                         text => (sprintf 'U-%08X', $self->{next_char}));
+       }
      }
    };
    $self->{prev_char} = [-1, -1, -1];
    $self->{next_char} = -1;
+   $self->{read_until} = sub {
+     #my ($scalar, $specials_range, $offset) = @_;
+     my $specials_range = $_[1];
+     return 0 if defined $self->{next_next_char};
+     my $count = $input->manakai_read_until
+        ($_[0],
+         qr/(?![$specials_range\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
+         $_[2]);
+     if ($count) {
+       $self->{column} += $count;
+       $self->{column_prev} += $count;
+       $self->{prev_char} = [-1, -1, -1];
+       $self->{next_char} = -1;
+     }
+     return $count;
+   }; # $self->{read_until}
    my $onerror = $_[2] || sub {
      my (%opt) = @_;
   &nb