/[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.161 by wakaba, Wed Sep 10 10:46:50 2008 UTC revision 1.165 by wakaba, Sat Sep 13 07:51:33 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 562  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    
# Line 590  sub parse_byte_stream ($$$$;$) { Line 597  sub parse_byte_stream ($$$$;$) {
597        $self->{input_encoding} = $charset->get_iana_name;        $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 605  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 789  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT Line 803  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT
803  sub BOGUS_DOCTYPE_STATE () { 32 }  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_SECTION_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    sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec
812    sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
813    
814  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
815  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 842  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 862  sub IN_COLUMN_GROUP_IM () { 0b10 }
862  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
863    my $self = shift;    my $self = shift;
864    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
865      #$self->{state_keyword}; # initialized when used
866    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
867    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
868    undef $self->{current_attribute};    undef $self->{current_attribute};
869    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
870    undef $self->{last_attribute_value_state};    undef $self->{last_attribute_value_state};
# Line 1104  sub _get_next_token ($) { Line 1125  sub _get_next_token ($) {
1125          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1126        }        }
1127      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1128          ## NOTE: The "close tag open state" in the spec is implemented as
1129          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1130    
1131        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1132        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1133          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1134              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1135            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1136            my @next_char;            ## Reconsume.
1137            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...  
           }  
1138          } else {          } else {
1139            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1140              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1141            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1142            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1143              ## Reconsume.
1144            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1145                      line => $l, column => $c,                      line => $l, column => $c,
1146                     });                     });
1147            redo A;            redo A;
1148          }          }
1149        }        }
1150          
1151        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1152            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1153          !!!cp (29);          !!!cp (29);
# Line 1213  sub _get_next_token ($) { Line 1194  sub _get_next_token ($) {
1194                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1195                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1196                                   };                                   };
1197          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1198          redo A;          ## Although the "anything else" case of the spec not explicitly
1199            ## states that the next input character is to be reconsumed,
1200            ## it will be included to the |data| of the comment token
1201            ## generated from the bogus end tag, as defined in the
1202            ## "bogus comment state" entry.
1203            redo A;
1204          }
1205        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1206          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1207          if (length $ch) {
1208            my $CH = $ch;
1209            $ch =~ tr/a-z/A-Z/;
1210            my $nch = chr $self->{next_char};
1211            if ($nch eq $ch or $nch eq $CH) {
1212              !!!cp (24);
1213              ## Stay in the state.
1214              $self->{state_keyword} .= $nch;
1215              !!!next-input-character;
1216              redo A;
1217            } else {
1218              !!!cp (25);
1219              $self->{state} = DATA_STATE;
1220              ## Reconsume.
1221              !!!emit ({type => CHARACTER_TOKEN,
1222                        data => '</' . $self->{state_keyword},
1223                        line => $self->{line_prev},
1224                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1225                       });
1226              redo A;
1227            }
1228          } else { # after "<{tag-name}"
1229            unless ({
1230                     0x0009 => 1, # HT
1231                     0x000A => 1, # LF
1232                     0x000B => 1, # VT
1233                     0x000C => 1, # FF
1234                     0x0020 => 1, # SP
1235                     0x003E => 1, # >
1236                     0x002F => 1, # /
1237                     -1 => 1, # EOF
1238                    }->{$self->{next_char}}) {
1239              !!!cp (26);
1240              ## Reconsume.
1241              $self->{state} = DATA_STATE;
1242              !!!emit ({type => CHARACTER_TOKEN,
1243                        data => '</' . $self->{state_keyword},
1244                        line => $self->{line_prev},
1245                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1246                       });
1247              redo A;
1248            } else {
1249              !!!cp (27);
1250              $self->{current_token}
1251                  = {type => END_TAG_TOKEN,
1252                     tag_name => $self->{last_emitted_start_tag_name},
1253                     line => $self->{line_prev},
1254                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1255              $self->{state} = TAG_NAME_STATE;
1256              ## Reconsume.
1257              redo A;
1258            }
1259        }        }
1260      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1261        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1987  sub _get_next_token ($) { Line 2028  sub _get_next_token ($) {
2028        die "$0: _get_next_token: unexpected case [BC]";        die "$0: _get_next_token: unexpected case [BC]";
2029      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2030        ## (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};  
2031                
2032        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2033            !!!cp (133);
2034            $self->{state} = MD_HYPHEN_STATE;
2035          !!!next-input-character;          !!!next-input-character;
2036          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);  
         }  
2037        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2038                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2039            ## ASCII case-insensitive.
2040            !!!cp (130);
2041            $self->{state} = MD_DOCTYPE_STATE;
2042            $self->{state_keyword} = chr $self->{next_char};
2043          !!!next-input-character;          !!!next-input-character;
2044          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);  
         }  
2045        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2046                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2047                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2048            !!!cp (135.4);                
2049            $self->{state} = MD_CDATA_STATE;
2050            $self->{state_keyword} = '[';
2051          !!!next-input-character;          !!!next-input-character;
2052          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);  
         }  
2053        } else {        } else {
2054          !!!cp (136);          !!!cp (136);
2055        }        }
2056    
2057        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2058        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2059        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2060          ## Reconsume.
2061        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2062        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2063                                  line => $l, column => $c,                                  line => $self->{line_prev},
2064                                    column => $self->{column_prev} - 1,
2065                                 };                                 };
2066        redo A;        redo A;
2067              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2068        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2069        ## 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);
2070            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2071                                      line => $self->{line_prev},
2072                                      column => $self->{column_prev} - 2,
2073                                     };
2074            $self->{state} = COMMENT_START_STATE;
2075            !!!next-input-character;
2076            redo A;
2077          } else {
2078            !!!cp (128);
2079            !!!parse-error (type => 'bogus comment',
2080                            line => $self->{line_prev},
2081                            column => $self->{column_prev} - 2);
2082            $self->{state} = BOGUS_COMMENT_STATE;
2083            ## Reconsume.
2084            $self->{current_token} = {type => COMMENT_TOKEN,
2085                                      data => '-',
2086                                      line => $self->{line_prev},
2087                                      column => $self->{column_prev} - 2,
2088                                     };
2089            redo A;
2090          }
2091        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2092          ## ASCII case-insensitive.
2093          if ($self->{next_char} == [
2094                undef,
2095                0x004F, # O
2096                0x0043, # C
2097                0x0054, # T
2098                0x0059, # Y
2099                0x0050, # P
2100              ]->[length $self->{state_keyword}] or
2101              $self->{next_char} == [
2102                undef,
2103                0x006F, # o
2104                0x0063, # c
2105                0x0074, # t
2106                0x0079, # y
2107                0x0070, # p
2108              ]->[length $self->{state_keyword}]) {
2109            !!!cp (131);
2110            ## Stay in the state.
2111            $self->{state_keyword} .= chr $self->{next_char};
2112            !!!next-input-character;
2113            redo A;
2114          } elsif ((length $self->{state_keyword}) == 6 and
2115                   ($self->{next_char} == 0x0045 or # E
2116                    $self->{next_char} == 0x0065)) { # e
2117            !!!cp (129);
2118            $self->{state} = DOCTYPE_STATE;
2119            $self->{current_token} = {type => DOCTYPE_TOKEN,
2120                                      quirks => 1,
2121                                      line => $self->{line_prev},
2122                                      column => $self->{column_prev} - 7,
2123                                     };
2124            !!!next-input-character;
2125            redo A;
2126          } else {
2127            !!!cp (132);        
2128            !!!parse-error (type => 'bogus comment',
2129                            line => $self->{line_prev},
2130                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2131            $self->{state} = BOGUS_COMMENT_STATE;
2132            ## Reconsume.
2133            $self->{current_token} = {type => COMMENT_TOKEN,
2134                                      data => $self->{state_keyword},
2135                                      line => $self->{line_prev},
2136                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2137                                     };
2138            redo A;
2139          }
2140        } elsif ($self->{state} == MD_CDATA_STATE) {
2141          if ($self->{next_char} == {
2142                '[' => 0x0043, # C
2143                '[C' => 0x0044, # D
2144                '[CD' => 0x0041, # A
2145                '[CDA' => 0x0054, # T
2146                '[CDAT' => 0x0041, # A
2147              }->{$self->{state_keyword}}) {
2148            !!!cp (135.1);
2149            ## Stay in the state.
2150            $self->{state_keyword} .= chr $self->{next_char};
2151            !!!next-input-character;
2152            redo A;
2153          } elsif ($self->{state_keyword} eq '[CDATA' and
2154                   $self->{next_char} == 0x005B) { # [
2155            !!!cp (135.2);
2156            $self->{current_token} = {type => CHARACTER_TOKEN,
2157                                      data => '',
2158                                      line => $self->{line_prev},
2159                                      column => $self->{column_prev} - 7};
2160            $self->{state} = CDATA_SECTION_STATE;
2161            !!!next-input-character;
2162            redo A;
2163          } else {
2164            !!!cp (135.3);
2165            !!!parse-error (type => 'bogus comment',
2166                            line => $self->{line_prev},
2167                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2168            $self->{state} = BOGUS_COMMENT_STATE;
2169            ## Reconsume.
2170            $self->{current_token} = {type => COMMENT_TOKEN,
2171                                      data => $self->{state_keyword},
2172                                      line => $self->{line_prev},
2173                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2174                                     };
2175            redo A;
2176          }
2177      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2178        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2179          !!!cp (137);          !!!cp (137);
# Line 2826  sub _get_next_token ($) { Line 2882  sub _get_next_token ($) {
2882          !!!next-input-character;          !!!next-input-character;
2883          redo A;          redo A;
2884        }        }
2885      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2886        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2887          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2888          ## and |CDATA_SECTION_MSE2_STATE|.
2889                
2890        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2891            !!!cp (221.1);
2892            $self->{state} = CDATA_SECTION_MSE1_STATE;
2893            !!!next-input-character;
2894            redo A;
2895          } elsif ($self->{next_char} == -1) {
2896            $self->{state} = DATA_STATE;
2897            !!!next-input-character;
2898            if (length $self->{current_token}->{data}) { # character
2899              !!!cp (221.2);
2900              !!!emit ($self->{current_token}); # character
2901            } else {
2902              !!!cp (221.3);
2903              ## No token to emit. $self->{current_token} is discarded.
2904            }        
2905            redo A;
2906          } else {
2907            !!!cp (221.4);
2908            $self->{current_token}->{data} .= chr $self->{next_char};
2909            ## Stay in the state.
2910            !!!next-input-character;
2911            redo A;
2912          }
2913    
2914        CS: while ($self->{next_char} != -1) {        ## ISSUE: "text tokens" in spec.
2915          if ($self->{next_char} == 0x005D) { # ]      } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
2916            !!!next-input-character;        if ($self->{next_char} == 0x005D) { # ]
2917            if ($self->{next_char} == 0x005D) { # ]          !!!cp (221.5);
2918              !!!next-input-character;          $self->{state} = CDATA_SECTION_MSE2_STATE;
2919              MDC: {          !!!next-input-character;
2920                if ($self->{next_char} == 0x003E) { # >          redo A;
2921                  !!!cp (221.1);        } else {
2922                  !!!next-input-character;          !!!cp (221.6);
2923                  last CS;          $self->{current_token}->{data} .= ']';
2924                } elsif ($self->{next_char} == 0x005D) { # ]          $self->{state} = CDATA_SECTION_STATE;
2925                  !!!cp (221.2);          ## Reconsume.
2926                  $s .= ']';          redo A;
2927                  !!!next-input-character;        }
2928                  redo MDC;      } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
2929                } else {        if ($self->{next_char} == 0x003E) { # >
2930                  !!!cp (221.3);          $self->{state} = DATA_STATE;
2931                  $s .= ']]';          !!!next-input-character;
2932                  #          if (length $self->{current_token}->{data}) { # character
2933                }            !!!cp (221.7);
2934              } # MDC            !!!emit ($self->{current_token}); # character
           } else {  
             !!!cp (221.4);  
             $s .= ']';  
             #  
           }  
2935          } else {          } else {
2936            !!!cp (221.5);            !!!cp (221.8);
2937            #            ## No token to emit. $self->{current_token} is discarded.
2938          }          }
2939          $s .= chr $self->{next_char};          redo A;
2940          } elsif ($self->{next_char} == 0x005D) { # ]
2941            !!!cp (221.9); # character
2942            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
2943            ## Stay in the state.
2944          !!!next-input-character;          !!!next-input-character;
2945        } # CS          redo A;
   
       $self->{state} = DATA_STATE;  
       ## next-input-character done or EOF, which is reconsumed.  
   
       if (length $s) {  
         !!!cp (221.6);  
         !!!emit ({type => CHARACTER_TOKEN, data => $s,  
                   line => $l, column => $c});  
2946        } else {        } else {
2947          !!!cp (221.7);          !!!cp (221.11);
2948            $self->{current_token}->{data} .= ']]'; # character
2949            $self->{state} = CDATA_SECTION_STATE;
2950            ## Reconsume.
2951            redo A;
2952        }        }
   
       redo A;  
   
       ## ISSUE: "text tokens" in spec.  
       ## TODO: Streaming support  
2953      } else {      } else {
2954        die "$0: $self->{state}: Unknown state";        die "$0: $self->{state}: Unknown state";
2955      }      }
# Line 7458  sub _tree_construction_main ($) { Line 7528  sub _tree_construction_main ($) {
7528    ## TODO: script stuffs    ## TODO: script stuffs
7529  } # _tree_construct_main  } # _tree_construct_main
7530    
7531  sub set_inner_html ($$$) {  sub set_inner_html ($$$;$) {
7532    my $class = shift;    my $class = shift;
7533    my $node = shift;    my $node = shift;
7534    my $s = \$_[0];    my $s = \$_[0];
7535    my $onerror = $_[1];    my $onerror = $_[1];
7536      my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7537    
7538    ## ISSUE: Should {confident} be true?    ## ISSUE: Should {confident} be true?
7539    
# Line 7481  sub set_inner_html ($$$) { Line 7552  sub set_inner_html ($$$) {
7552      }      }
7553    
7554      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7555      $class->parse_string ($$s => $node, $onerror);      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);
7556    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7557      ## TODO: If non-html element      ## TODO: If non-html element
7558    
7559      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
7560    
7561    ## TODO: Support for $get_wrapper
7562    
7563      ## Step 1 # MUST      ## Step 1 # MUST
7564      my $this_doc = $node->owner_document;      my $this_doc = $node->owner_document;
7565      my $doc = $this_doc->implementation->create_document;      my $doc = $this_doc->implementation->create_document;
Legend:
Removed from v.1.161  
changed lines
  Added in v.1.165
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24