Parent Directory
| 
Revision Log
| 
Patch
| revision 1.57 by wakaba, Sat Aug 11 08:08:12 2007 UTC | revision 1.157 by wakaba, Sun Aug 31 09:12:30 2008 UTC | |
|---|---|---|
| # | Line 1 | Line 1 |
| 1 | package Whatpm::HTML; | package Whatpm::HTML; |
| 2 | use strict; | use strict; |
| 3 | our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; | our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
| 4 | use Error qw(:try); | |
| 5 | ||
| 6 | ## ISSUE: | ## ISSUE: |
| 7 | ## var doc = implementation.createDocument (null, null, null); | ## var doc = implementation.createDocument (null, null, null); |
| 8 | ## doc.write (''); | ## doc.write (''); |
| 9 | ## alert (doc.compatMode); | ## alert (doc.compatMode); |
| 10 | ||
| 11 | ## ISSUE: HTML5 revision 967 says that the encoding layer MUST NOT | require IO::Handle; |
| 12 | ## strip BOM and the HTML layer MUST ignore it. Whether we can do it | |
| 13 | ## is not yet clear. | my $HTML_NS = q<http://www.w3.org/1999/xhtml>; |
| 14 | ## "{U+FEFF}..." in UTF-16BE/UTF-16LE is three or four characters? | my $MML_NS = q<http://www.w3.org/1998/Math/MathML>; |
| 15 | ## "{U+FEFF}..." in GB18030? | my $SVG_NS = q<http://www.w3.org/2000/svg>; |
| 16 | my $XLINK_NS = q<http://www.w3.org/1999/xlink>; | |
| 17 | my $permitted_slash_tag_name = { | my $XML_NS = q<http://www.w3.org/XML/1998/namespace>; |
| 18 | base => 1, | my $XMLNS_NS = q<http://www.w3.org/2000/xmlns/>; |
| 19 | link => 1, | |
| 20 | meta => 1, | sub A_EL () { 0b1 } |
| 21 | hr => 1, | sub ADDRESS_EL () { 0b10 } |
| 22 | br => 1, | sub BODY_EL () { 0b100 } |
| 23 | img=> 1, | sub BUTTON_EL () { 0b1000 } |
| 24 | embed => 1, | sub CAPTION_EL () { 0b10000 } |
| 25 | param => 1, | sub DD_EL () { 0b100000 } |
| 26 | area => 1, | sub DIV_EL () { 0b1000000 } |
| 27 | col => 1, | sub DT_EL () { 0b10000000 } |
| 28 | input => 1, | sub FORM_EL () { 0b100000000 } |
| 29 | sub FORMATTING_EL () { 0b1000000000 } | |
| 30 | sub FRAMESET_EL () { 0b10000000000 } | |
| 31 | sub HEADING_EL () { 0b100000000000 } | |
| 32 | sub HTML_EL () { 0b1000000000000 } | |
| 33 | sub LI_EL () { 0b10000000000000 } | |
| 34 | sub NOBR_EL () { 0b100000000000000 } | |
| 35 | sub OPTION_EL () { 0b1000000000000000 } | |
| 36 | sub OPTGROUP_EL () { 0b10000000000000000 } | |
| 37 | sub P_EL () { 0b100000000000000000 } | |
| 38 | sub SELECT_EL () { 0b1000000000000000000 } | |
| 39 | sub TABLE_EL () { 0b10000000000000000000 } | |
| 40 | sub TABLE_CELL_EL () { 0b100000000000000000000 } | |
| 41 | sub TABLE_ROW_EL () { 0b1000000000000000000000 } | |
| 42 | sub TABLE_ROW_GROUP_EL () { 0b10000000000000000000000 } | |
| 43 | sub MISC_SCOPING_EL () { 0b100000000000000000000000 } | |
| 44 | sub MISC_SPECIAL_EL () { 0b1000000000000000000000000 } | |
| 45 | sub FOREIGN_EL () { 0b10000000000000000000000000 } | |
| 46 | sub FOREIGN_FLOW_CONTENT_EL () { 0b100000000000000000000000000 } | |
| 47 | sub MML_AXML_EL () { 0b1000000000000000000000000000 } | |
| 48 | sub RUBY_EL () { 0b10000000000000000000000000000 } | |
| 49 | sub RUBY_COMPONENT_EL () { 0b100000000000000000000000000000 } | |
| 50 | ||
| 51 | sub TABLE_ROWS_EL () { | |
| 52 | TABLE_EL | | |
| 53 | TABLE_ROW_EL | | |
| 54 | TABLE_ROW_GROUP_EL | |
| 55 | } | |
| 56 | ||
| 57 | ## NOTE: Used in "generate implied end tags" algorithm. | |
| 58 | ## NOTE: There is a code where a modified version of END_TAG_OPTIONAL_EL | |
| 59 | ## is used in "generate implied end tags" implementation (search for the | |
| 60 | ## function mae). | |
| 61 | sub END_TAG_OPTIONAL_EL () { | |
| 62 | DD_EL | | |
| 63 | DT_EL | | |
| 64 | LI_EL | | |
| 65 | P_EL | | |
| 66 | RUBY_COMPONENT_EL | |
| 67 | } | |
| 68 | ||
| 69 | ## NOTE: Used in </body> and EOF algorithms. | |
| 70 | sub ALL_END_TAG_OPTIONAL_EL () { | |
| 71 | DD_EL | | |
| 72 | DT_EL | | |
| 73 | LI_EL | | |
| 74 | P_EL | | |
| 75 | ||
| 76 | BODY_EL | | |
| 77 | HTML_EL | | |
| 78 | TABLE_CELL_EL | | |
| 79 | TABLE_ROW_EL | | |
| 80 | TABLE_ROW_GROUP_EL | |
| 81 | } | |
| 82 | ||
| 83 | sub SCOPING_EL () { | |
| 84 | BUTTON_EL | | |
| 85 | CAPTION_EL | | |
| 86 | HTML_EL | | |
| 87 | TABLE_EL | | |
| 88 | TABLE_CELL_EL | | |
| 89 | MISC_SCOPING_EL | |
| 90 | } | |
| 91 | ||
| 92 | sub TABLE_SCOPING_EL () { | |
| 93 | HTML_EL | | |
| 94 | TABLE_EL | |
| 95 | } | |
| 96 | ||
| 97 | sub TABLE_ROWS_SCOPING_EL () { | |
| 98 | HTML_EL | | |
| 99 | TABLE_ROW_GROUP_EL | |
| 100 | } | |
| 101 | ||
| 102 | sub TABLE_ROW_SCOPING_EL () { | |
| 103 | HTML_EL | | |
| 104 | TABLE_ROW_EL | |
| 105 | } | |
| 106 | ||
| 107 | sub SPECIAL_EL () { | |
| 108 | ADDRESS_EL | | |
| 109 | BODY_EL | | |
| 110 | DIV_EL | | |
| 111 | ||
| 112 | DD_EL | | |
| 113 | DT_EL | | |
| 114 | LI_EL | | |
| 115 | P_EL | | |
| 116 | ||
| 117 | FORM_EL | | |
| 118 | FRAMESET_EL | | |
| 119 | HEADING_EL | | |
| 120 | OPTION_EL | | |
| 121 | OPTGROUP_EL | | |
| 122 | SELECT_EL | | |
| 123 | TABLE_ROW_EL | | |
| 124 | TABLE_ROW_GROUP_EL | | |
| 125 | MISC_SPECIAL_EL | |
| 126 | } | |
| 127 | ||
| 128 | my $el_category = { | |
| 129 | a => A_EL | FORMATTING_EL, | |
| 130 | address => ADDRESS_EL, | |
| 131 | applet => MISC_SCOPING_EL, | |
| 132 | area => MISC_SPECIAL_EL, | |
| 133 | b => FORMATTING_EL, | |
| 134 | base => MISC_SPECIAL_EL, | |
| 135 | basefont => MISC_SPECIAL_EL, | |
| 136 | bgsound => MISC_SPECIAL_EL, | |
| 137 | big => FORMATTING_EL, | |
| 138 | blockquote => MISC_SPECIAL_EL, | |
| 139 | body => BODY_EL, | |
| 140 | br => MISC_SPECIAL_EL, | |
| 141 | button => BUTTON_EL, | |
| 142 | caption => CAPTION_EL, | |
| 143 | center => MISC_SPECIAL_EL, | |
| 144 | col => MISC_SPECIAL_EL, | |
| 145 | colgroup => MISC_SPECIAL_EL, | |
| 146 | dd => DD_EL, | |
| 147 | dir => MISC_SPECIAL_EL, | |
| 148 | div => DIV_EL, | |
| 149 | dl => MISC_SPECIAL_EL, | |
| 150 | dt => DT_EL, | |
| 151 | em => FORMATTING_EL, | |
| 152 | embed => MISC_SPECIAL_EL, | |
| 153 | fieldset => MISC_SPECIAL_EL, | |
| 154 | font => FORMATTING_EL, | |
| 155 | form => FORM_EL, | |
| 156 | frame => MISC_SPECIAL_EL, | |
| 157 | frameset => FRAMESET_EL, | |
| 158 | h1 => HEADING_EL, | |
| 159 | h2 => HEADING_EL, | |
| 160 | h3 => HEADING_EL, | |
| 161 | h4 => HEADING_EL, | |
| 162 | h5 => HEADING_EL, | |
| 163 | h6 => HEADING_EL, | |
| 164 | head => MISC_SPECIAL_EL, | |
| 165 | hr => MISC_SPECIAL_EL, | |
| 166 | html => HTML_EL, | |
| 167 | i => FORMATTING_EL, | |
| 168 | iframe => MISC_SPECIAL_EL, | |
| 169 | img => MISC_SPECIAL_EL, | |
| 170 | input => MISC_SPECIAL_EL, | |
| 171 | isindex => MISC_SPECIAL_EL, | |
| 172 | li => LI_EL, | |
| 173 | link => MISC_SPECIAL_EL, | |
| 174 | listing => MISC_SPECIAL_EL, | |
| 175 | marquee => MISC_SCOPING_EL, | |
| 176 | menu => MISC_SPECIAL_EL, | |
| 177 | meta => MISC_SPECIAL_EL, | |
| 178 | nobr => NOBR_EL | FORMATTING_EL, | |
| 179 | noembed => MISC_SPECIAL_EL, | |
| 180 | noframes => MISC_SPECIAL_EL, | |
| 181 | noscript => MISC_SPECIAL_EL, | |
| 182 | object => MISC_SCOPING_EL, | |
| 183 | ol => MISC_SPECIAL_EL, | |
| 184 | optgroup => OPTGROUP_EL, | |
| 185 | option => OPTION_EL, | |
| 186 | p => P_EL, | |
| 187 | param => MISC_SPECIAL_EL, | |
| 188 | plaintext => MISC_SPECIAL_EL, | |
| 189 | pre => MISC_SPECIAL_EL, | |
| 190 | rp => RUBY_COMPONENT_EL, | |
| 191 | rt => RUBY_COMPONENT_EL, | |
| 192 | ruby => RUBY_EL, | |
| 193 | s => FORMATTING_EL, | |
| 194 | script => MISC_SPECIAL_EL, | |
| 195 | select => SELECT_EL, | |
| 196 | small => FORMATTING_EL, | |
| 197 | spacer => MISC_SPECIAL_EL, | |
| 198 | strike => FORMATTING_EL, | |
| 199 | strong => FORMATTING_EL, | |
| 200 | style => MISC_SPECIAL_EL, | |
| 201 | table => TABLE_EL, | |
| 202 | tbody => TABLE_ROW_GROUP_EL, | |
| 203 | td => TABLE_CELL_EL, | |
| 204 | textarea => MISC_SPECIAL_EL, | |
| 205 | tfoot => TABLE_ROW_GROUP_EL, | |
| 206 | th => TABLE_CELL_EL, | |
| 207 | thead => TABLE_ROW_GROUP_EL, | |
| 208 | title => MISC_SPECIAL_EL, | |
| 209 | tr => TABLE_ROW_EL, | |
| 210 | tt => FORMATTING_EL, | |
| 211 | u => FORMATTING_EL, | |
| 212 | ul => MISC_SPECIAL_EL, | |
| 213 | wbr => MISC_SPECIAL_EL, | |
| 214 | }; | |
| 215 | ||
| 216 | my $el_category_f = { | |
| 217 | $MML_NS => { | |
| 218 | 'annotation-xml' => MML_AXML_EL, | |
| 219 | mi => FOREIGN_FLOW_CONTENT_EL, | |
| 220 | mo => FOREIGN_FLOW_CONTENT_EL, | |
| 221 | mn => FOREIGN_FLOW_CONTENT_EL, | |
| 222 | ms => FOREIGN_FLOW_CONTENT_EL, | |
| 223 | mtext => FOREIGN_FLOW_CONTENT_EL, | |
| 224 | }, | |
| 225 | $SVG_NS => { | |
| 226 | foreignObject => FOREIGN_FLOW_CONTENT_EL, | |
| 227 | desc => FOREIGN_FLOW_CONTENT_EL, | |
| 228 | title => FOREIGN_FLOW_CONTENT_EL, | |
| 229 | }, | |
| 230 | ## NOTE: In addition, FOREIGN_EL is set to non-HTML elements. | |
| 231 | }; | }; |
| 232 | ||
| 233 | my $svg_attr_name = { | |
| 234 | attributename => 'attributeName', | |
| 235 | attributetype => 'attributeType', | |
| 236 | basefrequency => 'baseFrequency', | |
| 237 | baseprofile => 'baseProfile', | |
| 238 | calcmode => 'calcMode', | |
| 239 | clippathunits => 'clipPathUnits', | |
| 240 | contentscripttype => 'contentScriptType', | |
| 241 | contentstyletype => 'contentStyleType', | |
| 242 | diffuseconstant => 'diffuseConstant', | |
| 243 | edgemode => 'edgeMode', | |
| 244 | externalresourcesrequired => 'externalResourcesRequired', | |
| 245 | filterres => 'filterRes', | |
| 246 | filterunits => 'filterUnits', | |
| 247 | glyphref => 'glyphRef', | |
| 248 | gradienttransform => 'gradientTransform', | |
| 249 | gradientunits => 'gradientUnits', | |
| 250 | kernelmatrix => 'kernelMatrix', | |
| 251 | kernelunitlength => 'kernelUnitLength', | |
| 252 | keypoints => 'keyPoints', | |
| 253 | keysplines => 'keySplines', | |
| 254 | keytimes => 'keyTimes', | |
| 255 | lengthadjust => 'lengthAdjust', | |
| 256 | limitingconeangle => 'limitingConeAngle', | |
| 257 | markerheight => 'markerHeight', | |
| 258 | markerunits => 'markerUnits', | |
| 259 | markerwidth => 'markerWidth', | |
| 260 | maskcontentunits => 'maskContentUnits', | |
| 261 | maskunits => 'maskUnits', | |
| 262 | numoctaves => 'numOctaves', | |
| 263 | pathlength => 'pathLength', | |
| 264 | patterncontentunits => 'patternContentUnits', | |
| 265 | patterntransform => 'patternTransform', | |
| 266 | patternunits => 'patternUnits', | |
| 267 | pointsatx => 'pointsAtX', | |
| 268 | pointsaty => 'pointsAtY', | |
| 269 | pointsatz => 'pointsAtZ', | |
| 270 | preservealpha => 'preserveAlpha', | |
| 271 | preserveaspectratio => 'preserveAspectRatio', | |
| 272 | primitiveunits => 'primitiveUnits', | |
| 273 | refx => 'refX', | |
| 274 | refy => 'refY', | |
| 275 | repeatcount => 'repeatCount', | |
| 276 | repeatdur => 'repeatDur', | |
| 277 | requiredextensions => 'requiredExtensions', | |
| 278 | requiredfeatures => 'requiredFeatures', | |
| 279 | specularconstant => 'specularConstant', | |
| 280 | specularexponent => 'specularExponent', | |
| 281 | spreadmethod => 'spreadMethod', | |
| 282 | startoffset => 'startOffset', | |
| 283 | stddeviation => 'stdDeviation', | |
| 284 | stitchtiles => 'stitchTiles', | |
| 285 | surfacescale => 'surfaceScale', | |
| 286 | systemlanguage => 'systemLanguage', | |
| 287 | tablevalues => 'tableValues', | |
| 288 | targetx => 'targetX', | |
| 289 | targety => 'targetY', | |
| 290 | textlength => 'textLength', | |
| 291 | viewbox => 'viewBox', | |
| 292 | viewtarget => 'viewTarget', | |
| 293 | xchannelselector => 'xChannelSelector', | |
| 294 | ychannelselector => 'yChannelSelector', | |
| 295 | zoomandpan => 'zoomAndPan', | |
| 296 | }; | |
| 297 | ||
| 298 | my $foreign_attr_xname = { | |
| 299 | 'xlink:actuate' => [$XLINK_NS, ['xlink', 'actuate']], | |
| 300 | 'xlink:arcrole' => [$XLINK_NS, ['xlink', 'arcrole']], | |
| 301 | 'xlink:href' => [$XLINK_NS, ['xlink', 'href']], | |
| 302 | 'xlink:role' => [$XLINK_NS, ['xlink', 'role']], | |
| 303 | 'xlink:show' => [$XLINK_NS, ['xlink', 'show']], | |
| 304 | 'xlink:title' => [$XLINK_NS, ['xlink', 'title']], | |
| 305 | 'xlink:type' => [$XLINK_NS, ['xlink', 'type']], | |
| 306 | 'xml:base' => [$XML_NS, ['xml', 'base']], | |
| 307 | 'xml:lang' => [$XML_NS, ['xml', 'lang']], | |
| 308 | 'xml:space' => [$XML_NS, ['xml', 'space']], | |
| 309 | 'xmlns' => [$XMLNS_NS, [undef, 'xmlns']], | |
| 310 | 'xmlns:xlink' => [$XMLNS_NS, ['xmlns', 'xlink']], | |
| 311 | }; | |
| 312 | ||
| 313 | ## ISSUE: xmlns:xlink="non-xlink-ns" is not an error. | |
| 314 | ||
| 315 | my $c1_entity_char = { | my $c1_entity_char = { |
| 316 | 0x80 => 0x20AC, | 0x80 => 0x20AC, |
| 317 | 0x81 => 0xFFFD, | 0x81 => 0xFFFD, |
| # | Line 62 my $c1_entity_char = { | Line 347 my $c1_entity_char = { |
| 347 | 0x9F => 0x0178, | 0x9F => 0x0178, |
| 348 | }; # $c1_entity_char | }; # $c1_entity_char |
| 349 | ||
| 350 | my $special_category = { | sub parse_byte_string ($$$$;$) { |
| 351 | address => 1, area => 1, base => 1, basefont => 1, bgsound => 1, | my $self = shift; |
| 352 | blockquote => 1, body => 1, br => 1, center => 1, col => 1, colgroup => 1, | my $charset_name = shift; |
| 353 | dd => 1, dir => 1, div => 1, dl => 1, dt => 1, embed => 1, fieldset => 1, | open my $input, '<', ref $_[0] ? $_[0] : \($_[0]); |
| 354 | form => 1, frame => 1, frameset => 1, h1 => 1, h2 => 1, h3 => 1, | return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]); |
| 355 | h4 => 1, h5 => 1, h6 => 1, head => 1, hr => 1, iframe => 1, image => 1, | } # parse_byte_string |
| 356 | img => 1, input => 1, isindex => 1, li => 1, link => 1, listing => 1, | |
| 357 | menu => 1, meta => 1, noembed => 1, noframes => 1, noscript => 1, | sub parse_byte_stream ($$$$;$) { |
| 358 | ol => 1, optgroup => 1, option => 1, p => 1, param => 1, plaintext => 1, | my $self = ref $_[0] ? shift : shift->new; |
| 359 | pre => 1, script => 1, select => 1, spacer => 1, style => 1, tbody => 1, | my $charset_name = shift; |
| 360 | textarea => 1, tfoot => 1, thead => 1, title => 1, tr => 1, ul => 1, wbr => 1, | my $byte_stream = $_[0]; |
| }; | ||
| my $scoping_category = { | ||
| button => 1, caption => 1, html => 1, marquee => 1, object => 1, | ||
| table => 1, td => 1, th => 1, | ||
| }; | ||
| my $formatting_category = { | ||
| a => 1, b => 1, big => 1, em => 1, font => 1, i => 1, nobr => 1, | ||
| s => 1, small => 1, strile => 1, strong => 1, tt => 1, u => 1, | ||
| }; | ||
| # $phrasing_category: all other elements | ||
| 361 | ||
| 362 | sub parse_string ($$$;$) { | my $onerror = $_[2] || sub { |
| 363 | my $self = shift->new; | my (%opt) = @_; |
| 364 | my $s = \$_[0]; | warn "Parse error ($opt{type})\n"; |
| 365 | }; | |
| 366 | $self->{parse_error} = $onerror; # updated later by parse_char_string | |
| 367 | ||
| 368 | ## HTML5 encoding sniffing algorithm | |
| 369 | require Message::Charset::Info; | |
| 370 | my $charset; | |
| 371 | my $buffer; | |
| 372 | my ($char_stream, $e_status); | |
| 373 | ||
| 374 | SNIFFING: { | |
| 375 | ||
| 376 | ## Step 1 | |
| 377 | if (defined $charset_name) { | |
| 378 | $charset = Message::Charset::Info->get_by_iana_name ($charset_name); | |
| 379 | ||
| 380 | ## ISSUE: Unsupported encoding is not ignored according to the spec. | |
| 381 | ($char_stream, $e_status) = $charset->get_decode_handle | |
| 382 | ($byte_stream, allow_error_reporting => 1, | |
| 383 | allow_fallback => 1); | |
| 384 | if ($char_stream) { | |
| 385 | $self->{confident} = 1; | |
| 386 | last SNIFFING; | |
| 387 | } else { | |
| 388 | ## TODO: unsupported error | |
| 389 | } | |
| 390 | } | |
| 391 | ||
| 392 | ## Step 2 | |
| 393 | my $byte_buffer = ''; | |
| 394 | for (1..1024) { | |
| 395 | my $char = $byte_stream->getc; | |
| 396 | last unless defined $char; | |
| 397 | $byte_buffer .= $char; | |
| 398 | } ## TODO: timeout | |
| 399 | ||
| 400 | ## Step 3 | |
| 401 | if ($byte_buffer =~ /^\xFE\xFF/) { | |
| 402 | $charset = Message::Charset::Info->get_by_iana_name ('utf-16be'); | |
| 403 | ($char_stream, $e_status) = $charset->get_decode_handle | |
| 404 | ($byte_stream, allow_error_reporting => 1, | |
| 405 | allow_fallback => 1, byte_buffer => \$byte_buffer); | |
| 406 | $self->{confident} = 1; | |
| 407 | last SNIFFING; | |
| 408 | } elsif ($byte_buffer =~ /^\xFF\xFE/) { | |
| 409 | $charset = Message::Charset::Info->get_by_iana_name ('utf-16le'); | |
| 410 | ($char_stream, $e_status) = $charset->get_decode_handle | |
| 411 | ($byte_stream, allow_error_reporting => 1, | |
| 412 | allow_fallback => 1, byte_buffer => \$byte_buffer); | |
| 413 | $self->{confident} = 1; | |
| 414 | last SNIFFING; | |
| 415 | } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) { | |
| 416 | $charset = Message::Charset::Info->get_by_iana_name ('utf-8'); | |
| 417 | ($char_stream, $e_status) = $charset->get_decode_handle | |
| 418 | ($byte_stream, allow_error_reporting => 1, | |
| 419 | allow_fallback => 1, byte_buffer => \$byte_buffer); | |
| 420 | $self->{confident} = 1; | |
| 421 | last SNIFFING; | |
| 422 | } | |
| 423 | ||
| 424 | ## Step 4 | |
| 425 | ## TODO: <meta charset> | |
| 426 | ||
| 427 | ## Step 5 | |
| 428 | ## TODO: from history | |
| 429 | ||
| 430 | ## Step 6 | |
| 431 | require Whatpm::Charset::UniversalCharDet; | |
| 432 | $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string | |
| 433 | ($byte_buffer); | |
| 434 | if (defined $charset_name) { | |
| 435 | $charset = Message::Charset::Info->get_by_iana_name ($charset_name); | |
| 436 | ||
| 437 | ## ISSUE: Unsupported encoding is not ignored according to the spec. | |
| 438 | require Whatpm::Charset::DecodeHandle; | |
| 439 | $buffer = Whatpm::Charset::DecodeHandle::ByteBuffer->new | |
| 440 | ($byte_stream); | |
| 441 | ($char_stream, $e_status) = $charset->get_decode_handle | |
| 442 | ($buffer, allow_error_reporting => 1, | |
| 443 | allow_fallback => 1, byte_buffer => \$byte_buffer); | |
| 444 | if ($char_stream) { | |
| 445 | $buffer->{buffer} = $byte_buffer; | |
| 446 | !!!parse-error (type => 'sniffing:chardet', | |
| 447 | text => $charset_name, | |
| 448 | level => $self->{level}->{info}, | |
| 449 | layer => 'encode', | |
| 450 | line => 1, column => 1); | |
| 451 | $self->{confident} = 0; | |
| 452 | last SNIFFING; | |
| 453 | } | |
| 454 | } | |
| 455 | ||
| 456 | ## Step 7: default | |
| 457 | ## TODO: Make this configurable. | |
| 458 | $charset = Message::Charset::Info->get_by_iana_name ('windows-1252'); | |
| 459 | ## NOTE: We choose |windows-1252| here, since |utf-8| should be | |
| 460 | ## detectable in the step 6. | |
| 461 | require Whatpm::Charset::DecodeHandle; | |
| 462 | $buffer = Whatpm::Charset::DecodeHandle::ByteBuffer->new | |
| 463 | ($byte_stream); | |
| 464 | ($char_stream, $e_status) | |
| 465 | = $charset->get_decode_handle ($buffer, | |
| 466 | allow_error_reporting => 1, | |
| 467 | allow_fallback => 1, | |
| 468 | byte_buffer => \$byte_buffer); | |
| 469 | $buffer->{buffer} = $byte_buffer; | |
| 470 | !!!parse-error (type => 'sniffing:default', | |
| 471 | text => 'windows-1252', | |
| 472 | level => $self->{level}->{info}, | |
| 473 | line => 1, column => 1, | |
| 474 | layer => 'encode'); | |
| 475 | $self->{confident} = 0; | |
| 476 | } # SNIFFING | |
| 477 | ||
| 478 | $self->{input_encoding} = $charset->get_iana_name; | |
| 479 | if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) { | |
| 480 | !!!parse-error (type => 'chardecode:fallback', | |
| 481 | text => $self->{input_encoding}, | |
| 482 | level => $self->{level}->{uncertain}, | |
| 483 | line => 1, column => 1, | |
| 484 | layer => 'encode'); | |
| 485 | } elsif (not ($e_status & | |
| 486 | Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) { | |
| 487 | !!!parse-error (type => 'chardecode:no error', | |
| 488 | text => $self->{input_encoding}, | |
| 489 | level => $self->{level}->{uncertain}, | |
| 490 | line => 1, column => 1, | |
| 491 | layer => 'encode'); | |
| 492 | } | |
| 493 | ||
| 494 | $self->{change_encoding} = sub { | |
| 495 | my $self = shift; | |
| 496 | $charset_name = shift; | |
| 497 | my $token = shift; | |
| 498 | ||
| 499 | $charset = Message::Charset::Info->get_by_iana_name ($charset_name); | |
| 500 | ($char_stream, $e_status) = $charset->get_decode_handle | |
| 501 | ($byte_stream, allow_error_reporting => 1, allow_fallback => 1, | |
| 502 | byte_buffer => \ $buffer->{buffer}); | |
| 503 | ||
| 504 | if ($char_stream) { # if supported | |
| 505 | ## "Change the encoding" algorithm: | |
| 506 | ||
| 507 | ## Step 1 | |
| 508 | if ($charset->{category} & | |
| 509 | Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) { | |
| 510 | $charset = Message::Charset::Info->get_by_iana_name ('utf-8'); | |
| 511 | ($char_stream, $e_status) = $charset->get_decode_handle | |
| 512 | ($byte_stream, | |
| 513 | byte_buffer => \ $buffer->{buffer}); | |
| 514 | } | |
| 515 | $charset_name = $charset->get_iana_name; | |
| 516 | ||
| 517 | ## Step 2 | |
| 518 | if (defined $self->{input_encoding} and | |
| 519 | $self->{input_encoding} eq $charset_name) { | |
| 520 | !!!parse-error (type => 'charset label:matching', | |
| 521 | text => $charset_name, | |
| 522 | level => $self->{level}->{info}); | |
| 523 | $self->{confident} = 1; | |
| 524 | return; | |
| 525 | } | |
| 526 | ||
| 527 | !!!parse-error (type => 'charset label detected', | |
| 528 | text => $self->{input_encoding}, | |
| 529 | value => $charset_name, | |
| 530 | level => $self->{level}->{warn}, | |
| 531 | token => $token); | |
| 532 | ||
| 533 | ## Step 3 | |
| 534 | # if (can) { | |
| 535 | ## change the encoding on the fly. | |
| 536 | #$self->{confident} = 1; | |
| 537 | #return; | |
| 538 | # } | |
| 539 | ||
| 540 | ## Step 4 | |
| 541 | throw Whatpm::HTML::RestartParser (); | |
| 542 | } | |
| 543 | }; # $self->{change_encoding} | |
| 544 | ||
| 545 | my $char_onerror = sub { | |
| 546 | my (undef, $type, %opt) = @_; | |
| 547 | !!!parse-error (layer => 'encode', | |
| 548 | %opt, type => $type, | |
| 549 | line => $self->{line}, column => $self->{column} + 1); | |
| 550 | if ($opt{octets}) { | |
| 551 | ${$opt{octets}} = "\x{FFFD}"; # relacement character | |
| 552 | } | |
| 553 | }; | |
| 554 | $char_stream->onerror ($char_onerror); | |
| 555 | ||
| 556 | my @args = @_; shift @args; # $s | |
| 557 | my $return; | |
| 558 | try { | |
| 559 | $return = $self->parse_char_stream ($char_stream, @args); | |
| 560 | } catch Whatpm::HTML::RestartParser with { | |
| 561 | ## NOTE: Invoked after {change_encoding}. | |
| 562 | ||
| 563 | $self->{input_encoding} = $charset->get_iana_name; | |
| 564 | if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) { | |
| 565 | !!!parse-error (type => 'chardecode:fallback', | |
| 566 | text => $self->{input_encoding}, | |
| 567 | level => $self->{level}->{uncertain}, | |
| 568 | line => 1, column => 1, | |
| 569 | layer => 'encode'); | |
| 570 | } elsif (not ($e_status & | |
| 571 | Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) { | |
| 572 | !!!parse-error (type => 'chardecode:no error', | |
| 573 | text => $self->{input_encoding}, | |
| 574 | level => $self->{level}->{uncertain}, | |
| 575 | line => 1, column => 1, | |
| 576 | layer => 'encode'); | |
| 577 | } | |
| 578 | $self->{confident} = 1; | |
| 579 | $char_stream->onerror ($char_onerror); | |
| 580 | $return = $self->parse_char_stream ($char_stream, @args); | |
| 581 | }; | |
| 582 | return $return; | |
| 583 | } # parse_byte_stream | |
| 584 | ||
| 585 | ## NOTE: HTML5 spec says that the encoding layer MUST NOT strip BOM | |
| 586 | ## and the HTML layer MUST ignore it. However, we does strip BOM in | |
| 587 | ## the encoding layer and the HTML layer does not ignore any U+FEFF, | |
| 588 | ## because the core part of our HTML parser expects a string of character, | |
| 589 | ## not a string of bytes or code units or anything which might contain a BOM. | |
| 590 | ## Therefore, any parser interface that accepts a string of bytes, | |
| 591 | ## such as |parse_byte_string| in this module, must ensure that it does | |
| 592 | ## strip the BOM and never strip any ZWNBSP. | |
| 593 | ||
| 594 | sub parse_char_string ($$$;$) { | |
| 595 | my $self = shift; | |
| 596 | require utf8; | |
| 597 | my $s = ref $_[0] ? $_[0] : \($_[0]); | |
| 598 | open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s; | |
| 599 | return $self->parse_char_stream ($input, @_[1..$#_]); | |
| 600 | } # parse_char_string | |
| 601 | *parse_string = \&parse_char_string; | |
| 602 | ||
| 603 | sub parse_char_stream ($$$;$) { | |
| 604 | my $self = ref $_[0] ? shift : shift->new; | |
| 605 | my $input = $_[0]; | |
| 606 | $self->{document} = $_[1]; | $self->{document} = $_[1]; |
| 607 | @{$self->{document}->child_nodes} = (); | |
| 608 | ||
| 609 | ## NOTE: |set_inner_html| copies most of this method's code | ## NOTE: |set_inner_html| copies most of this method's code |
| 610 | ||
| 611 | $self->{confident} = 1 unless exists $self->{confident}; | |
| 612 | $self->{document}->input_encoding ($self->{input_encoding}) | |
| 613 | if defined $self->{input_encoding}; | |
| 614 | ||
| 615 | my $i = 0; | my $i = 0; |
| 616 | my $line = 1; | $self->{line_prev} = $self->{line} = 1; |
| 617 | my $column = 0; | $self->{column_prev} = $self->{column} = 0; |
| 618 | $self->{set_next_input_character} = sub { | $self->{set_next_char} = sub { |
| 619 | my $self = shift; | my $self = shift; |
| 620 | ||
| 621 | pop @{$self->{prev_input_character}}; | pop @{$self->{prev_char}}; |
| 622 | unshift @{$self->{prev_input_character}}, $self->{next_input_character}; | unshift @{$self->{prev_char}}, $self->{next_char}; |
| 623 | ||
| 624 | my $char; | |
| 625 | if (defined $self->{next_next_char}) { | |
| 626 | $char = $self->{next_next_char}; | |
| 627 | delete $self->{next_next_char}; | |
| 628 | } else { | |
| 629 | $char = $input->getc; | |
| 630 | } | |
| 631 | $self->{next_char} = -1 and return unless defined $char; | |
| 632 | $self->{next_char} = ord $char; | |
| 633 | ||
| 634 | $self->{next_input_character} = -1 and return if $i >= length $$s; | ($self->{line_prev}, $self->{column_prev}) |
| 635 | $self->{next_input_character} = ord substr $$s, $i++, 1; | = ($self->{line}, $self->{column}); |
| 636 | $column++; | $self->{column}++; |
| 637 | ||
| 638 | if ($self->{next_input_character} == 0x000A) { # LF | if ($self->{next_char} == 0x000A) { # LF |
| 639 | $line++; | !!!cp ('j1'); |
| 640 | $column = 0; | $self->{line}++; |
| 641 | } elsif ($self->{next_input_character} == 0x000D) { # CR | $self->{column} = 0; |
| 642 | $i++ if substr ($$s, $i, 1) eq "\x0A"; | } elsif ($self->{next_char} == 0x000D) { # CR |
| 643 | $self->{next_input_character} = 0x000A; # LF # MUST | !!!cp ('j2'); |
| 644 | $line++; | my $next = $input->getc; |
| 645 | $column = 0; | if (defined $next and $next ne "\x0A") { |
| 646 | } elsif ($self->{next_input_character} > 0x10FFFF) { | $self->{next_next_char} = $next; |
| 647 | $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST | } |
| 648 | } elsif ($self->{next_input_character} == 0x0000) { # NULL | $self->{next_char} = 0x000A; # LF # MUST |
| 649 | $self->{line}++; | |
| 650 | $self->{column} = 0; | |
| 651 | } elsif ($self->{next_char} > 0x10FFFF) { | |
| 652 | !!!cp ('j3'); | |
| 653 | $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST | |
| 654 | } elsif ($self->{next_char} == 0x0000) { # NULL | |
| 655 | !!!cp ('j4'); | |
| 656 | !!!parse-error (type => 'NULL'); | !!!parse-error (type => 'NULL'); |
| 657 | $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST | $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST |
| 658 | } elsif ($self->{next_char} <= 0x0008 or | |
| 659 | (0x000E <= $self->{next_char} and $self->{next_char} <= 0x001F) or | |
| 660 | (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or | |
| 661 | (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or | |
| 662 | (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or | |
| 663 | { | |
| 664 | 0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1, | |
| 665 | 0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1, | |
| 666 | 0x4FFFE => 1, 0x4FFFF => 1, 0x5FFFE => 1, 0x5FFFF => 1, | |
| 667 | 0x6FFFE => 1, 0x6FFFF => 1, 0x7FFFE => 1, 0x7FFFF => 1, | |
| 668 | 0x8FFFE => 1, 0x8FFFF => 1, 0x9FFFE => 1, 0x9FFFF => 1, | |
| 669 | 0xAFFFE => 1, 0xAFFFF => 1, 0xBFFFE => 1, 0xBFFFF => 1, | |
| 670 | 0xCFFFE => 1, 0xCFFFF => 1, 0xDFFFE => 1, 0xDFFFF => 1, | |
| 671 | 0xEFFFE => 1, 0xEFFFF => 1, 0xFFFFE => 1, 0xFFFFF => 1, | |
| 672 | 0x10FFFE => 1, 0x10FFFF => 1, | |
| 673 | }->{$self->{next_char}}) { | |
| 674 | !!!cp ('j5'); | |
| 675 | if ($self->{next_char} < 0x10000) { | |
| 676 | !!!parse-error (type => 'control char', | |
| 677 | text => (sprintf 'U+%04X', $self->{next_char})); | |
| 678 | } else { | |
| 679 | !!!parse-error (type => 'control char', | |
| 680 | text => (sprintf 'U-%08X', $self->{next_char})); | |
| 681 | } | |
| 682 | } | } |
| 683 | }; | }; |
| 684 | $self->{prev_input_character} = [-1, -1, -1]; | $self->{prev_char} = [-1, -1, -1]; |
| 685 | $self->{next_input_character} = -1; | $self->{next_char} = -1; |
| 686 | ||
| 687 | my $onerror = $_[2] || sub { | my $onerror = $_[2] || sub { |
| 688 | my (%opt) = @_; | my (%opt) = @_; |
| 689 | warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n"; | my $line = $opt{token} ? $opt{token}->{line} : $opt{line}; |
| 690 | my $column = $opt{token} ? $opt{token}->{column} : $opt{column}; | |
| 691 | warn "Parse error ($opt{type}) at line $line column $column\n"; | |
| 692 | }; | }; |
| 693 | $self->{parse_error} = sub { | $self->{parse_error} = sub { |
| 694 | $onerror->(@_, line => $line, column => $column); | $onerror->(line => $self->{line}, column => $self->{column}, @_); |
| 695 | }; | }; |
| 696 | ||
| 697 | $self->_initialize_tokenizer; | $self->_initialize_tokenizer; |
| # | Line 135 sub parse_string ($$$;$) { | Line 699 sub parse_string ($$$;$) { |
| 699 | $self->_construct_tree; | $self->_construct_tree; |
| 700 | $self->_terminate_tree_constructor; | $self->_terminate_tree_constructor; |
| 701 | ||
| 702 | delete $self->{parse_error}; # remove loop | |
| 703 | ||
| 704 | return $self->{document}; | return $self->{document}; |
| 705 | } # parse_string | } # parse_char_stream |
| 706 | ||
| 707 | sub new ($) { | sub new ($) { |
| 708 | my $class = shift; | my $class = shift; |
| 709 | my $self = bless {}, $class; | my $self = bless { |
| 710 | $self->{set_next_input_character} = sub { | level => {must => 'm', |
| 711 | $self->{next_input_character} = -1; | warn => 'w', |
| 712 | info => 'i', | |
| 713 | uncertain => 'u'}, | |
| 714 | }, $class; | |
| 715 | $self->{set_next_char} = sub { | |
| 716 | $self->{next_char} = -1; | |
| 717 | }; | }; |
| 718 | $self->{parse_error} = sub { | $self->{parse_error} = sub { |
| 719 | # | # |
| 720 | }; | }; |
| 721 | $self->{change_encoding} = sub { | |
| 722 | # if ($_[0] is a supported encoding) { | |
| 723 | # run "change the encoding" algorithm; | |
| 724 | # throw Whatpm::HTML::RestartParser (charset => $new_encoding); | |
| 725 | # } | |
| 726 | }; | |
| 727 | $self->{application_cache_selection} = sub { | |
| 728 | # | |
| 729 | }; | |
| 730 | return $self; | return $self; |
| 731 | } # new | } # new |
| 732 | ||
| # | Line 192 sub DOCTYPE_SYSTEM_IDENTIFIER_DOUBLE_QUO | Line 772 sub DOCTYPE_SYSTEM_IDENTIFIER_DOUBLE_QUO |
| 772 | sub DOCTYPE_SYSTEM_IDENTIFIER_SINGLE_QUOTED_STATE () { 30 } | sub DOCTYPE_SYSTEM_IDENTIFIER_SINGLE_QUOTED_STATE () { 30 } |
| 773 | sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STATE () { 31 } | sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STATE () { 31 } |
| 774 | sub BOGUS_DOCTYPE_STATE () { 32 } | sub BOGUS_DOCTYPE_STATE () { 32 } |
| 775 | sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 } | |
| 776 | sub SELF_CLOSING_START_TAG_STATE () { 34 } | |
| 777 | sub CDATA_BLOCK_STATE () { 35 } | |
| 778 | ||
| 779 | sub DOCTYPE_TOKEN () { 1 } | sub DOCTYPE_TOKEN () { 1 } |
| 780 | sub COMMENT_TOKEN () { 2 } | sub COMMENT_TOKEN () { 2 } |
| # | Line 208 sub TABLE_IMS () { 0b1000000 } | Line 791 sub TABLE_IMS () { 0b1000000 } |
| 791 | sub ROW_IMS () { 0b10000000 } | sub ROW_IMS () { 0b10000000 } |
| 792 | sub BODY_AFTER_IMS () { 0b100000000 } | sub BODY_AFTER_IMS () { 0b100000000 } |
| 793 | sub FRAME_IMS () { 0b1000000000 } | sub FRAME_IMS () { 0b1000000000 } |
| 794 | sub SELECT_IMS () { 0b10000000000 } | |
| 795 | sub IN_FOREIGN_CONTENT_IM () { 0b100000000000 } | |
| 796 | ## NOTE: "in foreign content" insertion mode is special; it is combined | |
| 797 | ## with the secondary insertion mode. In this parser, they are stored | |
| 798 | ## together in the bit-or'ed form. | |
| 799 | ||
| 800 | ## NOTE: "initial" and "before html" insertion modes have no constants. | |
| 801 | ||
| 802 | ## NOTE: "after after body" insertion mode. | |
| 803 | sub AFTER_HTML_BODY_IM () { AFTER_HTML_IMS | BODY_AFTER_IMS } | sub AFTER_HTML_BODY_IM () { AFTER_HTML_IMS | BODY_AFTER_IMS } |
| 804 | ||
| 805 | ## NOTE: "after after frameset" insertion mode. | |
| 806 | sub AFTER_HTML_FRAMESET_IM () { AFTER_HTML_IMS | FRAME_IMS } | sub AFTER_HTML_FRAMESET_IM () { AFTER_HTML_IMS | FRAME_IMS } |
| 807 | ||
| 808 | sub IN_HEAD_IM () { HEAD_IMS | 0b00 } | sub IN_HEAD_IM () { HEAD_IMS | 0b00 } |
| 809 | sub IN_HEAD_NOSCRIPT_IM () { HEAD_IMS | 0b01 } | sub IN_HEAD_NOSCRIPT_IM () { HEAD_IMS | 0b01 } |
| 810 | sub AFTER_HEAD_IM () { HEAD_IMS | 0b10 } | sub AFTER_HEAD_IM () { HEAD_IMS | 0b10 } |
| # | Line 224 sub IN_TABLE_IM () { TABLE_IMS } | Line 818 sub IN_TABLE_IM () { TABLE_IMS } |
| 818 | sub AFTER_BODY_IM () { BODY_AFTER_IMS } | sub AFTER_BODY_IM () { BODY_AFTER_IMS } |
| 819 | sub IN_FRAMESET_IM () { FRAME_IMS | 0b01 } | sub IN_FRAMESET_IM () { FRAME_IMS | 0b01 } |
| 820 | sub AFTER_FRAMESET_IM () { FRAME_IMS | 0b10 } | sub AFTER_FRAMESET_IM () { FRAME_IMS | 0b10 } |
| 821 | sub IN_SELECT_IM () { 0b01 } | sub IN_SELECT_IM () { SELECT_IMS | 0b01 } |
| 822 | sub IN_SELECT_IN_TABLE_IM () { SELECT_IMS | 0b10 } | |
| 823 | sub IN_COLUMN_GROUP_IM () { 0b10 } | sub IN_COLUMN_GROUP_IM () { 0b10 } |
| 824 | ||
| 825 | ## Implementations MUST act as if state machine in the spec | ## Implementations MUST act as if state machine in the spec |
| # | Line 237 sub _initialize_tokenizer ($) { | Line 832 sub _initialize_tokenizer ($) { |
| 832 | undef $self->{current_attribute}; | undef $self->{current_attribute}; |
| 833 | undef $self->{last_emitted_start_tag_name}; | undef $self->{last_emitted_start_tag_name}; |
| 834 | undef $self->{last_attribute_value_state}; | undef $self->{last_attribute_value_state}; |
| 835 | delete $self->{self_closing}; | |
| 836 | $self->{char} = []; | $self->{char} = []; |
| 837 | # $self->{next_input_character} | # $self->{next_char} |
| 838 | !!!next-input-character; | !!!next-input-character; |
| 839 | $self->{token} = []; | $self->{token} = []; |
| 840 | # $self->{escape} | # $self->{escape} |
| # | Line 251 sub _initialize_tokenizer ($) { | Line 847 sub _initialize_tokenizer ($) { |
| 847 | ## ->{tag_name} (START_TAG_TOKEN, END_TAG_TOKEN) | ## ->{tag_name} (START_TAG_TOKEN, END_TAG_TOKEN) |
| 848 | ## ->{public_identifier} (DOCTYPE_TOKEN) | ## ->{public_identifier} (DOCTYPE_TOKEN) |
| 849 | ## ->{system_identifier} (DOCTYPE_TOKEN) | ## ->{system_identifier} (DOCTYPE_TOKEN) |
| 850 | ## ->{correct} == 1 or 0 (DOCTYPE_TOKEN) | ## ->{quirks} == 1 or 0 (DOCTYPE_TOKEN): "force-quirks" flag |
| 851 | ## ->{attributes} isa HASH (START_TAG_TOKEN, END_TAG_TOKEN) | ## ->{attributes} isa HASH (START_TAG_TOKEN, END_TAG_TOKEN) |
| 852 | ## ->{name} | |
| 853 | ## ->{value} | |
| 854 | ## ->{has_reference} == 1 or 0 | |
| 855 | ## ->{data} (COMMENT_TOKEN, CHARACTER_TOKEN) | ## ->{data} (COMMENT_TOKEN, CHARACTER_TOKEN) |
| 856 | ## NOTE: The "self-closing flag" is hold as |$self->{self_closing}|. | |
| 857 | ## |->{self_closing}| is used to save the value of |$self->{self_closing}| | |
| 858 | ## while the token is pushed back to the stack. | |
| 859 | ||
| 860 | ## Emitted token MUST immediately be handled by the tree construction state. | ## Emitted token MUST immediately be handled by the tree construction state. |
| 861 | ||
| # | Line 263 sub _initialize_tokenizer ($) { | Line 865 sub _initialize_tokenizer ($) { |
| 865 | ## has completed loading. If one has, then it MUST be executed | ## has completed loading. If one has, then it MUST be executed |
| 866 | ## and removed from the list. | ## and removed from the list. |
| 867 | ||
| 868 | ## NOTE: HTML5 "Writing HTML documents" section, applied to | |
| 869 | ## documents and not to user agents and conformance checkers, | |
| 870 | ## contains some requirements that are not detected by the | |
| 871 | ## parsing algorithm: | |
| 872 | ## - Some requirements on character encoding declarations. ## TODO | |
| 873 | ## - "Elements MUST NOT contain content that their content model disallows." | |
| 874 | ## ... Some are parse error, some are not (will be reported by c.c.). | |
| 875 | ## - Polytheistic slash SHOULD NOT be used. (Applied only to atheists.) ## TODO | |
| 876 | ## - Text (in elements, attributes, and comments) SHOULD NOT contain | |
| 877 | ## control characters other than space characters. ## TODO: (what is control character? C0, C1 and DEL? Unicode control character?) | |
| 878 | ||
| 879 | ## TODO: HTML5 poses authors two SHOULD-level requirements that cannot | |
| 880 | ## be detected by the HTML5 parsing algorithm: | |
| 881 | ## - Text, | |
| 882 | ||
| 883 | sub _get_next_token ($) { | sub _get_next_token ($) { |
| 884 | my $self = shift; | my $self = shift; |
| 885 | ||
| 886 | if ($self->{self_closing}) { | |
| 887 | !!!parse-error (type => 'nestc', token => $self->{current_token}); | |
| 888 | ## NOTE: The |self_closing| flag is only set by start tag token. | |
| 889 | ## In addition, when a start tag token is emitted, it is always set to | |
| 890 | ## |current_token|. | |
| 891 | delete $self->{self_closing}; | |
| 892 | } | |
| 893 | ||
| 894 | if (@{$self->{token}}) { | if (@{$self->{token}}) { |
| 895 | $self->{self_closing} = $self->{token}->[0]->{self_closing}; | |
| 896 | return shift @{$self->{token}}; | return shift @{$self->{token}}; |
| 897 | } | } |
| 898 | ||
| 899 | A: { | A: { |
| 900 | if ($self->{state} == DATA_STATE) { | if ($self->{state} == DATA_STATE) { |
| 901 | if ($self->{next_input_character} == 0x0026) { # & | if ($self->{next_char} == 0x0026) { # & |
| 902 | if ($self->{content_model} & CM_ENTITY) { # PCDATA | RCDATA | if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA |
| 903 | not $self->{escape}) { | |
| 904 | !!!cp (1); | |
| 905 | $self->{state} = ENTITY_DATA_STATE; | $self->{state} = ENTITY_DATA_STATE; |
| 906 | !!!next-input-character; | !!!next-input-character; |
| 907 | redo A; | redo A; |
| 908 | } else { | } else { |
| 909 | !!!cp (2); | |
| 910 | # | # |
| 911 | } | } |
| 912 | } elsif ($self->{next_input_character} == 0x002D) { # - | } elsif ($self->{next_char} == 0x002D) { # - |
| 913 | if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA | if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA |
| 914 | unless ($self->{escape}) { | unless ($self->{escape}) { |
| 915 | if ($self->{prev_input_character}->[0] == 0x002D and # - | if ($self->{prev_char}->[0] == 0x002D and # - |
| 916 | $self->{prev_input_character}->[1] == 0x0021 and # ! | $self->{prev_char}->[1] == 0x0021 and # ! |
| 917 | $self->{prev_input_character}->[2] == 0x003C) { # < | $self->{prev_char}->[2] == 0x003C) { # < |
| 918 | !!!cp (3); | |
| 919 | $self->{escape} = 1; | $self->{escape} = 1; |
| 920 | } else { | |
| 921 | !!!cp (4); | |
| 922 | } | } |
| 923 | } else { | |
| 924 | !!!cp (5); | |
| 925 | } | } |
| 926 | } | } |
| 927 | ||
| 928 | # | # |
| 929 | } elsif ($self->{next_input_character} == 0x003C) { # < | } elsif ($self->{next_char} == 0x003C) { # < |
| 930 | if ($self->{content_model} & CM_FULL_MARKUP or # PCDATA | if ($self->{content_model} & CM_FULL_MARKUP or # PCDATA |
| 931 | (($self->{content_model} & CM_LIMITED_MARKUP) and # CDATA | RCDATA | (($self->{content_model} & CM_LIMITED_MARKUP) and # CDATA | RCDATA |
| 932 | not $self->{escape})) { | not $self->{escape})) { |
| 933 | !!!cp (6); | |
| 934 | $self->{state} = TAG_OPEN_STATE; | $self->{state} = TAG_OPEN_STATE; |
| 935 | !!!next-input-character; | !!!next-input-character; |
| 936 | redo A; | redo A; |
| 937 | } else { | } else { |
| 938 | !!!cp (7); | |
| 939 | # | # |
| 940 | } | } |
| 941 | } elsif ($self->{next_input_character} == 0x003E) { # > | } elsif ($self->{next_char} == 0x003E) { # > |
| 942 | if ($self->{escape} and | if ($self->{escape} and |
| 943 | ($self->{content_model} & CM_LIMITED_MARKUP)) { # RCDATA | CDATA | ($self->{content_model} & CM_LIMITED_MARKUP)) { # RCDATA | CDATA |
| 944 | if ($self->{prev_input_character}->[0] == 0x002D and # - | if ($self->{prev_char}->[0] == 0x002D and # - |
| 945 | $self->{prev_input_character}->[1] == 0x002D) { # - | $self->{prev_char}->[1] == 0x002D) { # - |
| 946 | !!!cp (8); | |
| 947 | delete $self->{escape}; | delete $self->{escape}; |
| 948 | } else { | |
| 949 | !!!cp (9); | |
| 950 | } | } |
| 951 | } else { | |
| 952 | !!!cp (10); | |
| 953 | } | } |
| 954 | ||
| 955 | # | # |
| 956 | } elsif ($self->{next_input_character} == -1) { | } elsif ($self->{next_char} == -1) { |
| 957 | !!!emit ({type => END_OF_FILE_TOKEN}); | !!!cp (11); |
| 958 | !!!emit ({type => END_OF_FILE_TOKEN, | |
| 959 | line => $self->{line}, column => $self->{column}}); | |
| 960 | last A; ## TODO: ok? | last A; ## TODO: ok? |
| 961 | } else { | |
| 962 | !!!cp (12); | |
| 963 | } | } |
| 964 | # Anything else | # Anything else |
| 965 | my $token = {type => CHARACTER_TOKEN, | my $token = {type => CHARACTER_TOKEN, |
| 966 | data => chr $self->{next_input_character}}; | data => chr $self->{next_char}, |
| 967 | line => $self->{line}, column => $self->{column}, | |
| 968 | }; | |
| 969 | ## Stay in the data state | ## Stay in the data state |
| 970 | !!!next-input-character; | !!!next-input-character; |
| 971 | ||
| # | Line 326 sub _get_next_token ($) { | Line 974 sub _get_next_token ($) { |
| 974 | redo A; | redo A; |
| 975 | } elsif ($self->{state} == ENTITY_DATA_STATE) { | } elsif ($self->{state} == ENTITY_DATA_STATE) { |
| 976 | ## (cannot happen in CDATA state) | ## (cannot happen in CDATA state) |
| 977 | ||
| 978 | my ($l, $c) = ($self->{line_prev}, $self->{column_prev}); | |
| 979 | ||
| 980 | my $token = $self->_tokenize_attempt_to_consume_an_entity (0); | my $token = $self->_tokenize_attempt_to_consume_an_entity (0, -1); |
| 981 | ||
| 982 | $self->{state} = DATA_STATE; | $self->{state} = DATA_STATE; |
| 983 | # next-input-character is already done | # next-input-character is already done |
| 984 | ||
| 985 | unless (defined $token) { | unless (defined $token) { |
| 986 | !!!emit ({type => CHARACTER_TOKEN, data => '&'}); | !!!cp (13); |
| 987 | !!!emit ({type => CHARACTER_TOKEN, data => '&', | |
| 988 | line => $l, column => $c, | |
| 989 | }); | |
| 990 | } else { | } else { |
| 991 | !!!cp (14); | |
| 992 | !!!emit ($token); | !!!emit ($token); |
| 993 | } | } |
| 994 | ||
| 995 | redo A; | redo A; |
| 996 | } elsif ($self->{state} == TAG_OPEN_STATE) { | } elsif ($self->{state} == TAG_OPEN_STATE) { |
| 997 | if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA | if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA |
| 998 | if ($self->{next_input_character} == 0x002F) { # / | if ($self->{next_char} == 0x002F) { # / |
| 999 | !!!cp (15); | |
| 1000 | !!!next-input-character; | !!!next-input-character; |
| 1001 | $self->{state} = CLOSE_TAG_OPEN_STATE; | $self->{state} = CLOSE_TAG_OPEN_STATE; |
| 1002 | redo A; | redo A; |
| 1003 | } else { | } else { |
| 1004 | !!!cp (16); | |
| 1005 | ## reconsume | ## reconsume |
| 1006 | $self->{state} = DATA_STATE; | $self->{state} = DATA_STATE; |
| 1007 | ||
| 1008 | !!!emit ({type => CHARACTER_TOKEN, data => '<'}); | !!!emit ({type => CHARACTER_TOKEN, data => '<', |
| 1009 | line => $self->{line_prev}, | |
| 1010 | column => $self->{column_prev}, | |
| 1011 | }); | |
| 1012 | ||
| 1013 | redo A; | redo A; |
| 1014 | } | } |
| 1015 | } elsif ($self->{content_model} & CM_FULL_MARKUP) { # PCDATA | } elsif ($self->{content_model} & CM_FULL_MARKUP) { # PCDATA |
| 1016 | if ($self->{next_input_character} == 0x0021) { # ! | if ($self->{next_char} == 0x0021) { # ! |
| 1017 | !!!cp (17); | |
| 1018 | $self->{state} = MARKUP_DECLARATION_OPEN_STATE; | $self->{state} = MARKUP_DECLARATION_OPEN_STATE; |
| 1019 | !!!next-input-character; | !!!next-input-character; |
| 1020 | redo A; | redo A; |
| 1021 | } elsif ($self->{next_input_character} == 0x002F) { # / | } elsif ($self->{next_char} == 0x002F) { # / |
| 1022 | !!!cp (18); | |
| 1023 | $self->{state} = CLOSE_TAG_OPEN_STATE; | $self->{state} = CLOSE_TAG_OPEN_STATE; |
| 1024 | !!!next-input-character; | !!!next-input-character; |
| 1025 | redo A; | redo A; |
| 1026 | } elsif (0x0041 <= $self->{next_input_character} and | } elsif (0x0041 <= $self->{next_char} and |
| 1027 | $self->{next_input_character} <= 0x005A) { # A..Z | $self->{next_char} <= 0x005A) { # A..Z |
| 1028 | !!!cp (19); | |
| 1029 | $self->{current_token} | $self->{current_token} |
| 1030 | = {type => START_TAG_TOKEN, | = {type => START_TAG_TOKEN, |
| 1031 | tag_name => chr ($self->{next_input_character} + 0x0020)}; | tag_name => chr ($self->{next_char} + 0x0020), |
| 1032 | line => $self->{line_prev}, | |
| 1033 | column => $self->{column_prev}}; | |
| 1034 | $self->{state} = TAG_NAME_STATE; | $self->{state} = TAG_NAME_STATE; |
| 1035 | !!!next-input-character; | !!!next-input-character; |
| 1036 | redo A; | redo A; |
| 1037 | } elsif (0x0061 <= $self->{next_input_character} and | } elsif (0x0061 <= $self->{next_char} and |
| 1038 | $self->{next_input_character} <= 0x007A) { # a..z | $self->{next_char} <= 0x007A) { # a..z |
| 1039 | !!!cp (20); | |
| 1040 | $self->{current_token} = {type => START_TAG_TOKEN, | $self->{current_token} = {type => START_TAG_TOKEN, |
| 1041 | tag_name => chr ($self->{next_input_character})}; | tag_name => chr ($self->{next_char}), |
| 1042 | line => $self->{line_prev}, | |
| 1043 | column => $self->{column_prev}}; | |
| 1044 | $self->{state} = TAG_NAME_STATE; | $self->{state} = TAG_NAME_STATE; |
| 1045 | !!!next-input-character; | !!!next-input-character; |
| 1046 | redo A; | redo A; |
| 1047 | } elsif ($self->{next_input_character} == 0x003E) { # > | } elsif ($self->{next_char} == 0x003E) { # > |
| 1048 | !!!parse-error (type => 'empty start tag'); | !!!cp (21); |
| 1049 | !!!parse-error (type => 'empty start tag', | |
| 1050 | line => $self->{line_prev}, | |
| 1051 | column => $self->{column_prev}); | |
| 1052 | $self->{state} = DATA_STATE; | $self->{state} = DATA_STATE; |
| 1053 | !!!next-input-character; | !!!next-input-character; |
| 1054 | ||
| 1055 | !!!emit ({type => CHARACTER_TOKEN, data => '<>'}); | !!!emit ({type => CHARACTER_TOKEN, data => '<>', |
| 1056 | line => $self->{line_prev}, | |
| 1057 | column => $self->{column_prev}, | |
| 1058 | }); | |
| 1059 | ||
| 1060 | redo A; | redo A; |
| 1061 | } elsif ($self->{next_input_character} == 0x003F) { # ? | } elsif ($self->{next_char} == 0x003F) { # ? |
| 1062 | !!!parse-error (type => 'pio'); | !!!cp (22); |
| 1063 | !!!parse-error (type => 'pio', | |
| 1064 | line => $self->{line_prev}, | |
| 1065 | column => $self->{column_prev}); | |
| 1066 | $self->{state} = BOGUS_COMMENT_STATE; | $self->{state} = BOGUS_COMMENT_STATE; |
| 1067 | ## $self->{next_input_character} is intentionally left as is | $self->{current_token} = {type => COMMENT_TOKEN, data => '', |
| 1068 | line => $self->{line_prev}, | |
| 1069 | column => $self->{column_prev}, | |
| 1070 | }; | |
| 1071 | ## $self->{next_char} is intentionally left as is | |
| 1072 | redo A; | redo A; |
| 1073 | } else { | } else { |
| 1074 | !!!parse-error (type => 'bare stago'); | !!!cp (23); |
| 1075 | !!!parse-error (type => 'bare stago', | |
| 1076 | line => $self->{line_prev}, | |
| 1077 | column => $self->{column_prev}); | |
| 1078 | $self->{state} = DATA_STATE; | $self->{state} = DATA_STATE; |
| 1079 | ## reconsume | ## reconsume |
| 1080 | ||
| 1081 | !!!emit ({type => CHARACTER_TOKEN, data => '<'}); | !!!emit ({type => CHARACTER_TOKEN, data => '<', |
| 1082 | line => $self->{line_prev}, | |
| 1083 | column => $self->{column_prev}, | |
| 1084 | }); | |
| 1085 | ||
| 1086 | redo A; | redo A; |
| 1087 | } | } |
| # | Line 403 sub _get_next_token ($) { | Line 1089 sub _get_next_token ($) { |
| 1089 | die "$0: $self->{content_model} in tag open"; | die "$0: $self->{content_model} in tag open"; |
| 1090 | } | } |
| 1091 | } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) { | } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) { |
| 1092 | my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</" | |
| 1093 | if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA | if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA |
| 1094 | if (defined $self->{last_emitted_start_tag_name}) { | if (defined $self->{last_emitted_start_tag_name}) { |
| 1095 | ||
| 1096 | ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564> | ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564> |
| 1097 | my @next_char; | my @next_char; |
| 1098 | TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) { | TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) { |
| 1099 | push @next_char, $self->{next_input_character}; | push @next_char, $self->{next_char}; |
| 1100 | my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1); | my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1); |
| 1101 | my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c; | my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c; |
| 1102 | if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) { | if ($self->{next_char} == $c or $self->{next_char} == $C) { |
| 1103 | !!!cp (24); | |
| 1104 | !!!next-input-character; | !!!next-input-character; |
| 1105 | next TAGNAME; | next TAGNAME; |
| 1106 | } else { | } else { |
| 1107 | $self->{next_input_character} = shift @next_char; # reconsume | !!!cp (25); |
| 1108 | $self->{next_char} = shift @next_char; # reconsume | |
| 1109 | !!!back-next-input-character (@next_char); | !!!back-next-input-character (@next_char); |
| 1110 | $self->{state} = DATA_STATE; | $self->{state} = DATA_STATE; |
| 1111 | ||
| 1112 | !!!emit ({type => CHARACTER_TOKEN, data => '</'}); | !!!emit ({type => CHARACTER_TOKEN, data => '</', |
| 1113 | line => $l, column => $c, | |
| 1114 | }); | |
| 1115 | ||
| 1116 | redo A; | redo A; |
| 1117 | } | } |
| 1118 | } | } |
| 1119 | push @next_char, $self->{next_input_character}; | push @next_char, $self->{next_char}; |
| 1120 | ||
| 1121 | unless ($self->{next_input_character} == 0x0009 or # HT | unless ($self->{next_char} == 0x0009 or # HT |
| 1122 | $self->{next_input_character} == 0x000A or # LF | $self->{next_char} == 0x000A or # LF |
| 1123 | $self->{next_input_character} == 0x000B or # VT | $self->{next_char} == 0x000B or # VT |
| 1124 | $self->{next_input_character} == 0x000C or # FF | $self->{next_char} == 0x000C or # FF |
| 1125 | $self->{next_input_character} == 0x0020 or # SP | $self->{next_char} == 0x0020 or # SP |
| 1126 | $self->{next_input_character} == 0x003E or # > | $self->{next_char} == 0x003E or # > |
| 1127 | $self->{next_input_character} == 0x002F or # / | $self->{next_char} == 0x002F or # / |
| 1128 | $self->{next_input_character} == -1) { | $self->{next_char} == -1) { |
| 1129 | $self->{next_input_character} = shift @next_char; # reconsume | !!!cp (26); |
| 1130 | $self->{next_char} = shift @next_char; # reconsume | |
| 1131 | !!!back-next-input-character (@next_char); | !!!back-next-input-character (@next_char); |
| 1132 | $self->{state} = DATA_STATE; | $self->{state} = DATA_STATE; |
| 1133 | !!!emit ({type => CHARACTER_TOKEN, data => '</'}); | !!!emit ({type => CHARACTER_TOKEN, data => '</', |
| 1134 | line => $l, column => $c, | |
| 1135 | }); | |
| 1136 | redo A; | redo A; |
| 1137 | } else { | } else { |
| 1138 | $self->{next_input_character} = shift @next_char; | !!!cp (27); |
| 1139 | $self->{next_char} = shift @next_char; | |
| 1140 | !!!back-next-input-character (@next_char); | !!!back-next-input-character (@next_char); |
| 1141 | # and consume... | # and consume... |
| 1142 | } | } |
| 1143 | } else { | } else { |
| 1144 | ## No start tag token has ever been emitted | ## No start tag token has ever been emitted |
| 1145 | !!!cp (28); | |
| 1146 | # next-input-character is already done | # next-input-character is already done |
| 1147 | $self->{state} = DATA_STATE; | $self->{state} = DATA_STATE; |
| 1148 | !!!emit ({type => CHARACTER_TOKEN, data => '</'}); | !!!emit ({type => CHARACTER_TOKEN, data => '</', |
| 1149 | line => $l, column => $c, | |
| 1150 | }); | |
| 1151 | redo A; | redo A; |
| 1152 | } | } |
| 1153 | } | } |
| 1154 | ||
| 1155 | if (0x0041 <= $self->{next_input_character} and | if (0x0041 <= $self->{next_char} and |
| 1156 | $self->{next_input_character} <= 0x005A) { # A..Z | $self->{next_char} <= 0x005A) { # A..Z |
| 1157 | $self->{current_token} = {type => END_TAG_TOKEN, | !!!cp (29); |
| 1158 | tag_name => chr ($self->{next_input_character} + 0x0020)}; | $self->{current_token} |
| 1159 | = {type => END_TAG_TOKEN, | |
| 1160 | tag_name => chr ($self->{next_char} + 0x0020), | |
| 1161 | line => $l, column => $c}; | |
| 1162 | $self->{state} = TAG_NAME_STATE; | $self->{state} = TAG_NAME_STATE; |
| 1163 | !!!next-input-character; | !!!next-input-character; |
| 1164 | redo A; | redo A; |
| 1165 | } elsif (0x0061 <= $self->{next_input_character} and | } elsif (0x0061 <= $self->{next_char} and |
| 1166 | $self->{next_input_character} <= 0x007A) { # a..z | $self->{next_char} <= 0x007A) { # a..z |
| 1167 | !!!cp (30); | |
| 1168 | $self->{current_token} = {type => END_TAG_TOKEN, | $self->{current_token} = {type => END_TAG_TOKEN, |
| 1169 | tag_name => chr ($self->{next_input_character})}; | tag_name => chr ($self->{next_char}), |
| 1170 | line => $l, column => $c}; | |
| 1171 | $self->{state} = TAG_NAME_STATE; | $self->{state} = TAG_NAME_STATE; |
| 1172 | !!!next-input-character; | !!!next-input-character; |
| 1173 | redo A; | redo A; |
| 1174 | } elsif ($self->{next_input_character} == 0x003E) { # > | } elsif ($self->{next_char} == 0x003E) { # > |
| 1175 | !!!parse-error (type => 'empty end tag'); | !!!cp (31); |
| 1176 | !!!parse-error (type => 'empty end tag', | |
| 1177 | line => $self->{line_prev}, ## "<" in "</>" | |
| 1178 | column => $self->{column_prev} - 1); | |
| 1179 | $self->{state} = DATA_STATE; | $self->{state} = DATA_STATE; |
| 1180 | !!!next-input-character; | !!!next-input-character; |
| 1181 | redo A; | redo A; |
| 1182 | } elsif ($self->{next_input_character} == -1) { | } elsif ($self->{next_char} == -1) { |
| 1183 | !!!cp (32); | |
| 1184 | !!!parse-error (type => 'bare etago'); | !!!parse-error (type => 'bare etago'); |
| 1185 | $self->{state} = DATA_STATE; | $self->{state} = DATA_STATE; |
| 1186 | # reconsume | # reconsume |
| 1187 | ||
| 1188 | !!!emit ({type => CHARACTER_TOKEN, data => '</'}); | !!!emit ({type => CHARACTER_TOKEN, data => '</', |
| 1189 | line => $l, column => $c, | |
| 1190 | }); | |
| 1191 | ||
| 1192 | redo A; | redo A; |
| 1193 | } else { | } else { |
| 1194 | !!!cp (33); | |
| 1195 | !!!parse-error (type => 'bogus end tag'); | !!!parse-error (type => 'bogus end tag'); |
| 1196 | $self->{state} = BOGUS_COMMENT_STATE; | $self->{state} = BOGUS_COMMENT_STATE; |
| 1197 | ## $self->{next_input_character} is intentionally left as is | $self->{current_token} = {type => COMMENT_TOKEN, data => '', |
| 1198 | line => $self->{line_prev}, # "<" of "</" | |
| 1199 | column => $self->{column_prev} - 1, | |
| 1200 | }; | |
| 1201 | ## $self->{next_char} is intentionally left as is | |
| 1202 | redo A; | redo A; |
| 1203 | } | } |
| 1204 | } elsif ($self->{state} == TAG_NAME_STATE) { | } elsif ($self->{state} == TAG_NAME_STATE) { |
| 1205 | if ($self->{next_input_character} == 0x0009 or # HT | if ($self->{next_char} == 0x0009 or # HT |
| 1206 | $self->{next_input_character} == 0x000A or # LF | $self->{next_char} == 0x000A or # LF |
| 1207 | $self->{next_input_character} == 0x000B or # VT | $self->{next_char} == 0x000B or # VT |
| 1208 | $self->{next_input_character} == 0x000C or # FF | $self->{next_char} == 0x000C or # FF |
| 1209 | $self->{next_input_character} == 0x0020) { # SP | $self->{next_char} == 0x0020) { # SP |
| 1210 | !!!cp (34); | |
| 1211 | $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE; | $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE; |
| 1212 | !!!next-input-character; | !!!next-input-character; |
| 1213 | redo A; | redo A; |
| 1214 | } elsif ($self->{next_input_character} == 0x003E) { # > | } elsif ($self->{next_char} == 0x003E) { # > |
| 1215 | if ($self->{current_token}->{type} == START_TAG_TOKEN) { | if ($self->{current_token}->{type} == START_TAG_TOKEN) { |
| 1216 | $self->{current_token}->{first_start_tag} | !!!cp (35); |
| = not defined $self->{last_emitted_start_tag_name}; | ||
| 1217 | $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; | $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; |
| 1218 | } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) { | } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) { |
| 1219 | $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST | $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST |
| 1220 | if ($self->{current_token}->{attributes}) { | #if ($self->{current_token}->{attributes}) { |
| 1221 | !!!parse-error (type => 'end tag attribute'); | # ## NOTE: This should never be reached. |
| 1222 | } | # !!! cp (36); |
| 1223 | # !!! parse-error (type => 'end tag attribute'); | |
| 1224 | #} else { | |
| 1225 | !!!cp (37); | |
| 1226 | #} | |
| 1227 | } else { | } else { |
| 1228 | die "$0: $self->{current_token}->{type}: Unknown token type"; | die "$0: $self->{current_token}->{type}: Unknown token type"; |
| 1229 | } | } |
| # | Line 514 sub _get_next_token ($) { | Line 1233 sub _get_next_token ($) { |
| 1233 | !!!emit ($self->{current_token}); # start tag or end tag | !!!emit ($self->{current_token}); # start tag or end tag |
| 1234 | ||
| 1235 | redo A; | redo A; |
| 1236 | } elsif (0x0041 <= $self->{next_input_character} and | } elsif (0x0041 <= $self->{next_char} and |
| 1237 | $self->{next_input_character} <= 0x005A) { # A..Z | $self->{next_char} <= 0x005A) { # A..Z |
| 1238 | $self->{current_token}->{tag_name} .= chr ($self->{next_input_character} + 0x0020); | !!!cp (38); |
| 1239 | $self->{current_token}->{tag_name} .= chr ($self->{next_char} + 0x0020); | |
| 1240 | # start tag or end tag | # start tag or end tag |
| 1241 | ## Stay in this state | ## Stay in this state |
| 1242 | !!!next-input-character; | !!!next-input-character; |
| 1243 | redo A; | redo A; |
| 1244 | } elsif ($self->{next_input_character} == -1) { | } elsif ($self->{next_char} == -1) { |
| 1245 | !!!parse-error (type => 'unclosed tag'); | !!!parse-error (type => 'unclosed tag'); |
| 1246 | if ($self->{current_token}->{type} == START_TAG_TOKEN) { | if ($self->{current_token}->{type} == START_TAG_TOKEN) { |
| 1247 | $self->{current_token}->{first_start_tag} | !!!cp (39); |
| = not defined $self->{last_emitted_start_tag_name}; | ||
| 1248 | $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; | $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; |
| 1249 | } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) { | } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) { |
| 1250 | $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST | $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST |
| 1251 | if ($self->{current_token}->{attributes}) { | #if ($self->{current_token}->{attributes}) { |
| 1252 | !!!parse-error (type => 'end tag attribute'); | # ## NOTE: This state should never be reached. |
| 1253 | } | # !!! cp (40); |
| 1254 | # !!! parse-error (type => 'end tag attribute'); | |
| 1255 | #} else { | |
| 1256 | !!!cp (41); | |
| 1257 | #} | |
| 1258 | } else { | } else { |
| 1259 | die "$0: $self->{current_token}->{type}: Unknown token type"; | die "$0: $self->{current_token}->{type}: Unknown token type"; |
| 1260 | } | } |
| # | Line 541 sub _get_next_token ($) { | Line 1264 sub _get_next_token ($) { |
| 1264 | !!!emit ($self->{current_token}); # start tag or end tag | !!!emit ($self->{current_token}); # start tag or end tag |
| 1265 | ||
| 1266 | redo A; | redo A; |
| 1267 | } elsif ($self->{next_input_character} == 0x002F) { # / | } elsif ($self->{next_char} == 0x002F) { # / |
| 1268 | !!!cp (42); | |
| 1269 | $self->{state} = SELF_CLOSING_START_TAG_STATE; | |
| 1270 | !!!next-input-character; | !!!next-input-character; |
| if ($self->{next_input_character} == 0x003E and # > | ||
| $self->{current_token}->{type} == START_TAG_TOKEN and | ||
| $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) { | ||
| # permitted slash | ||
| # | ||
| } else { | ||
| !!!parse-error (type => 'nestc'); | ||
| } | ||
| $self->{state} = BEFORE_ATTRIBUTE_NAME_STATE; | ||
| # next-input-character is already done | ||
| 1271 | redo A; | redo A; |
| 1272 | } else { | } else { |
| 1273 | $self->{current_token}->{tag_name} .= chr $self->{next_input_character}; | !!!cp (44); |
| 1274 | $self->{current_token}->{tag_name} .= chr $self->{next_char}; | |
| 1275 | # start tag or end tag | # start tag or end tag |
| 1276 | ## Stay in the state | ## Stay in the state |
| 1277 | !!!next-input-character; | !!!next-input-character; |
| 1278 | redo A; | redo A; |
| 1279 | } | } |
| 1280 | } elsif ($self->{state} == BEFORE_ATTRIBUTE_NAME_STATE) { | } elsif ($self->{state} == BEFORE_ATTRIBUTE_NAME_STATE) { |
| 1281 | if ($self->{next_input_character} == 0x0009 or # HT | if ($self->{next_char} == 0x0009 or # HT |
| 1282 | $self->{next_input_character} == 0x000A or # LF | $self->{next_char} == 0x000A or # LF |
| 1283 | $self->{next_input_character} == 0x000B or # VT | $self->{next_char} == 0x000B or # VT |
| 1284 | $self->{next_input_character} == 0x000C or # FF | $self->{next_char} == 0x000C or # FF |
| 1285 | $self->{next_input_character} == 0x0020) { # SP | $self->{next_char} == 0x0020) { # SP |
| 1286 | !!!cp (45); | |
| 1287 | ## Stay in the state | ## Stay in the state |
| 1288 | !!!next-input-character; | !!!next-input-character; |
| 1289 | redo A; | redo A; |
| 1290 | } elsif ($self->{next_input_character} == 0x003E) { # > | } elsif ($self->{next_char} == 0x003E) { # > |
| 1291 | if ($self->{current_token}->{type} == START_TAG_TOKEN) { | if ($self->{current_token}->{type} == START_TAG_TOKEN) { |
| 1292 | $self->{current_token}->{first_start_tag} | !!!cp (46); |
| = not defined $self->{last_emitted_start_tag_name}; | ||
| 1293 | $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; | $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; |
| 1294 | } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) { | } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) { |
| 1295 | $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST | $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST |
| 1296 | if ($self->{current_token}->{attributes}) { | if ($self->{current_token}->{attributes}) { |
| 1297 | !!!cp (47); | |
| 1298 | !!!parse-error (type => 'end tag attribute'); | !!!parse-error (type => 'end tag attribute'); |
| 1299 | } else { | |
| 1300 | !!!cp (48); | |
| 1301 | } | } |
| 1302 | } else { | } else { |
| 1303 | die "$0: $self->{current_token}->{type}: Unknown token type"; | die "$0: $self->{current_token}->{type}: Unknown token type"; |
| # | Line 589 sub _get_next_token ($) { | Line 1308 sub _get_next_token ($) { |
| 1308 | !!!emit ($self->{current_token}); # start tag or end tag | !!!emit ($self->{current_token}); # start tag or end tag |
| 1309 | ||
| 1310 | redo A; | redo A; |
| 1311 | } elsif (0x0041 <= $self->{next_input_character} and | } elsif (0x0041 <= $self->{next_char} and |
| 1312 | $self->{next_input_character} <= 0x005A) { # A..Z | $self->{next_char} <= 0x005A) { # A..Z |
| 1313 | $self->{current_attribute} = {name => chr ($self->{next_input_character} + 0x0020), | !!!cp (49); |
| 1314 | value => ''}; | $self->{current_attribute} |
| 1315 | = {name => chr ($self->{next_char} + 0x0020), | |
| 1316 | value => '', | |
| 1317 | line => $self->{line}, column => $self->{column}}; | |
| 1318 | $self->{state} = ATTRIBUTE_NAME_STATE; | $self->{state} = ATTRIBUTE_NAME_STATE; |
| 1319 | !!!next-input-character; | !!!next-input-character; |
| 1320 | redo A; | redo A; |
| 1321 | } elsif ($self->{next_input_character} == 0x002F) { # / | } elsif ($self->{next_char} == 0x002F) { # / |
| 1322 | !!!cp (50); | |
| 1323 | $self->{state} = SELF_CLOSING_START_TAG_STATE; | |
| 1324 | !!!next-input-character; | !!!next-input-character; |
| if ($self->{next_input_character} == 0x003E and # > | ||
| $self->{current_token}->{type} == START_TAG_TOKEN and | ||
| $permitted_slash_tag_name->{$self->{current_token}->{tag_name}}) { | ||
| # permitted slash | ||
| # | ||
| } else { | ||
| !!!parse-error (type => 'nestc'); | ||
| } | ||
| ## Stay in the state | ||
| # next-input-character is already done | ||
| 1325 | redo A; | redo A; |
| 1326 | } elsif ($self->{next_input_character} == -1) { | } elsif ($self->{next_char} == -1) { |
| 1327 | !!!parse-error (type => 'unclosed tag'); | !!!parse-error (type => 'unclosed tag'); |
| 1328 | if ($self->{current_token}->{type} == START_TAG_TOKEN) { | if ($self->{current_token}->{type} == START_TAG_TOKEN) { |
| 1329 | $self->{current_token}->{first_start_tag} | !!!cp (52); |
| = not defined $self->{last_emitted_start_tag_name}; | ||
| 1330 | $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; | $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; |
| 1331 | } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) { | } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) { |
| 1332 | $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST | $self->{content_model} = PCDATA_CONTENT_MODEL; # MUST |
| 1333 | if ($self->{current_token}->{attributes}) { | if ($self->{current_token}->{attributes}) { |
| 1334 | !!!cp (53); | |
| 1335 | !!!parse-error (type => 'end tag attribute'); | !!!parse-error (type => 'end tag attribute'); |
| 1336 | } else { | |
| 1337 | !!!cp (54); | |
| 1338 | } | } |
| 1339 | } else { | } else { |
| 1340 | die "$0: $self->{current_token}->{type}: Unknown token type"; | die "$0: $self->{current_token}->{type}: Unknown token type"; |
| # | Line 630 sub _get_next_token ($) { | Line 1346 sub _get_next_token ($) { |
| 1346 | ||
| 1347 | redo A; | redo A; |
| 1348 | } else { | } else { |
| 1349 | $self->{current_attribute} = {name => chr ($self->{next_input_character}), | if ({ |
| 1350 | value => ''}; | 0x0022 => 1, # " |
| 1351 | 0x0027 => 1, # ' | |
| 1352 | 0x003D => 1, # = | |
| 1353 | }->{$self->{next_char}}) { | |
| 1354 | !!!cp (55); | |
| 1355 | !!!parse-error (type => 'bad attribute name'); | |
| 1356 | } else { | |
| 1357 | !!!cp (56); | |
| 1358 | } | |
| 1359 | $self->{current_attribute} | |
| 1360 | = {name => chr ($self->{next_char}), | |
| 1361 | value => '', | |
| 1362 | line => $self->{line}, column => $self->{column}}; | |
| 1363 | $self->{state} = ATTRIBUTE_NAME_STATE; | $self->{state} = ATTRIBUTE_NAME_STATE; |
| 1364 | !!!next-input-character; | !!!next-input-character; |
| 1365 | redo A; | redo A; |
| # | Line 640 sub _get_next_token ($) { | Line 1368 sub _get_next_token ($) { |
| 1368 | my $before_leave = sub { | my $before_leave = sub { |
| 1369 | if (exists $self->{current_token}->{attributes} # start tag or end tag | if (exists $self->{current_token}->{attributes} # start tag or end tag |
| 1370 | ->{$self->{current_attribute}->{name}}) { # MUST | ->{$self->{current_attribute}->{name}}) { # MUST |
| 1371 | !!!parse-error (type => 'duplicate attribute:'.$self->{current_attribute}->{name}); | !!!cp (57); |
| 1372 | !!!parse-error (type => 'duplicate attribute', text => $self->{current_attribute}->{name}, line => $self->{current_attribute}->{line}, column => $self->{current_attribute}->{column}); | |
| 1373 | ## Discard $self->{current_attribute} # MUST | ## Discard $self->{current_attribute} # MUST |
| 1374 | } else { | } else { |
| 1375 | !!!cp (58); | |
| 1376 | $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}} | $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}} |
| 1377 | = $self->{current_attribute}; | = $self->{current_attribute}; |
| 1378 | } | } |
| 1379 | }; # $before_leave | }; # $before_leave |
| 1380 | ||
| 1381 | if ($self->{next_input_character} == 0x0009 or # HT | if ($self->{next_char} == 0x0009 or # HT |
| 1382 | $self->{next_input_character} == 0x000A or # LF | $self->{next_char} == 0x000A or # LF |
| 1383 | $self->{next_input_character} == 0x000B or # VT | $self->{next_char} == 0x000B or # VT |
| 1384 | $self->{next_input_character} == 0x000C or # FF | $self->{next_char} == 0x000C or # FF |
| 1385 | $self->{next_input_character} == 0x0020) { # SP | $self->{next_char} == 0x0020) { # SP |
| 1386 | !!!cp (59); | |
| 1387 | $before_leave->(); | $before_leave->(); |
| 1388 | $self->{state} = AFTER_ATTRIBUTE_NAME_STATE; | $self->{state} = AFTER_ATTRIBUTE_NAME_STATE; |
| 1389 | !!!next-input-character; | !!!next-input-character; |
| 1390 | redo A; | redo A; |
| 1391 | } elsif ($self->{next_input_character} == 0x003D) { # = | } elsif ($self->{next_char} == 0x003D) { # = |
| 1392 | !!!cp (60); | |
| 1393 | $before_leave->(); | $before_leave->(); |
| 1394 | $self->{state} = BEFORE_ATTRIBUTE_VALUE_STATE; | $self->{state} = BEFORE_ATTRIBUTE_VALUE_STATE; |
| 1395 | !!!next-input-character; | !!!next-input-character; |
| 1396 | redo A; | redo A; |
| 1397 | } elsif ($self->{next_input_character} == 0x003E) { # > | } elsif ($self->{next_char} == 0x003E) { # > |
| 1398 | $before_leave->(); | $before_leave->(); |
| 1399 | &nb |