/[suikacvs]/markup/html/whatpm/Whatpm/HTML/Tokenizer.pm
Suika

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.20 by wakaba, Sun Oct 19 08:20:29 2008 UTC revision 1.33 by wakaba, Sat Sep 5 10:41:07 2009 UTC
# Line 105  sub COMMENT_START_STATE () { 14 } Line 105  sub COMMENT_START_STATE () { 14 }
105  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
106  sub COMMENT_STATE () { 16 }  sub COMMENT_STATE () { 16 }
107  sub COMMENT_END_STATE () { 17 }  sub COMMENT_END_STATE () { 17 }
108    sub COMMENT_END_BANG_STATE () { 102 }
109    sub COMMENT_END_SPACE_STATE () { 103 } ## LAST
110  sub COMMENT_END_DASH_STATE () { 18 }  sub COMMENT_END_DASH_STATE () { 18 }
111  sub BOGUS_COMMENT_STATE () { 19 }  sub BOGUS_COMMENT_STATE () { 19 }
112  sub DOCTYPE_STATE () { 20 }  sub DOCTYPE_STATE () { 20 }
# Line 1100  sub _get_next_token ($) { Line 1102  sub _get_next_token ($) {
1102          $self->{s_kwd} = '';          $self->{s_kwd} = '';
1103          # reconsume          # reconsume
1104    
1105          return  ($self->{ct}); # start tag or end tag          ## Discard the token.
1106            #return  ($self->{ct}); # start tag or end tag
1107    
1108          redo A;          redo A;
1109        } elsif ($self->{nc} == 0x002F) { # /        } elsif ($self->{nc} == 0x002F) { # /
# Line 1241  sub _get_next_token ($) { Line 1244  sub _get_next_token ($) {
1244          $self->{s_kwd} = '';          $self->{s_kwd} = '';
1245          # reconsume          # reconsume
1246    
1247          return  ($self->{ct}); # start tag or end tag          ## Discard the token.
1248            #return  ($self->{ct}); # start tag or end tag
1249    
1250          redo A;          redo A;
1251        } else {        } else {
1252          if ({          if ({
1253               0x0022 => 1, # "               0x0022 => 1, # "
1254               0x0027 => 1, # '               0x0027 => 1, # '
1255                 0x003C => 1, # <
1256               0x003D => 1, # =               0x003D => 1, # =
1257              }->{$self->{nc}}) {              }->{$self->{nc}}) {
1258                        
# Line 1426  sub _get_next_token ($) { Line 1431  sub _get_next_token ($) {
1431          $self->{s_kwd} = '';          $self->{s_kwd} = '';
1432          # reconsume          # reconsume
1433    
1434          return  ($self->{ct}); # start tag or end tag          ## Discard the token.
1435            #return  ($self->{ct}); # start tag or end tag
1436    
1437          redo A;          redo A;
1438        } else {        } else {
1439          if ($self->{nc} == 0x0022 or # "          if ({
1440              $self->{nc} == 0x0027) { # '               0x0022 => 1, # "
1441                 0x0027 => 1, # '
1442                 0x003C => 1, # <
1443                }->{$self->{nc}}) {
1444                        
1445            ## XML5: Not a parse error.            ## XML5: Not a parse error.
1446            $self->{parse_error}->(level => $self->{level}->{must}, type => 'bad attribute name');            $self->{parse_error}->(level => $self->{level}->{must}, type => 'bad attribute name');
# Line 1590  sub _get_next_token ($) { Line 1599  sub _get_next_token ($) {
1599          $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
1600          # reconsume          # reconsume
1601    
1602          return  ($self->{ct}); # start tag or end tag          ## Discard the token.
1603            #return  ($self->{ct}); # start tag or end tag
1604    
1605          redo A;          redo A;
1606        } else {        } else {
# Line 1602  sub _get_next_token ($) { Line 1612  sub _get_next_token ($) {
1612                        
1613          }          }
1614    
1615          if ($self->{nc} == 0x0022 or # "          if ({
1616              $self->{nc} == 0x0027) { # '               0x0022 => 1, # "
1617                 0x0027 => 1, # '
1618                 0x003C => 1, # <
1619                }->{$self->{nc}}) {
1620                        
1621            ## XML5: Not a parse error.            ## XML5: Not a parse error.
1622            $self->{parse_error}->(level => $self->{level}->{must}, type => 'bad attribute name');            $self->{parse_error}->(level => $self->{level}->{must}, type => 'bad attribute name');
# Line 1736  sub _get_next_token ($) { Line 1749  sub _get_next_token ($) {
1749          $self->{s_kwd} = '';          $self->{s_kwd} = '';
1750          ## reconsume          ## reconsume
1751    
1752          return  ($self->{ct}); # start tag or end tag          ## Discard the token.
1753            #return  ($self->{ct}); # start tag or end tag
1754    
1755          redo A;          redo A;
1756        } else {        } else {
1757          if ($self->{nc} == 0x003D) { # =          if ($self->{nc} == 0x003D or $self->{nc} == 0x003C) { # =, <
1758                        
1759            ## XML5: Not a parse error.            ## XML5: Not a parse error.
1760            $self->{parse_error}->(level => $self->{level}->{must}, type => 'bad attribute value');            $self->{parse_error}->(level => $self->{level}->{must}, type => 'bad attribute value');
# Line 1816  sub _get_next_token ($) { Line 1830  sub _get_next_token ($) {
1830      }      }
1831        
1832          redo A;          redo A;
1833          } elsif ($self->{is_xml} and
1834                   $is_space->{$self->{nc}}) {
1835            
1836            $self->{ca}->{value} .= ' ';
1837            ## Stay in the state.
1838            
1839        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
1840          $self->{line_prev} = $self->{line};
1841          $self->{column_prev} = $self->{column};
1842          $self->{column}++;
1843          $self->{nc}
1844              = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
1845        } else {
1846          $self->{set_nc}->($self);
1847        }
1848      
1849            redo A;
1850        } elsif ($self->{nc} == -1) {        } elsif ($self->{nc} == -1) {
1851          $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed attribute value');          $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed attribute value');
1852          if ($self->{ct}->{type} == START_TAG_TOKEN) {          if ($self->{ct}->{type} == START_TAG_TOKEN) {
# Line 1840  sub _get_next_token ($) { Line 1871  sub _get_next_token ($) {
1871            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1872            $self->{s_kwd} = '';            $self->{s_kwd} = '';
1873            ## reconsume            ## reconsume
1874            return  ($self->{ct}); # end tag  
1875              ## Discard the token.
1876              #return  ($self->{ct}); # end tag
1877    
1878            redo A;            redo A;
1879          } elsif ($self->{ct}->{type} == ATTLIST_TOKEN) {          } elsif ($self->{ct}->{type} == ATTLIST_TOKEN) {
1880            ## XML5: No parse error above; not defined yet.            ## XML5: No parse error above; not defined yet.
1881            push @{$self->{ct}->{attrdefs}}, $self->{ca};            push @{$self->{ct}->{attrdefs}}, $self->{ca};
1882            $self->{state} = DOCTYPE_INTERNAL_SUBSET_STATE;            $self->{state} = DOCTYPE_INTERNAL_SUBSET_STATE;
1883            ## Reconsume.            ## Reconsume.
1884            return  ($self->{ct}); # ATTLIST  
1885              ## Discard the token.
1886              #return  ($self->{ct}); # ATTLIST
1887    
1888            redo A;            redo A;
1889          } else {          } else {
1890            die "$0: $self->{ct}->{type}: Unknown token type";            die "$0: $self->{ct}->{type}: Unknown token type";
# Line 1863  sub _get_next_token ($) { Line 1900  sub _get_next_token ($) {
1900          }          }
1901          $self->{ca}->{value} .= chr ($self->{nc});          $self->{ca}->{value} .= chr ($self->{nc});
1902          $self->{read_until}->($self->{ca}->{value},          $self->{read_until}->($self->{ca}->{value},
1903                                q["&<],                                qq["&<\x09\x0C\x20],
1904                                length $self->{ca}->{value});                                length $self->{ca}->{value});
1905    
1906          ## Stay in the state          ## Stay in the state
# Line 1930  sub _get_next_token ($) { Line 1967  sub _get_next_token ($) {
1967      }      }
1968        
1969          redo A;          redo A;
1970          } elsif ($self->{is_xml} and
1971                   $is_space->{$self->{nc}}) {
1972            
1973            $self->{ca}->{value} .= ' ';
1974            ## Stay in the state.
1975            
1976        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
1977          $self->{line_prev} = $self->{line};
1978          $self->{column_prev} = $self->{column};
1979          $self->{column}++;
1980          $self->{nc}
1981              = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
1982        } else {
1983          $self->{set_nc}->($self);
1984        }
1985      
1986            redo A;
1987        } elsif ($self->{nc} == -1) {        } elsif ($self->{nc} == -1) {
1988          $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed attribute value');          $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed attribute value');
1989          if ($self->{ct}->{type} == START_TAG_TOKEN) {          if ($self->{ct}->{type} == START_TAG_TOKEN) {
# Line 1939  sub _get_next_token ($) { Line 1993  sub _get_next_token ($) {
1993            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1994            $self->{s_kwd} = '';            $self->{s_kwd} = '';
1995            ## reconsume            ## reconsume
1996            return  ($self->{ct}); # start tag  
1997              ## Discard the token.
1998              #return  ($self->{ct}); # start tag
1999    
2000            redo A;            redo A;
2001          } elsif ($self->{ct}->{type} == END_TAG_TOKEN) {          } elsif ($self->{ct}->{type} == END_TAG_TOKEN) {
2002            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST            $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST
# Line 1954  sub _get_next_token ($) { Line 2011  sub _get_next_token ($) {
2011            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
2012            $self->{s_kwd} = '';            $self->{s_kwd} = '';
2013            ## reconsume            ## reconsume
2014            return  ($self->{ct}); # end tag  
2015              ## Discard the token.
2016              #return  ($self->{ct}); # end tag
2017    
2018            redo A;            redo A;
2019          } elsif ($self->{ct}->{type} == ATTLIST_TOKEN) {          } elsif ($self->{ct}->{type} == ATTLIST_TOKEN) {
2020            ## XML5: No parse error above; not defined yet.            ## XML5: No parse error above; not defined yet.
2021            push @{$self->{ct}->{attrdefs}}, $self->{ca};            push @{$self->{ct}->{attrdefs}}, $self->{ca};
2022            $self->{state} = DOCTYPE_INTERNAL_SUBSET_STATE;            $self->{state} = DOCTYPE_INTERNAL_SUBSET_STATE;
2023            ## Reconsume.            ## Reconsume.
2024            return  ($self->{ct}); # ATTLIST  
2025              ## Discard the token.
2026              #return  ($self->{ct}); # ATTLIST
2027    
2028            redo A;            redo A;
2029          } else {          } else {
2030            die "$0: $self->{ct}->{type}: Unknown token type";            die "$0: $self->{ct}->{type}: Unknown token type";
# Line 1977  sub _get_next_token ($) { Line 2040  sub _get_next_token ($) {
2040          }          }
2041          $self->{ca}->{value} .= chr ($self->{nc});          $self->{ca}->{value} .= chr ($self->{nc});
2042          $self->{read_until}->($self->{ca}->{value},          $self->{read_until}->($self->{ca}->{value},
2043                                q['&<],                                qq['&<\x09\x0C\x20],
2044                                length $self->{ca}->{value});                                length $self->{ca}->{value});
2045    
2046          ## Stay in the state          ## Stay in the state
# Line 2116  sub _get_next_token ($) { Line 2179  sub _get_next_token ($) {
2179            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
2180            $self->{s_kwd} = '';            $self->{s_kwd} = '';
2181            ## reconsume            ## reconsume
2182            return  ($self->{ct}); # start tag  
2183              ## Discard the token.
2184              #return  ($self->{ct}); # start tag
2185              
2186            redo A;            redo A;
2187          } elsif ($self->{ct}->{type} == END_TAG_TOKEN) {          } elsif ($self->{ct}->{type} == END_TAG_TOKEN) {
2188            $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed tag');            $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed tag');
# Line 2132  sub _get_next_token ($) { Line 2198  sub _get_next_token ($) {
2198            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
2199            $self->{s_kwd} = '';            $self->{s_kwd} = '';
2200            ## reconsume            ## reconsume
2201            return  ($self->{ct}); # end tag  
2202              ## Discard the token.
2203              #return  ($self->{ct}); # end tag
2204    
2205            redo A;            redo A;
2206          } elsif ($self->{ct}->{type} == ATTLIST_TOKEN) {          } elsif ($self->{ct}->{type} == ATTLIST_TOKEN) {
2207            $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed md'); ## TODO: type            $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed md'); ## TODO: type
2208            push @{$self->{ct}->{attrdefs}}, $self->{ca};            push @{$self->{ct}->{attrdefs}}, $self->{ca};
2209            $self->{state} = DOCTYPE_INTERNAL_SUBSET_STATE;            $self->{state} = DOCTYPE_INTERNAL_SUBSET_STATE;
2210            ## Reconsume.            ## Reconsume.
2211            return  ($self->{ct}); # ATTLIST  
2212              ## Discard the token.
2213              #return  ($self->{ct}); # ATTLIST
2214    
2215            redo A;            redo A;
2216          } else {          } else {
2217            die "$0: $self->{ct}->{type}: Unknown token type";            die "$0: $self->{ct}->{type}: Unknown token type";
# Line 2149  sub _get_next_token ($) { Line 2221  sub _get_next_token ($) {
2221               0x0022 => 1, # "               0x0022 => 1, # "
2222               0x0027 => 1, # '               0x0027 => 1, # '
2223               0x003D => 1, # =               0x003D => 1, # =
2224                 0x003C => 1, # <
2225              }->{$self->{nc}}) {              }->{$self->{nc}}) {
2226                        
2227            ## XML5: Not a parse error.            ## XML5: Not a parse error.
# Line 2158  sub _get_next_token ($) { Line 2231  sub _get_next_token ($) {
2231          }          }
2232          $self->{ca}->{value} .= chr ($self->{nc});          $self->{ca}->{value} .= chr ($self->{nc});
2233          $self->{read_until}->($self->{ca}->{value},          $self->{read_until}->($self->{ca}->{value},
2234                                q["'=& >],                                qq["'=& \x09\x0C>],
2235                                length $self->{ca}->{value});                                length $self->{ca}->{value});
2236    
2237          ## Stay in the state          ## Stay in the state
# Line 2258  sub _get_next_token ($) { Line 2331  sub _get_next_token ($) {
2331          $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2332          $self->{s_kwd} = '';          $self->{s_kwd} = '';
2333          ## Reconsume.          ## Reconsume.
2334          return  ($self->{ct}); # start tag or end tag  
2335            ## Discard the token.
2336            #return  ($self->{ct}); # start tag or end tag
2337    
2338          redo A;          redo A;
2339        } else {        } else {
2340                    
# Line 2325  sub _get_next_token ($) { Line 2401  sub _get_next_token ($) {
2401          $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2402          $self->{s_kwd} = '';          $self->{s_kwd} = '';
2403          ## Reconsume.          ## Reconsume.
2404          return  ($self->{ct}); # start tag or end tag  
2405            ## Discard the token.
2406            #return  ($self->{ct}); # start tag or end tag
2407    
2408          redo A;          redo A;
2409        } else {        } else {
2410                    
# Line 2900  sub _get_next_token ($) { Line 2979  sub _get_next_token ($) {
2979        
2980          redo A;          redo A;
2981        }        }
2982      } elsif ($self->{state} == COMMENT_END_STATE) {      } elsif ($self->{state} == COMMENT_END_STATE or
2983                 $self->{state} == COMMENT_END_BANG_STATE) {
2984        ## XML5: "Comment end state" and "DOCTYPE comment end state".        ## XML5: "Comment end state" and "DOCTYPE comment end state".
2985          ## (No comment end bang state.)
2986    
2987        if ($self->{nc} == 0x003E) { # >        if ($self->{nc} == 0x003E) { # >
2988          if ($self->{in_subset}) {          if ($self->{in_subset}) {
# Line 2928  sub _get_next_token ($) { Line 3009  sub _get_next_token ($) {
3009    
3010          redo A;          redo A;
3011        } elsif ($self->{nc} == 0x002D) { # -        } elsif ($self->{nc} == 0x002D) { # -
3012            if ($self->{state} == COMMENT_END_BANG_STATE) {
3013              
3014              $self->{ct}->{data} .= '--!'; # comment
3015              $self->{state} = COMMENT_END_DASH_STATE;
3016            } else {
3017              
3018              ## XML5: Not a parse error.
3019              $self->{parse_error}->(level => $self->{level}->{must}, type => 'dash in comment',
3020                              line => $self->{line_prev},
3021                              column => $self->{column_prev});
3022              $self->{ct}->{data} .= '-'; # comment
3023              ## Stay in the state
3024            }
3025                    
3026          ## XML5: Not a parse error.      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
3027          $self->{parse_error}->(level => $self->{level}->{must}, type => 'dash in comment',        $self->{line_prev} = $self->{line};
3028                          line => $self->{line_prev},        $self->{column_prev} = $self->{column};
3029                          column => $self->{column_prev});        $self->{column}++;
3030          $self->{ct}->{data} .= '-'; # comment        $self->{nc}
3031          ## Stay in the state            = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
3032        } else {
3033          $self->{set_nc}->($self);
3034        }
3035      
3036            redo A;
3037          } elsif ($self->{state} != COMMENT_END_BANG_STATE and
3038                   $is_space->{$self->{nc}}) {
3039            
3040            $self->{parse_error}->(level => $self->{level}->{must}, type => 'comment end space'); # XXX error type
3041            $self->{ct}->{data} .= '--' . chr ($self->{nc}); # comment
3042            $self->{state} = COMMENT_END_SPACE_STATE;
3043            
3044        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
3045          $self->{line_prev} = $self->{line};
3046          $self->{column_prev} = $self->{column};
3047          $self->{column}++;
3048          $self->{nc}
3049              = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
3050        } else {
3051          $self->{set_nc}->($self);
3052        }
3053      
3054            redo A;
3055          } elsif ($self->{state} != COMMENT_END_BANG_STATE and
3056                   $self->{nc} == 0x0021) { # !
3057            
3058            $self->{parse_error}->(level => $self->{level}->{must}, type => 'comment end bang'); # XXX error type
3059            $self->{state} = COMMENT_END_BANG_STATE;
3060                    
3061      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
3062        $self->{line_prev} = $self->{line};        $self->{line_prev} = $self->{line};
# Line 2957  sub _get_next_token ($) { Line 3079  sub _get_next_token ($) {
3079            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
3080            $self->{s_kwd} = '';            $self->{s_kwd} = '';
3081          }          }
3082          ## reconsume          ## Reconsume.
3083    
3084          return  ($self->{ct}); # comment          return  ($self->{ct}); # comment
3085    
3086          redo A;          redo A;
3087        } else {        } else {
3088                    
3089          ## XML5: Not a parse error.          if ($self->{state} == COMMENT_END_BANG_STATE) {
3090          $self->{parse_error}->(level => $self->{level}->{must}, type => 'dash in comment',            $self->{ct}->{data} .= '--!' . chr ($self->{nc}); # comment
3091                          line => $self->{line_prev},          } else {
3092                          column => $self->{column_prev});            $self->{ct}->{data} .= '--' . chr ($self->{nc}); # comment
3093          $self->{ct}->{data} .= '--' . chr ($self->{nc}); # comment          }
3094          $self->{state} = COMMENT_STATE;          $self->{state} = COMMENT_STATE;
3095                    
3096      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
# Line 2983  sub _get_next_token ($) { Line 3105  sub _get_next_token ($) {
3105        
3106          redo A;          redo A;
3107        }        }
3108        } elsif ($self->{state} == COMMENT_END_SPACE_STATE) {
3109          ## XML5: Not exist.
3110    
3111          if ($self->{nc} == 0x003E) { # >
3112            if ($self->{in_subset}) {
3113              
3114              $self->{state} = DOCTYPE_INTERNAL_SUBSET_STATE;
3115            } else {
3116              
3117              $self->{state} = DATA_STATE;
3118              $self->{s_kwd} = '';
3119            }
3120            
3121        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
3122          $self->{line_prev} = $self->{line};
3123          $self->{column_prev} = $self->{column};
3124          $self->{column}++;
3125          $self->{nc}
3126              = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
3127        } else {
3128          $self->{set_nc}->($self);
3129        }
3130      
3131    
3132            return  ($self->{ct}); # comment
3133    
3134            redo A;
3135          } elsif ($is_space->{$self->{nc}}) {
3136            
3137            $self->{ct}->{data} .= chr ($self->{nc}); # comment
3138            ## Stay in the state.
3139            
3140        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
3141          $self->{line_prev} = $self->{line};
3142          $self->{column_prev} = $self->{column};
3143          $self->{column}++;
3144          $self->{nc}
3145              = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
3146        } else {
3147          $self->{set_nc}->($self);
3148        }
3149      
3150            redo A;
3151          } elsif ($self->{nc} == -1) {
3152            $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed comment');
3153            if ($self->{in_subset}) {
3154              
3155              $self->{state} = DOCTYPE_INTERNAL_SUBSET_STATE;
3156            } else {
3157              
3158              $self->{state} = DATA_STATE;
3159              $self->{s_kwd} = '';
3160            }
3161            ## Reconsume.
3162    
3163            return  ($self->{ct}); # comment
3164    
3165            redo A;
3166          } else {
3167            
3168            $self->{ct}->{data} .= chr ($self->{nc}); # comment
3169            $self->{state} = COMMENT_STATE;
3170            
3171        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
3172          $self->{line_prev} = $self->{line};
3173          $self->{column_prev} = $self->{column};
3174          $self->{column}++;
3175          $self->{nc}
3176              = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
3177        } else {
3178          $self->{set_nc}->($self);
3179        }
3180      
3181            redo A;
3182          }
3183      } elsif ($self->{state} == DOCTYPE_STATE) {      } elsif ($self->{state} == DOCTYPE_STATE) {
3184        if ($is_space->{$self->{nc}}) {        if ($is_space->{$self->{nc}}) {
3185                    
# Line 2999  sub _get_next_token ($) { Line 3196  sub _get_next_token ($) {
3196      }      }
3197        
3198          redo A;          redo A;
3199          } elsif ($self->{nc} == -1) {
3200            
3201            $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed DOCTYPE');
3202            $self->{ct}->{quirks} = 1;
3203    
3204            $self->{state} = DATA_STATE;
3205            ## Reconsume.
3206            return  ($self->{ct}); # DOCTYPE (quirks)
3207    
3208            redo A;
3209        } else {        } else {
3210                    
3211          ## XML5: Unless EOF, swith to the bogus comment state.          ## XML5: Swith to the bogus comment state.
3212          $self->{parse_error}->(level => $self->{level}->{must}, type => 'no space before DOCTYPE name');          $self->{parse_error}->(level => $self->{level}->{must}, type => 'no space before DOCTYPE name');
3213          $self->{state} = BEFORE_DOCTYPE_NAME_STATE;          $self->{state} = BEFORE_DOCTYPE_NAME_STATE;
3214          ## reconsume          ## reconsume
# Line 3046  sub _get_next_token ($) { Line 3253  sub _get_next_token ($) {
3253          return  ($self->{ct}); # DOCTYPE (quirks)          return  ($self->{ct}); # DOCTYPE (quirks)
3254    
3255          redo A;          redo A;
3256          } elsif (0x0041 <= $self->{nc} and $self->{nc} <= 0x005A) { # A..Z
3257            
3258            $self->{ct}->{name} # DOCTYPE
3259                = chr ($self->{nc} + ($self->{is_xml} ? 0 : 0x0020));
3260            delete $self->{ct}->{quirks};
3261            $self->{state} = DOCTYPE_NAME_STATE;
3262            
3263        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
3264          $self->{line_prev} = $self->{line};
3265          $self->{column_prev} = $self->{column};
3266          $self->{column}++;
3267          $self->{nc}
3268              = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
3269        } else {
3270          $self->{set_nc}->($self);
3271        }
3272      
3273            redo A;
3274        } elsif ($self->{nc} == -1) {        } elsif ($self->{nc} == -1) {
3275                    
3276          $self->{parse_error}->(level => $self->{level}->{must}, type => 'no DOCTYPE name');          $self->{parse_error}->(level => $self->{level}->{must}, type => 'no DOCTYPE name');
# Line 3132  sub _get_next_token ($) { Line 3357  sub _get_next_token ($) {
3357          return  ($self->{ct}); # DOCTYPE          return  ($self->{ct}); # DOCTYPE
3358    
3359          redo A;          redo A;
3360          } elsif (0x0041 <= $self->{nc} and $self->{nc} <= 0x005A) { # A..Z
3361            
3362            $self->{ct}->{name} # DOCTYPE
3363                .= chr ($self->{nc} + ($self->{is_xml} ? 0 : 0x0020));
3364            delete $self->{ct}->{quirks};
3365            ## Stay in the state.
3366            
3367        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
3368          $self->{line_prev} = $self->{line};
3369          $self->{column_prev} = $self->{column};
3370          $self->{column}++;
3371          $self->{nc}
3372              = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
3373        } else {
3374          $self->{set_nc}->($self);
3375        }
3376      
3377            redo A;
3378        } elsif ($self->{nc} == -1) {        } elsif ($self->{nc} == -1) {
3379                    
3380          $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed DOCTYPE');          $self->{parse_error}->(level => $self->{level}->{must}, type => 'unclosed DOCTYPE');
# Line 3163  sub _get_next_token ($) { Line 3406  sub _get_next_token ($) {
3406          redo A;          redo A;
3407        } else {        } else {
3408                    
3409          $self->{ct}->{name}          $self->{ct}->{name} .= chr ($self->{nc}); # DOCTYPE
3410            .= chr ($self->{nc}); # DOCTYPE          ## Stay in the state.
         ## Stay in the state  
3411                    
3412      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
3413        $self->{line_prev} = $self->{line};        $self->{line_prev} = $self->{line};
# Line 4628  sub _get_next_token ($) { Line 4870  sub _get_next_token ($) {
4870              0x003C => 1, 0x0026 => 1, -1 => 1, # <, &              0x003C => 1, 0x0026 => 1, -1 => 1, # <, &
4871              $self->{entity_add} => 1,              $self->{entity_add} => 1,
4872            }->{$self->{nc}}) {            }->{$self->{nc}}) {
4873                    if ($self->{is_xml}) {
4874              
4875              $self->{parse_error}->(level => $self->{level}->{must}, type => 'bare ero',
4876                              line => $self->{line_prev},
4877                              column => $self->{column_prev}
4878                                  + ($self->{nc} == -1 ? 1 : 0));
4879            } else {
4880              
4881              ## No error
4882            }
4883          ## Don't consume          ## Don't consume
         ## No error  
4884          ## Return nothing.          ## Return nothing.
4885          #          #
4886        } elsif ($self->{nc} == 0x0023) { # #        } elsif ($self->{nc} == 0x0023) { # #
# Line 4649  sub _get_next_token ($) { Line 4899  sub _get_next_token ($) {
4899      }      }
4900        
4901          redo A;          redo A;
4902        } elsif ((0x0041 <= $self->{nc} and        } elsif ($self->{is_xml} or
4903                   (0x0041 <= $self->{nc} and
4904                  $self->{nc} <= 0x005A) or # A..Z                  $self->{nc} <= 0x005A) or # A..Z
4905                 (0x0061 <= $self->{nc} and                 (0x0061 <= $self->{nc} and
4906                  $self->{nc} <= 0x007A)) { # a..z                  $self->{nc} <= 0x007A)) { # a..z
# Line 4703  sub _get_next_token ($) { Line 4954  sub _get_next_token ($) {
4954          redo A;          redo A;
4955        }        }
4956      } elsif ($self->{state} == ENTITY_HASH_STATE) {      } elsif ($self->{state} == ENTITY_HASH_STATE) {
4957        if ($self->{nc} == 0x0078 or # x        if ($self->{nc} == 0x0078) { # x
           $self->{nc} == 0x0058) { # X  
4958                    
4959          $self->{state} = HEXREF_X_STATE;          $self->{state} = HEXREF_X_STATE;
4960          $self->{kwd} .= chr $self->{nc};          $self->{kwd} .= chr $self->{nc};
# Line 4720  sub _get_next_token ($) { Line 4970  sub _get_next_token ($) {
4970      }      }
4971        
4972          redo A;          redo A;
4973          } elsif ($self->{nc} == 0x0058) { # X
4974            
4975            if ($self->{is_xml}) {
4976              $self->{parse_error}->(level => $self->{level}->{must}, type => 'uppercase hcro'); ## TODO: type
4977            }
4978            $self->{state} = HEXREF_X_STATE;
4979            $self->{kwd} .= chr $self->{nc};
4980            
4981        if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
4982          $self->{line_prev} = $self->{line};
4983          $self->{column_prev} = $self->{column};
4984          $self->{column}++;
4985          $self->{nc}
4986              = ord substr ($self->{char_buffer}, $self->{char_buffer_pos}++, 1);
4987        } else {
4988          $self->{set_nc}->($self);
4989        }
4990      
4991            redo A;
4992        } elsif (0x0030 <= $self->{nc} and        } elsif (0x0030 <= $self->{nc} and
4993                 $self->{nc} <= 0x0039) { # 0..9                 $self->{nc} <= 0x0039) { # 0..9
4994                    
# Line 4810  sub _get_next_token ($) { Line 5079  sub _get_next_token ($) {
5079        my $code = $self->{kwd};        my $code = $self->{kwd};
5080        my $l = $self->{line_prev};        my $l = $self->{line_prev};
5081        my $c = $self->{column_prev};        my $c = $self->{column_prev};
5082        if ($charref_map->{$code}) {        if ((not $self->{is_xml} and $charref_map->{$code}) or
5083              ($self->{is_xml} and 0xD800 <= $code and $code <= 0xDFFF) or
5084              ($self->{is_xml} and $code == 0x0000)) {
5085                    
5086          $self->{parse_error}->(level => $self->{level}->{must}, type => 'invalid character reference',          $self->{parse_error}->(level => $self->{level}->{must}, type => 'invalid character reference',
5087                          text => (sprintf 'U+%04X', $code),                          text => (sprintf 'U+%04X', $code),
# Line 4963  sub _get_next_token ($) { Line 5234  sub _get_next_token ($) {
5234        my $code = $self->{kwd};        my $code = $self->{kwd};
5235        my $l = $self->{line_prev};        my $l = $self->{line_prev};
5236        my $c = $self->{column_prev};        my $c = $self->{column_prev};
5237        if ($charref_map->{$code}) {        if ((not $self->{is_xml} and $charref_map->{$code}) or
5238              ($self->{is_xml} and 0xD800 <= $code and $code <= 0xDFFF) or
5239              ($self->{is_xml} and $code == 0x0000)) {
5240                    
5241          $self->{parse_error}->(level => $self->{level}->{must}, type => 'invalid character reference',          $self->{parse_error}->(level => $self->{level}->{must}, type => 'invalid character reference',
5242                          text => (sprintf 'U+%04X', $code),                          text => (sprintf 'U+%04X', $code),
# Line 4997  sub _get_next_token ($) { Line 5270  sub _get_next_token ($) {
5270          redo A;          redo A;
5271        }        }
5272      } elsif ($self->{state} == ENTITY_NAME_STATE) {      } elsif ($self->{state} == ENTITY_NAME_STATE) {
5273        if (length $self->{kwd} < 30 and        if ((0x0041 <= $self->{nc} and # a
5274            ## NOTE: Some number greater than the maximum length of entity name             $self->{nc} <= 0x005A) or # x
5275            ((0x0041 <= $self->{nc} and # a            (0x0061 <= $self->{nc} and # a
5276              $self->{nc} <= 0x005A) or # x             $self->{nc} <= 0x007A) or # z
5277             (0x0061 <= $self->{nc} and # a            (0x0030 <= $self->{nc} and # 0
5278              $self->{nc} <= 0x007A) or # z             $self->{nc} <= 0x0039) or # 9
5279             (0x0030 <= $self->{nc} and # 0            $self->{nc} == 0x003B or # ;
5280              $self->{nc} <= 0x0039) or # 9            ($self->{is_xml} and
5281             $self->{nc} == 0x003B)) { # ;             not ($is_space->{$self->{nc}} or
5282                    {
5283                      0x003C => 1, 0x0026 => 1, -1 => 1, # <, &
5284                      $self->{entity_add} => 1,
5285                    }->{$self->{nc}}))) {
5286          our $EntityChar;          our $EntityChar;
5287          $self->{kwd} .= chr $self->{nc};          $self->{kwd} .= chr $self->{nc};
5288          if (defined $EntityChar->{$self->{kwd}}) {          if (defined $EntityChar->{$self->{kwd}} or
5289                $self->{ge}->{$self->{kwd}}) {
5290            if ($self->{nc} == 0x003B) { # ;            if ($self->{nc} == 0x003B) { # ;
5291                            if (defined $self->{ge}->{$self->{kwd}}) {
5292              $self->{entity__value} = $EntityChar->{$self->{kwd}};                if ($self->{ge}->{$self->{kwd}}->{only_text}) {
5293                    
5294                    $self->{entity__value} = $self->{ge}->{$self->{kwd}}->{value};
5295                  } else {
5296                    if (defined $self->{ge}->{$self->{kwd}}->{notation}) {
5297                      
5298                      $self->{parse_error}->(level => $self->{level}->{must}, type => 'unparsed entity', ## TODO: type
5299                                      value => $self->{kwd});
5300                    } else {
5301                      
5302                    }
5303                    $self->{entity__value} = '&' . $self->{kwd}; ## TODO: expand
5304                  }
5305                } else {
5306                  if ($self->{is_xml}) {
5307                    
5308                    $self->{parse_error}->(level => $self->{level}->{must}, type => 'entity not declared', ## TODO: type
5309                                    value => $self->{kwd},
5310                                    level => {
5311                                              'amp;' => $self->{level}->{warn},
5312                                              'quot;' => $self->{level}->{warn},
5313                                              'lt;' => $self->{level}->{warn},
5314                                              'gt;' => $self->{level}->{warn},
5315                                              'apos;' => $self->{level}->{warn},
5316                                             }->{$self->{kwd}} ||
5317                                             $self->{level}->{must});
5318                  } else {
5319                    
5320                  }
5321                  $self->{entity__value} = $EntityChar->{$self->{kwd}};
5322                }
5323              $self->{entity__match} = 1;              $self->{entity__match} = 1;
5324                            
5325      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
# Line 5407  sub _get_next_token ($) { Line 5715  sub _get_next_token ($) {
5715          ## XML5: Not defined yet.          ## XML5: Not defined yet.
5716    
5717          ## TODO:          ## TODO:
5718    
5719            if (not $self->{stop_processing} and
5720                not $self->{document}->xml_standalone) {
5721              $self->{parse_error}->(level => $self->{level}->{must}, type => 'stop processing', ## TODO: type
5722                              level => $self->{level}->{info});
5723              $self->{stop_processing} = 1;
5724            }
5725    
5726                    
5727      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
5728        $self->{line_prev} = $self->{line};        $self->{line_prev} = $self->{line};
# Line 5841  sub _get_next_token ($) { Line 6157  sub _get_next_token ($) {
6157          }          }
6158          $self->{ct} = {type => ELEMENT_TOKEN, name => '',          $self->{ct} = {type => ELEMENT_TOKEN, name => '',
6159                         line => $self->{line_prev},                         line => $self->{line_prev},
6160                         column => $self->{column_prev} - 6};                         column => $self->{column_prev} - 7};
6161          $self->{state} = DOCTYPE_MD_STATE;          $self->{state} = DOCTYPE_MD_STATE;
6162                    
6163      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
# Line 5909  sub _get_next_token ($) { Line 6225  sub _get_next_token ($) {
6225          $self->{ct} = {type => ATTLIST_TOKEN, name => '',          $self->{ct} = {type => ATTLIST_TOKEN, name => '',
6226                         attrdefs => [],                         attrdefs => [],
6227                         line => $self->{line_prev},                         line => $self->{line_prev},
6228                         column => $self->{column_prev} - 6};                         column => $self->{column_prev} - 7};
6229          $self->{state} = DOCTYPE_MD_STATE;          $self->{state} = DOCTYPE_MD_STATE;
6230                    
6231      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
# Line 5978  sub _get_next_token ($) { Line 6294  sub _get_next_token ($) {
6294          }          }
6295          $self->{ct} = {type => NOTATION_TOKEN, name => '',          $self->{ct} = {type => NOTATION_TOKEN, name => '',
6296                         line => $self->{line_prev},                         line => $self->{line_prev},
6297                         column => $self->{column_prev} - 6};                         column => $self->{column_prev} - 8};
6298          $self->{state} = DOCTYPE_MD_STATE;          $self->{state} = DOCTYPE_MD_STATE;
6299                    
6300      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {      if ($self->{char_buffer_pos} < length $self->{char_buffer}) {
# Line 7840  sub _get_next_token ($) { Line 8156  sub _get_next_token ($) {
8156          redo A;          redo A;
8157        }        }
8158      } elsif ($self->{state} == ENTITY_VALUE_ENTITY_STATE) {      } elsif ($self->{state} == ENTITY_VALUE_ENTITY_STATE) {
       ## TODO: XMLize  
   
8159        if ($is_space->{$self->{nc}} or        if ($is_space->{$self->{nc}} or
8160            {            {
8161              0x003C => 1, 0x0026 => 1, -1 => 1, # <, &              0x003C => 1, 0x0026 => 1, -1 => 1, # <, &
8162              $self->{entity_add} => 1,              $self->{entity_add} => 1,
8163            }->{$self->{nc}}) {            }->{$self->{nc}}) {
8164            $self->{parse_error}->(level => $self->{level}->{must}, type => 'bare ero',
8165                            line => $self->{line_prev},
8166                            column => $self->{column_prev}
8167                                + ($self->{nc} == -1 ? 1 : 0));
8168          ## Don't consume          ## Don't consume
         ## No error  
8169          ## Return nothing.          ## Return nothing.
8170          #          #
8171        } elsif ($self->{nc} == 0x0023) { # #        } elsif ($self->{nc} == 0x0023) { # #
# Line 7867  sub _get_next_token ($) { Line 8184  sub _get_next_token ($) {
8184      }      }
8185        
8186          redo A;          redo A;
       } elsif ((0x0041 <= $self->{nc} and  
                 $self->{nc} <= 0x005A) or # A..Z  
                (0x0061 <= $self->{nc} and  
                 $self->{nc} <= 0x007A)) { # a..z  
         #  
8187        } else {        } else {
         $self->{parse_error}->(level => $self->{level}->{must}, type => 'bare ero');  
         ## Return nothing.  
8188          #          #
8189        }        }
8190    
Legend:
Removed from v.1.20  
changed lines
  Added in v.1.33
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24