| 354 |
return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]); |
return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]); |
| 355 |
} # parse_byte_string |
} # parse_byte_string |
| 356 |
|
|
| 357 |
sub parse_byte_stream ($$$$;$) { |
sub parse_byte_stream ($$$$;$$) { |
| 358 |
|
# my ($self, $charset_name, $byte_stream, $doc, $onerror, $get_wrapper) = @_; |
| 359 |
my $self = ref $_[0] ? shift : shift->new; |
my $self = ref $_[0] ? shift : shift->new; |
| 360 |
my $charset_name = shift; |
my $charset_name = shift; |
| 361 |
my $byte_stream = $_[0]; |
my $byte_stream = $_[0]; |
| 366 |
}; |
}; |
| 367 |
$self->{parse_error} = $onerror; # updated later by parse_char_string |
$self->{parse_error} = $onerror; # updated later by parse_char_string |
| 368 |
|
|
| 369 |
|
my $get_wrapper = $_[3] || sub ($) { |
| 370 |
|
return $_[0]; # $_[0] = byte stream handle, returned = arg to char handle |
| 371 |
|
}; |
| 372 |
|
|
| 373 |
## HTML5 encoding sniffing algorithm |
## HTML5 encoding sniffing algorithm |
| 374 |
require Message::Charset::Info; |
require Message::Charset::Info; |
| 375 |
my $charset; |
my $charset; |
| 377 |
my ($char_stream, $e_status); |
my ($char_stream, $e_status); |
| 378 |
|
|
| 379 |
SNIFFING: { |
SNIFFING: { |
| 380 |
|
## NOTE: By setting |allow_fallback| option true when the |
| 381 |
|
## |get_decode_handle| method is invoked, we ignore what the HTML5 |
| 382 |
|
## spec requires, i.e. unsupported encoding should be ignored. |
| 383 |
|
## TODO: We should not do this unless the parser is invoked |
| 384 |
|
## in the conformance checking mode, in which this behavior |
| 385 |
|
## would be useful. |
| 386 |
|
|
| 387 |
## Step 1 |
## Step 1 |
| 388 |
if (defined $charset_name) { |
if (defined $charset_name) { |
| 389 |
$charset = Message::Charset::Info->get_by_iana_name ($charset_name); |
$charset = Message::Charset::Info->get_by_html_name ($charset_name); |
| 390 |
|
## TODO: Is this ok? Transfer protocol's parameter should be |
| 391 |
|
## interpreted in its semantics? |
| 392 |
|
|
| 393 |
## ISSUE: Unsupported encoding is not ignored according to the spec. |
## ISSUE: Unsupported encoding is not ignored according to the spec. |
| 394 |
($char_stream, $e_status) = $charset->get_decode_handle |
($char_stream, $e_status) = $charset->get_decode_handle |
| 412 |
|
|
| 413 |
## Step 3 |
## Step 3 |
| 414 |
if ($byte_buffer =~ /^\xFE\xFF/) { |
if ($byte_buffer =~ /^\xFE\xFF/) { |
| 415 |
$charset = Message::Charset::Info->get_by_iana_name ('utf-16be'); |
$charset = Message::Charset::Info->get_by_html_name ('utf-16be'); |
| 416 |
($char_stream, $e_status) = $charset->get_decode_handle |
($char_stream, $e_status) = $charset->get_decode_handle |
| 417 |
($byte_stream, allow_error_reporting => 1, |
($byte_stream, allow_error_reporting => 1, |
| 418 |
allow_fallback => 1, byte_buffer => \$byte_buffer); |
allow_fallback => 1, byte_buffer => \$byte_buffer); |
| 419 |
$self->{confident} = 1; |
$self->{confident} = 1; |
| 420 |
last SNIFFING; |
last SNIFFING; |
| 421 |
} elsif ($byte_buffer =~ /^\xFF\xFE/) { |
} elsif ($byte_buffer =~ /^\xFF\xFE/) { |
| 422 |
$charset = Message::Charset::Info->get_by_iana_name ('utf-16le'); |
$charset = Message::Charset::Info->get_by_html_name ('utf-16le'); |
| 423 |
($char_stream, $e_status) = $charset->get_decode_handle |
($char_stream, $e_status) = $charset->get_decode_handle |
| 424 |
($byte_stream, allow_error_reporting => 1, |
($byte_stream, allow_error_reporting => 1, |
| 425 |
allow_fallback => 1, byte_buffer => \$byte_buffer); |
allow_fallback => 1, byte_buffer => \$byte_buffer); |
| 426 |
$self->{confident} = 1; |
$self->{confident} = 1; |
| 427 |
last SNIFFING; |
last SNIFFING; |
| 428 |
} elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) { |
} elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) { |
| 429 |
$charset = Message::Charset::Info->get_by_iana_name ('utf-8'); |
$charset = Message::Charset::Info->get_by_html_name ('utf-8'); |
| 430 |
($char_stream, $e_status) = $charset->get_decode_handle |
($char_stream, $e_status) = $charset->get_decode_handle |
| 431 |
($byte_stream, allow_error_reporting => 1, |
($byte_stream, allow_error_reporting => 1, |
| 432 |
allow_fallback => 1, byte_buffer => \$byte_buffer); |
allow_fallback => 1, byte_buffer => \$byte_buffer); |
| 445 |
$charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string |
$charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string |
| 446 |
($byte_buffer); |
($byte_buffer); |
| 447 |
if (defined $charset_name) { |
if (defined $charset_name) { |
| 448 |
$charset = Message::Charset::Info->get_by_iana_name ($charset_name); |
$charset = Message::Charset::Info->get_by_html_name ($charset_name); |
| 449 |
|
|
| 450 |
## ISSUE: Unsupported encoding is not ignored according to the spec. |
## ISSUE: Unsupported encoding is not ignored according to the spec. |
| 451 |
require Whatpm::Charset::DecodeHandle; |
require Whatpm::Charset::DecodeHandle; |
| 468 |
|
|
| 469 |
## Step 7: default |
## Step 7: default |
| 470 |
## TODO: Make this configurable. |
## TODO: Make this configurable. |
| 471 |
$charset = Message::Charset::Info->get_by_iana_name ('windows-1252'); |
$charset = Message::Charset::Info->get_by_html_name ('windows-1252'); |
| 472 |
## NOTE: We choose |windows-1252| here, since |utf-8| should be |
## NOTE: We choose |windows-1252| here, since |utf-8| should be |
| 473 |
## detectable in the step 6. |
## detectable in the step 6. |
| 474 |
require Whatpm::Charset::DecodeHandle; |
require Whatpm::Charset::DecodeHandle; |
| 488 |
$self->{confident} = 0; |
$self->{confident} = 0; |
| 489 |
} # SNIFFING |
} # SNIFFING |
| 490 |
|
|
|
$self->{input_encoding} = $charset->get_iana_name; |
|
| 491 |
if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) { |
if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) { |
| 492 |
|
$self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name? |
| 493 |
!!!parse-error (type => 'chardecode:fallback', |
!!!parse-error (type => 'chardecode:fallback', |
| 494 |
text => $self->{input_encoding}, |
#text => $self->{input_encoding}, |
| 495 |
level => $self->{level}->{uncertain}, |
level => $self->{level}->{uncertain}, |
| 496 |
line => 1, column => 1, |
line => 1, column => 1, |
| 497 |
layer => 'encode'); |
layer => 'encode'); |
| 498 |
} elsif (not ($e_status & |
} elsif (not ($e_status & |
| 499 |
Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) { |
Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) { |
| 500 |
|
$self->{input_encoding} = $charset->get_iana_name; |
| 501 |
!!!parse-error (type => 'chardecode:no error', |
!!!parse-error (type => 'chardecode:no error', |
| 502 |
text => $self->{input_encoding}, |
text => $self->{input_encoding}, |
| 503 |
level => $self->{level}->{uncertain}, |
level => $self->{level}->{uncertain}, |
| 504 |
line => 1, column => 1, |
line => 1, column => 1, |
| 505 |
layer => 'encode'); |
layer => 'encode'); |
| 506 |
|
} else { |
| 507 |
|
$self->{input_encoding} = $charset->get_iana_name; |
| 508 |
} |
} |
| 509 |
|
|
| 510 |
$self->{change_encoding} = sub { |
$self->{change_encoding} = sub { |
| 512 |
$charset_name = shift; |
$charset_name = shift; |
| 513 |
my $token = shift; |
my $token = shift; |
| 514 |
|
|
| 515 |
$charset = Message::Charset::Info->get_by_iana_name ($charset_name); |
$charset = Message::Charset::Info->get_by_html_name ($charset_name); |
| 516 |
($char_stream, $e_status) = $charset->get_decode_handle |
($char_stream, $e_status) = $charset->get_decode_handle |
| 517 |
($byte_stream, allow_error_reporting => 1, allow_fallback => 1, |
($byte_stream, allow_error_reporting => 1, allow_fallback => 1, |
| 518 |
byte_buffer => \ $buffer->{buffer}); |
byte_buffer => \ $buffer->{buffer}); |
| 523 |
## Step 1 |
## Step 1 |
| 524 |
if ($charset->{category} & |
if ($charset->{category} & |
| 525 |
Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) { |
Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) { |
| 526 |
$charset = Message::Charset::Info->get_by_iana_name ('utf-8'); |
$charset = Message::Charset::Info->get_by_html_name ('utf-8'); |
| 527 |
($char_stream, $e_status) = $charset->get_decode_handle |
($char_stream, $e_status) = $charset->get_decode_handle |
| 528 |
($byte_stream, |
($byte_stream, |
| 529 |
byte_buffer => \ $buffer->{buffer}); |
byte_buffer => \ $buffer->{buffer}); |
| 567 |
${$opt{octets}} = "\x{FFFD}"; # relacement character |
${$opt{octets}} = "\x{FFFD}"; # relacement character |
| 568 |
} |
} |
| 569 |
}; |
}; |
| 570 |
$char_stream->onerror ($char_onerror); |
|
| 571 |
|
my $wrapped_char_stream = $get_wrapper->($char_stream); |
| 572 |
|
$wrapped_char_stream->onerror ($char_onerror); |
| 573 |
|
|
| 574 |
my @args = @_; shift @args; # $s |
my @args = @_; shift @args; # $s |
| 575 |
my $return; |
my $return; |
| 576 |
try { |
try { |
| 577 |
$return = $self->parse_char_stream ($char_stream, @args); |
$return = $self->parse_char_stream ($wrapped_char_stream, @args); |
| 578 |
} catch Whatpm::HTML::RestartParser with { |
} catch Whatpm::HTML::RestartParser with { |
| 579 |
## NOTE: Invoked after {change_encoding}. |
## NOTE: Invoked after {change_encoding}. |
| 580 |
|
|
|
$self->{input_encoding} = $charset->get_iana_name; |
|
| 581 |
if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) { |
if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) { |
| 582 |
|
$self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name? |
| 583 |
!!!parse-error (type => 'chardecode:fallback', |
!!!parse-error (type => 'chardecode:fallback', |
|
text => $self->{input_encoding}, |
|
| 584 |
level => $self->{level}->{uncertain}, |
level => $self->{level}->{uncertain}, |
| 585 |
|
#text => $self->{input_encoding}, |
| 586 |
line => 1, column => 1, |
line => 1, column => 1, |
| 587 |
layer => 'encode'); |
layer => 'encode'); |
| 588 |
} elsif (not ($e_status & |
} elsif (not ($e_status & |
| 589 |
Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) { |
Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) { |
| 590 |
|
$self->{input_encoding} = $charset->get_iana_name; |
| 591 |
!!!parse-error (type => 'chardecode:no error', |
!!!parse-error (type => 'chardecode:no error', |
| 592 |
text => $self->{input_encoding}, |
text => $self->{input_encoding}, |
| 593 |
level => $self->{level}->{uncertain}, |
level => $self->{level}->{uncertain}, |
| 594 |
line => 1, column => 1, |
line => 1, column => 1, |
| 595 |
layer => 'encode'); |
layer => 'encode'); |
| 596 |
|
} else { |
| 597 |
|
$self->{input_encoding} = $charset->get_iana_name; |
| 598 |
} |
} |
| 599 |
$self->{confident} = 1; |
$self->{confident} = 1; |
| 600 |
$char_stream->onerror ($char_onerror); |
|
| 601 |
$return = $self->parse_char_stream ($char_stream, @args); |
$wrapped_char_stream = $get_wrapper->($char_stream); |
| 602 |
|
$wrapped_char_stream->onerror ($char_onerror); |
| 603 |
|
|
| 604 |
|
$return = $self->parse_char_stream ($wrapped_char_stream, @args); |
| 605 |
}; |
}; |
| 606 |
return $return; |
return $return; |
| 607 |
} # parse_byte_stream |
} # parse_byte_stream |
| 615 |
## such as |parse_byte_string| in this module, must ensure that it does |
## such as |parse_byte_string| in this module, must ensure that it does |
| 616 |
## strip the BOM and never strip any ZWNBSP. |
## strip the BOM and never strip any ZWNBSP. |
| 617 |
|
|
| 618 |
sub parse_char_string ($$$;$) { |
sub parse_char_string ($$$;$$) { |
| 619 |
|
#my ($self, $s, $doc, $onerror, $get_wrapper) = @_; |
| 620 |
my $self = shift; |
my $self = shift; |
|
require utf8; |
|
| 621 |
my $s = ref $_[0] ? $_[0] : \($_[0]); |
my $s = ref $_[0] ? $_[0] : \($_[0]); |
| 622 |
open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s; |
require Whatpm::Charset::DecodeHandle; |
| 623 |
|
my $input = Whatpm::Charset::DecodeHandle::CharString->new ($s); |
| 624 |
|
if ($_[3]) { |
| 625 |
|
$input = $_[3]->($input); |
| 626 |
|
} |
| 627 |
return $self->parse_char_stream ($input, @_[1..$#_]); |
return $self->parse_char_stream ($input, @_[1..$#_]); |
| 628 |
} # parse_char_string |
} # parse_char_string |
| 629 |
*parse_string = \&parse_char_string; |
*parse_string = \&parse_char_string; ## NOTE: Alias for backward compatibility. |
| 630 |
|
|
| 631 |
sub parse_char_stream ($$$;$) { |
sub parse_char_stream ($$$;$) { |
| 632 |
my $self = ref $_[0] ? shift : shift->new; |
my $self = ref $_[0] ? shift : shift->new; |
| 669 |
$self->{column} = 0; |
$self->{column} = 0; |
| 670 |
} elsif ($self->{next_char} == 0x000D) { # CR |
} elsif ($self->{next_char} == 0x000D) { # CR |
| 671 |
!!!cp ('j2'); |
!!!cp ('j2'); |
| 672 |
|
## TODO: support for abort/streaming |
| 673 |
my $next = $input->getc; |
my $next = $input->getc; |
| 674 |
if (defined $next and $next ne "\x0A") { |
if (defined $next and $next ne "\x0A") { |
| 675 |
$self->{next_next_char} = $next; |
$self->{next_next_char} = $next; |
| 689 |
(0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or |
(0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or |
| 690 |
(0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or |
(0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or |
| 691 |
(0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or |
(0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or |
| 692 |
|
## ISSUE: U+FDE0-U+FDEF are not excluded |
| 693 |
{ |
{ |
| 694 |
0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1, |
0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1, |
| 695 |
0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1, |
0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1, |
| 714 |
$self->{prev_char} = [-1, -1, -1]; |
$self->{prev_char} = [-1, -1, -1]; |
| 715 |
$self->{next_char} = -1; |
$self->{next_char} = -1; |
| 716 |
|
|
| 717 |
|
$self->{read_until} = sub { |
| 718 |
|
#my ($scalar, $specials_range, $offset) = @_; |
| 719 |
|
my $specials_range = $_[1]; |
| 720 |
|
return 0 if defined $self->{next_next_char}; |
| 721 |
|
my $count = $input->manakai_read_until |
| 722 |
|
($_[0], |
| 723 |
|
qr/(?![$specials_range\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/, |
| 724 |
|
$_[2]); |
| 725 |
|
if ($count) { |
| 726 |
|
$self->{column} += $count; |
| 727 |
|
$self->{column_prev} += $count; |
| 728 |
|
$self->{prev_char} = [-1, -1, -1]; |
| 729 |
|
$self->{next_char} = -1; |
| 730 |
|
} |
| 731 |
|
return $count; |
| 732 |
|
}; # $self->{read_until} |
| 733 |
|
|
| 734 |
my $onerror = $_[2] || sub { |
my $onerror = $_[2] || sub { |
| 735 |
my (%opt) = @_; |
my (%opt) = @_; |
| 736 |
my $line = $opt{token} ? $opt{token}->{line} : $opt{line}; |
my $line = $opt{token} ? $opt{token}->{line} : $opt{line}; |
| 755 |
my $class = shift; |
my $class = shift; |
| 756 |
my $self = bless { |
my $self = bless { |
| 757 |
level => {must => 'm', |
level => {must => 'm', |
| 758 |
|
should => 's', |
| 759 |
warn => 'w', |
warn => 'w', |
| 760 |
info => 'i', |
info => 'i', |
| 761 |
uncertain => 'u'}, |
uncertain => 'u'}, |
| 788 |
sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP } |
sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP } |
| 789 |
|
|
| 790 |
sub DATA_STATE () { 0 } |
sub DATA_STATE () { 0 } |
| 791 |
sub ENTITY_DATA_STATE () { 1 } |
#sub ENTITY_DATA_STATE () { 1 } |
| 792 |
sub TAG_OPEN_STATE () { 2 } |
sub TAG_OPEN_STATE () { 2 } |
| 793 |
sub CLOSE_TAG_OPEN_STATE () { 3 } |
sub CLOSE_TAG_OPEN_STATE () { 3 } |
| 794 |
sub TAG_NAME_STATE () { 4 } |
sub TAG_NAME_STATE () { 4 } |
| 799 |
sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 } |
sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 } |
| 800 |
sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 } |
sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 } |
| 801 |
sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 } |
sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 } |
| 802 |
sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 } |
#sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 } |
| 803 |
sub MARKUP_DECLARATION_OPEN_STATE () { 13 } |
sub MARKUP_DECLARATION_OPEN_STATE () { 13 } |
| 804 |
sub COMMENT_START_STATE () { 14 } |
sub COMMENT_START_STATE () { 14 } |
| 805 |
sub COMMENT_START_DASH_STATE () { 15 } |
sub COMMENT_START_DASH_STATE () { 15 } |
| 822 |
sub BOGUS_DOCTYPE_STATE () { 32 } |
sub BOGUS_DOCTYPE_STATE () { 32 } |
| 823 |
sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 } |
sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 } |
| 824 |
sub SELF_CLOSING_START_TAG_STATE () { 34 } |
sub SELF_CLOSING_START_TAG_STATE () { 34 } |
| 825 |
sub CDATA_BLOCK_STATE () { 35 } |
sub CDATA_SECTION_STATE () { 35 } |
| 826 |
|
sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec |
| 827 |
|
sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec |
| 828 |
|
sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec |
| 829 |
|
sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec |
| 830 |
|
sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec |
| 831 |
|
sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec |
| 832 |
|
sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec |
| 833 |
|
sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec |
| 834 |
|
## NOTE: "Entity data state", "entity in attribute value state", and |
| 835 |
|
## "consume a character reference" algorithm are jointly implemented |
| 836 |
|
## using the following six states: |
| 837 |
|
sub ENTITY_STATE () { 44 } |
| 838 |
|
sub ENTITY_HASH_STATE () { 45 } |
| 839 |
|
sub NCR_NUM_STATE () { 46 } |
| 840 |
|
sub HEXREF_X_STATE () { 47 } |
| 841 |
|
sub HEXREF_HEX_STATE () { 48 } |
| 842 |
|
sub ENTITY_NAME_STATE () { 49 } |
| 843 |
|
|
| 844 |
sub DOCTYPE_TOKEN () { 1 } |
sub DOCTYPE_TOKEN () { 1 } |
| 845 |
sub COMMENT_TOKEN () { 2 } |
sub COMMENT_TOKEN () { 2 } |
| 892 |
sub _initialize_tokenizer ($) { |
sub _initialize_tokenizer ($) { |
| 893 |
my $self = shift; |
my $self = shift; |
| 894 |
$self->{state} = DATA_STATE; # MUST |
$self->{state} = DATA_STATE; # MUST |
| 895 |
|
#$self->{state_keyword}; # initialized when used |
| 896 |
|
#$self->{entity__value}; # initialized when used |
| 897 |
|
#$self->{entity__match}; # initialized when used |
| 898 |
$self->{content_model} = PCDATA_CONTENT_MODEL; # be |
$self->{content_model} = PCDATA_CONTENT_MODEL; # be |
| 899 |
undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE |
undef $self->{current_token}; |
| 900 |
undef $self->{current_attribute}; |
undef $self->{current_attribute}; |
| 901 |
undef $self->{last_emitted_start_tag_name}; |
undef $self->{last_emitted_start_tag_name}; |
| 902 |
undef $self->{last_attribute_value_state}; |
#$self->{prev_state}; # initialized when used |
| 903 |
delete $self->{self_closing}; |
delete $self->{self_closing}; |
|
$self->{char} = []; |
|
| 904 |
# $self->{next_char} |
# $self->{next_char} |
| 905 |
!!!next-input-character; |
!!!next-input-character; |
| 906 |
$self->{token} = []; |
$self->{token} = []; |
| 932 |
## has completed loading. If one has, then it MUST be executed |
## has completed loading. If one has, then it MUST be executed |
| 933 |
## and removed from the list. |
## and removed from the list. |
| 934 |
|
|
| 935 |
## NOTE: HTML5 "Writing HTML documents" section, applied to |
## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.) |
| 936 |
## documents and not to user agents and conformance checkers, |
## (This requirement was dropped from HTML5 spec, unfortunately.) |
|
## contains some requirements that are not detected by the |
|
|
## parsing algorithm: |
|
|
## - Some requirements on character encoding declarations. ## TODO |
|
|
## - "Elements MUST NOT contain content that their content model disallows." |
|
|
## ... Some are parse error, some are not (will be reported by c.c.). |
|
|
## - Polytheistic slash SHOULD NOT be used. (Applied only to atheists.) ## TODO |
|
|
## - Text (in elements, attributes, and comments) SHOULD NOT contain |
|
|
## control characters other than space characters. ## TODO: (what is control character? C0, C1 and DEL? Unicode control character?) |
|
|
|
|
|
## TODO: HTML5 poses authors two SHOULD-level requirements that cannot |
|
|
## be detected by the HTML5 parsing algorithm: |
|
|
## - Text, |
|
| 937 |
|
|
| 938 |
sub _get_next_token ($) { |
sub _get_next_token ($) { |
| 939 |
my $self = shift; |
my $self = shift; |
| 957 |
if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA |
if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA |
| 958 |
not $self->{escape}) { |
not $self->{escape}) { |
| 959 |
!!!cp (1); |
!!!cp (1); |
| 960 |
$self->{state} = ENTITY_DATA_STATE; |
## NOTE: In the spec, the tokenizer is switched to the |
| 961 |
|
## "entity data state". In this implementation, the tokenizer |
| 962 |
|
## is switched to the |ENTITY_STATE|, which is an implementation |
| 963 |
|
## of the "consume a character reference" algorithm. |
| 964 |
|
$self->{entity_additional} = -1; |
| 965 |
|
$self->{prev_state} = DATA_STATE; |
| 966 |
|
$self->{state} = ENTITY_STATE; |
| 967 |
!!!next-input-character; |
!!!next-input-character; |
| 968 |
redo A; |
redo A; |
| 969 |
} else { |
} else { |
| 1027 |
data => chr $self->{next_char}, |
data => chr $self->{next_char}, |
| 1028 |
line => $self->{line}, column => $self->{column}, |
line => $self->{line}, column => $self->{column}, |
| 1029 |
}; |
}; |
| 1030 |
|
$self->{read_until}->($token->{data}, q[-!<>&], length $token->{data}); |
| 1031 |
|
|
| 1032 |
## Stay in the data state |
## Stay in the data state |
| 1033 |
!!!next-input-character; |
!!!next-input-character; |
| 1034 |
|
|
| 1035 |
!!!emit ($token); |
!!!emit ($token); |
| 1036 |
|
|
| 1037 |
redo A; |
redo A; |
|
} elsif ($self->{state} == ENTITY_DATA_STATE) { |
|
|
## (cannot happen in CDATA state) |
|
|
|
|
|
my ($l, $c) = ($self->{line_prev}, $self->{column_prev}); |
|
|
|
|
|
my $token = $self->_tokenize_attempt_to_consume_an_entity (0, -1); |
|
|
|
|
|
$self->{state} = DATA_STATE; |
|
|
# next-input-character is already done |
|
|
|
|
|
unless (defined $token) { |
|
|
!!!cp (13); |
|
|
!!!emit ({type => CHARACTER_TOKEN, data => '&', |
|
|
line => $l, column => $c, |
|
|
}); |
|
|
} else { |
|
|
!!!cp (14); |
|
|
!!!emit ($token); |
|
|
} |
|
|
|
|
|
redo A; |
|
| 1038 |
} elsif ($self->{state} == TAG_OPEN_STATE) { |
} elsif ($self->{state} == TAG_OPEN_STATE) { |
| 1039 |
if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA |
if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA |
| 1040 |
if ($self->{next_char} == 0x002F) { # / |
if ($self->{next_char} == 0x002F) { # / |
| 1131 |
die "$0: $self->{content_model} in tag open"; |
die "$0: $self->{content_model} in tag open"; |
| 1132 |
} |
} |
| 1133 |
} elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) { |
} elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) { |
| 1134 |
|
## NOTE: The "close tag open state" in the spec is implemented as |
| 1135 |
|
## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|. |
| 1136 |
|
|
| 1137 |
my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</" |
my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</" |
| 1138 |
if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA |
if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA |
| 1139 |
if (defined $self->{last_emitted_start_tag_name}) { |
if (defined $self->{last_emitted_start_tag_name}) { |
| 1140 |
|
$self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE; |
| 1141 |
## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564> |
$self->{state_keyword} = ''; |
| 1142 |
my @next_char; |
## Reconsume. |
| 1143 |
TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) { |
redo A; |
|
push @next_char, $self->{next_char}; |
|
|
my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1); |
|
|
my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c; |
|
|
if ($self->{next_char} == $c or $self->{next_char} == $C) { |
|
|
!!!cp (24); |
|
|
!!!next-input-character; |
|
|
next TAGNAME; |
|
|
} else { |
|
|
!!!cp (25); |
|
|
$self->{next_char} = shift @next_char; # reconsume |
|
|
!!!back-next-input-character (@next_char); |
|
|
$self->{state} = DATA_STATE; |
|
|
|
|
|
!!!emit ({type => CHARACTER_TOKEN, data => '</', |
|
|
line => $l, column => $c, |
|
|
}); |
|
|
|
|
|
redo A; |
|
|
} |
|
|
} |
|
|
push @next_char, $self->{next_char}; |
|
|
|
|
|
unless ($self->{next_char} == 0x0009 or # HT |
|
|
$self->{next_char} == 0x000A or # LF |
|
|
$self->{next_char} == 0x000B or # VT |
|
|
$self->{next_char} == 0x000C or # FF |
|
|
$self->{next_char} == 0x0020 or # SP |
|
|
$self->{next_char} == 0x003E or # > |
|
|
$self->{next_char} == 0x002F or # / |
|
|
$self->{next_char} == -1) { |
|
|
!!!cp (26); |
|
|
$self->{next_char} = shift @next_char; # reconsume |
|
|
!!!back-next-input-character (@next_char); |
|
|
$self->{state} = DATA_STATE; |
|
|
!!!emit ({type => CHARACTER_TOKEN, data => '</', |
|
|
line => $l, column => $c, |
|
|
}); |
|
|
redo A; |
|
|
} else { |
|
|
!!!cp (27); |
|
|
$self->{next_char} = shift @next_char; |
|
|
!!!back-next-input-character (@next_char); |
|
|
# and consume... |
|
|
} |
|
| 1144 |
} else { |
} else { |
| 1145 |
## No start tag token has ever been emitted |
## No start tag token has ever been emitted |
| 1146 |
|
## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>. |
| 1147 |
!!!cp (28); |
!!!cp (28); |
|
# next-input-character is already done |
|
| 1148 |
$self->{state} = DATA_STATE; |
$self->{state} = DATA_STATE; |
| 1149 |
|
## Reconsume. |
| 1150 |
!!!emit ({type => CHARACTER_TOKEN, data => '</', |
!!!emit ({type => CHARACTER_TOKEN, data => '</', |
| 1151 |
line => $l, column => $c, |
line => $l, column => $c, |
| 1152 |
}); |
}); |
| 1153 |
redo A; |
redo A; |
| 1154 |
} |
} |
| 1155 |
} |
} |
| 1156 |
|
|
| 1157 |
if (0x0041 <= $self->{next_char} and |
if (0x0041 <= $self->{next_char} and |
| 1158 |
$self->{next_char} <= 0x005A) { # A..Z |
$self->{next_char} <= 0x005A) { # A..Z |
| 1159 |
!!!cp (29); |
!!!cp (29); |
| 1200 |
line => $self->{line_prev}, # "<" of "</" |
line => $self->{line_prev}, # "<" of "</" |
| 1201 |
column => $self->{column_prev} - 1, |
column => $self->{column_prev} - 1, |
| 1202 |
}; |
}; |
| 1203 |
## $self->{next_char} is intentionally left as is |
## NOTE: $self->{next_char} is intentionally left as is. |
| 1204 |
redo A; |
## Although the "anything else" case of the spec not explicitly |
| 1205 |
|
## states that the next input character is to be reconsumed, |
| 1206 |
|
## it will be included to the |data| of the comment token |
| 1207 |
|
## generated from the bogus end tag, as defined in the |
| 1208 |
|
## "bogus comment state" entry. |
| 1209 |
|
redo A; |
| 1210 |
|
} |
| 1211 |
|
} elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) { |
| 1212 |
|
my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1; |
| 1213 |
|
if (length $ch) { |
| 1214 |
|
my $CH = $ch; |
| 1215 |
|
$ch =~ tr/a-z/A-Z/; |
| 1216 |
|
my $nch = chr $self->{next_char}; |
| 1217 |
|
if ($nch eq $ch or $nch eq $CH) { |
| 1218 |
|
!!!cp (24); |
| 1219 |
|
## Stay in the state. |
| 1220 |
|
$self->{state_keyword} .= $nch; |
| 1221 |
|
!!!next-input-character; |
| 1222 |
|
redo A; |
| 1223 |
|
} else { |
| 1224 |
|
!!!cp (25); |
| 1225 |
|
$self->{state} = DATA_STATE; |
| 1226 |
|
## Reconsume. |
| 1227 |
|
!!!emit ({type => CHARACTER_TOKEN, |
| 1228 |
|
data => '</' . $self->{state_keyword}, |
| 1229 |
|
line => $self->{line_prev}, |
| 1230 |
|
column => $self->{column_prev} - 1 - length $self->{state_keyword}, |
| 1231 |
|
}); |
| 1232 |
|
redo A; |
| 1233 |
|
} |
| 1234 |
|
} else { # after "<{tag-name}" |
| 1235 |
|
unless ({ |
| 1236 |
|
0x0009 => 1, # HT |
| 1237 |
|
0x000A => 1, # LF |
| 1238 |
|
0x000B => 1, # VT |
| 1239 |
|
0x000C => 1, # FF |
| 1240 |
|
0x0020 => 1, # SP |
| 1241 |
|
0x003E => 1, # > |
| 1242 |
|
0x002F => 1, # / |
| 1243 |
|
-1 => 1, # EOF |
| 1244 |
|
}->{$self->{next_char}}) { |
| 1245 |
|
!!!cp (26); |
| 1246 |
|
## Reconsume. |
| 1247 |
|
$self->{state} = DATA_STATE; |
| 1248 |
|
!!!emit ({type => CHARACTER_TOKEN, |
| 1249 |
|
data => '</' . $self->{state_keyword}, |
| 1250 |
|
line => $self->{line_prev}, |
| 1251 |
|
column => $self->{column_prev} - 1 - length $self->{state_keyword}, |
| 1252 |
|
}); |
| 1253 |
|
redo A; |
| 1254 |
|
} else { |
| 1255 |
|
!!!cp (27); |
| 1256 |
|
$self->{current_token} |
| 1257 |
|
= {type => END_TAG_TOKEN, |
| 1258 |
|
tag_name => $self->{last_emitted_start_tag_name}, |
| 1259 |
|
line => $self->{line_prev}, |
| 1260 |
|
column => $self->{column_prev} - 1 - length $self->{state_keyword}}; |
| 1261 |
|
$self->{state} = TAG_NAME_STATE; |
| 1262 |
|
## Reconsume. |
| 1263 |
|
redo A; |
| 1264 |
|
} |
| 1265 |
} |
} |
| 1266 |
} elsif ($self->{state} == TAG_NAME_STATE) { |
} elsif ($self->{state} == TAG_NAME_STATE) { |
| 1267 |
if ($self->{next_char} == 0x0009 or # HT |
if ($self->{next_char} == 0x0009 or # HT |
| 1602 |
|
|
| 1603 |
redo A; |
redo A; |
| 1604 |
} else { |
} else { |
| 1605 |
!!!cp (82); |
if ($self->{next_char} == 0x0022 or # " |
| 1606 |
|
$self->{next_char} == 0x0027) { # ' |
| 1607 |
|
!!!cp (78); |
| 1608 |
|
!!!parse-error (type => 'bad attribute name'); |
| 1609 |
|
} else { |
| 1610 |
|
!!!cp (82); |
| 1611 |
|
} |
| 1612 |
$self->{current_attribute} |
$self->{current_attribute} |
| 1613 |
= {name => chr ($self->{next_char}), |
= {name => chr ($self->{next_char}), |
| 1614 |
value => '', |
value => '', |
| 1643 |
!!!next-input-character; |
!!!next-input-character; |
| 1644 |
redo A; |
redo A; |
| 1645 |
} elsif ($self->{next_char} == 0x003E) { # > |
} elsif ($self->{next_char} == 0x003E) { # > |
| 1646 |
|
!!!parse-error (type => 'empty unquoted attribute value'); |
| 1647 |
if ($self->{current_token}->{type} == START_TAG_TOKEN) { |
if ($self->{current_token}->{type} == START_TAG_TOKEN) { |
| 1648 |
!!!cp (87); |
!!!cp (87); |
| 1649 |
$self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; |
$self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name}; |
| 1708 |
redo A; |
redo A; |
| 1709 |
} elsif ($self->{next_char} == 0x0026) { # & |
} elsif ($self->{next_char} == 0x0026) { # & |
| 1710 |
!!!cp (96); |
!!!cp (96); |
| 1711 |
$self->{last_attribute_value_state} = $self->{state}; |
## NOTE: In the spec, the tokenizer is switched to the |
| 1712 |
$self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE; |
## "entity in attribute value state". In this implementation, the |
| 1713 |
|
## tokenizer is switched to the |ENTITY_STATE|, which is an |
| 1714 |
|
## implementation of the "consume a character reference" algorithm. |
| 1715 |
|
$self->{prev_state} = $self->{state}; |
| 1716 |
|
$self->{entity_additional} = 0x0022; # " |
| 1717 |
|
$self->{state} = ENTITY_STATE; |
| 1718 |
!!!next-input-character; |
!!!next-input-character; |
| 1719 |
redo A; |
redo A; |
| 1720 |
} elsif ($self->{next_char} == -1) { |
} elsif ($self->{next_char} == -1) { |
| 1755 |
redo A; |
redo A; |
| 1756 |
} elsif ($self->{next_char} == 0x0026) { # & |
} elsif ($self->{next_char} == 0x0026) { # & |
| 1757 |
!!!cp (102); |
!!!cp (102); |
| 1758 |
$self->{last_attribute_value_state} = $self->{state}; |
## NOTE: In the spec, the tokenizer is switched to the |
| 1759 |
$self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE; |
## "entity in attribute value state". In this implementation, the |
| 1760 |
|
## tokenizer is switched to the |ENTITY_STATE|, which is an |
| 1761 |
|
## implementation of the "consume a character reference" algorithm. |
| 1762 |
|
$self->{entity_additional} = 0x0027; # ' |
| 1763 |
|
$self->{prev_state} = $self->{state}; |
| 1764 |
|
$self->{state} = ENTITY_STATE; |
| 1765 |
!!!next-input-character; |
!!!next-input-character; |
| 1766 |
redo A; |
redo A; |
| 1767 |
} elsif ($self->{next_char} == -1) { |
} elsif ($self->{next_char} == -1) { |
| 1806 |
redo A; |
redo A; |
| 1807 |
} elsif ($self->{next_char} == 0x0026) { # & |
} elsif ($self->{next_char} == 0x0026) { # & |
| 1808 |
!!!cp (108); |
!!!cp (108); |
| 1809 |
$self->{last_attribute_value_state} = $self->{state}; |
## NOTE: In the spec, the tokenizer is switched to the |
| 1810 |
$self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE; |
## "entity in attribute value state". In this implementation, the |
| 1811 |
|
## tokenizer is switched to the |ENTITY_STATE|, which is an |
| 1812 |
|
## implementation of the "consume a character reference" algorithm. |
| 1813 |
|
$self->{entity_additional} = -1; |
| 1814 |
|
$self->{prev_state} = $self->{state}; |
| 1815 |
|
$self->{state} = ENTITY_STATE; |
| 1816 |
!!!next-input-character; |
!!!next-input-character; |
| 1817 |
redo A; |
redo A; |
| 1818 |
} elsif ($self->{next_char} == 0x003E) { # > |
} elsif ($self->{next_char} == 0x003E) { # > |
| 1876 |
!!!next-input-character; |
!!!next-input-character; |
| 1877 |
redo A; |
redo A; |
| 1878 |
} |
} |
|
} elsif ($self->{state} == ENTITY_IN_ATTRIBUTE_VALUE_STATE) { |
|
|
my $token = $self->_tokenize_attempt_to_consume_an_entity |
|
|
(1, |
|
|
$self->{last_attribute_value_state} |
|
|
== ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE ? 0x0022 : # " |
|
|
$self->{last_attribute_value_state} |
|
|
== ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE ? 0x0027 : # ' |
|
|
-1); |
|
|
|
|
|
unless (defined $token) { |
|
|
!!!cp (117); |
|
|
$self->{current_attribute}->{value} .= '&'; |
|
|
} else { |
|
|
!!!cp (118); |
|
|
$self->{current_attribute}->{value} .= $token->{data}; |
|
|
$self->{current_attribute}->{has_reference} = $token->{has_reference}; |
|
|
## ISSUE: spec says "append the returned character token to the current attribute's value" |
|
|
} |
|
|
|
|
|
$self->{state} = $self->{last_attribute_value_state}; |
|
|
# next-input-character is already done |
|
|
redo A; |
|
| 1879 |
} elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) { |
} elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) { |
| 1880 |
if ($self->{next_char} == 0x0009 or # HT |
if ($self->{next_char} == 0x0009 or # HT |
| 1881 |
$self->{next_char} == 0x000A or # LF |
$self->{next_char} == 0x000A or # LF |
| 1995 |
} |
} |
| 1996 |
} elsif ($self->{state} == BOGUS_COMMENT_STATE) { |
} elsif ($self->{state} == BOGUS_COMMENT_STATE) { |
| 1997 |
## (only happen if PCDATA state) |
## (only happen if PCDATA state) |
|
|
|
|
## NOTE: Set by the previous state |
|
|
#my $token = {type => COMMENT_TOKEN, data => ''}; |
|
| 1998 |
|
|
| 1999 |
BC: { |
## NOTE: Unlike spec's "bogus comment state", this implementation |
| 2000 |
if ($self->{next_char} == 0x003E) { # > |
## consumes characters one-by-one basis. |
| 2001 |
!!!cp (124); |
|
| 2002 |
$self->{state} = DATA_STATE; |
if ($self->{next_char} == 0x003E) { # > |
| 2003 |
!!!next-input-character; |
!!!cp (124); |
| 2004 |
|
$self->{state} = DATA_STATE; |
| 2005 |
!!!emit ($self->{current_token}); # comment |
!!!next-input-character; |
|
|
|
|
redo A; |
|
|
} elsif ($self->{next_char} == -1) { |
|
|
!!!cp (125); |
|
|
$self->{state} = DATA_STATE; |
|
|
## reconsume |
|
|
|
|
|
!!!emit ($self->{current_token}); # comment |
|
| 2006 |
|
|
| 2007 |
redo A; |
!!!emit ($self->{current_token}); # comment |
| 2008 |
} else { |
redo A; |
| 2009 |
!!!cp (126); |
} elsif ($self->{next_char} == -1) { |
| 2010 |
$self->{current_token}->{data} .= chr ($self->{next_char}); # comment |
!!!cp (125); |
| 2011 |
!!!next-input-character; |
$self->{state} = DATA_STATE; |
| 2012 |
redo BC; |
## reconsume |
|
} |
|
|
} # BC |
|
| 2013 |
|
|
| 2014 |
die "$0: _get_next_token: unexpected case [BC]"; |
!!!emit ($self->{current_token}); # comment |
| 2015 |
|
redo A; |
| 2016 |
|
} else { |
| 2017 |
|
!!!cp (126); |
| 2018 |
|
$self->{current_token}->{data} .= chr ($self->{next_char}); # comment |
| 2019 |
|
## Stay in the state. |
| 2020 |
|
!!!next-input-character; |
| 2021 |
|
redo A; |
| 2022 |
|
} |
| 2023 |
} elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) { |
} elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) { |
| 2024 |
## (only happen if PCDATA state) |
## (only happen if PCDATA state) |
|
|
|
|
my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); |
|
|
|
|
|
my @next_char; |
|
|
push @next_char, $self->{next_char}; |
|
| 2025 |
|
|
| 2026 |
if ($self->{next_char} == 0x002D) { # - |
if ($self->{next_char} == 0x002D) { # - |
| 2027 |
|
!!!cp (133); |
| 2028 |
|
$self->{state} = MD_HYPHEN_STATE; |
| 2029 |
!!!next-input-character; |
!!!next-input-character; |
| 2030 |
push @next_char, $self->{next_char}; |
redo A; |
|
if ($self->{next_char} == 0x002D) { # - |
|
|
!!!cp (127); |
|
|
$self->{current_token} = {type => COMMENT_TOKEN, data => '', |
|
|
line => $l, column => $c, |
|
|
}; |
|
|
$self->{state} = COMMENT_START_STATE; |
|
|
!!!next-input-character; |
|
|
redo A; |
|
|
} else { |
|
|
!!!cp (128); |
|
|
} |
|
| 2031 |
} elsif ($self->{next_char} == 0x0044 or # D |
} elsif ($self->{next_char} == 0x0044 or # D |
| 2032 |
$self->{next_char} == 0x0064) { # d |
$self->{next_char} == 0x0064) { # d |
| 2033 |
|
## ASCII case-insensitive. |
| 2034 |
|
!!!cp (130); |
| 2035 |
|
$self->{state} = MD_DOCTYPE_STATE; |
| 2036 |
|
$self->{state_keyword} = chr $self->{next_char}; |
| 2037 |
!!!next-input-character; |
!!!next-input-character; |
| 2038 |
push @next_char, $self->{next_char}; |
redo A; |
|
if ($self->{next_char} == 0x004F or # O |
|
|
$self->{next_char} == 0x006F) { # o |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x0043 or # C |
|
|
$self->{next_char} == 0x0063) { # c |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x0054 or # T |
|
|
$self->{next_char} == 0x0074) { # t |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x0059 or # Y |
|
|
$self->{next_char} == 0x0079) { # y |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x0050 or # P |
|
|
$self->{next_char} == 0x0070) { # p |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x0045 or # E |
|
|
$self->{next_char} == 0x0065) { # e |
|
|
!!!cp (129); |
|
|
## TODO: What a stupid code this is! |
|
|
$self->{state} = DOCTYPE_STATE; |
|
|
$self->{current_token} = {type => DOCTYPE_TOKEN, |
|
|
quirks => 1, |
|
|
line => $l, column => $c, |
|
|
}; |
|
|
!!!next-input-character; |
|
|
redo A; |
|
|
} else { |
|
|
!!!cp (130); |
|
|
} |
|
|
} else { |
|
|
!!!cp (131); |
|
|
} |
|
|
} else { |
|
|
!!!cp (132); |
|
|
} |
|
|
} else { |
|
|
!!!cp (133); |
|
|
} |
|
|
} else { |
|
|
!!!cp (134); |
|
|
} |
|
|
} else { |
|
|
!!!cp (135); |
|
|
} |
|
| 2039 |
} elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and |
} elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and |
| 2040 |
$self->{open_elements}->[-1]->[1] & FOREIGN_EL and |
$self->{open_elements}->[-1]->[1] & FOREIGN_EL and |
| 2041 |
$self->{next_char} == 0x005B) { # [ |
$self->{next_char} == 0x005B) { # [ |
| 2042 |
|
!!!cp (135.4); |
| 2043 |
|
$self->{state} = MD_CDATA_STATE; |
| 2044 |
|
$self->{state_keyword} = '['; |
| 2045 |
!!!next-input-character; |
!!!next-input-character; |
| 2046 |
push @next_char, $self->{next_char}; |
redo A; |
|
if ($self->{next_char} == 0x0043) { # C |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x0044) { # D |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x0041) { # A |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x0054) { # T |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x0041) { # A |
|
|
!!!next-input-character; |
|
|
push @next_char, $self->{next_char}; |
|
|
if ($self->{next_char} == 0x005B) { # [ |
|
|
!!!cp (135.1); |
|
|
$self->{state} = CDATA_BLOCK_STATE; |
|
|
!!!next-input-character; |
|
|
redo A; |
|
|
} else { |
|
|
!!!cp (135.2); |
|
|
} |
|
|
} else { |
|
|
!!!cp (135.3); |
|
|
} |
|
|
} else { |
|
|
!!!cp (135.4); |
|
|
} |
|
|
} else { |
|
|
!!!cp (135.5); |
|
|
} |
|
|
} else { |
|
|
!!!cp (135.6); |
|
|
} |
|
|
} else { |
|
|
!!!cp (135.7); |
|
|
} |
|
| 2047 |
} else { |
} else { |
| 2048 |
!!!cp (136); |
!!!cp (136); |
| 2049 |
} |
} |
| 2050 |
|
|
| 2051 |
!!!parse-error (type => 'bogus comment'); |
!!!parse-error (type => 'bogus comment', |
| 2052 |
$self->{next_char} = shift @next_char; |
line => $self->{line_prev}, |
| 2053 |
!!!back-next-input-character (@next_char); |
column => $self->{column_prev} - 1); |
| 2054 |
|
## Reconsume. |
| 2055 |
$self->{state} = BOGUS_COMMENT_STATE; |
$self->{state} = BOGUS_COMMENT_STATE; |
| 2056 |
$self->{current_token} = {type => COMMENT_TOKEN, data => '', |
$self->{current_token} = {type => COMMENT_TOKEN, data => '', |
| 2057 |
line => $l, column => $c, |
line => $self->{line_prev}, |
| 2058 |
|
column => $self->{column_prev} - 1, |
| 2059 |
}; |
}; |
| 2060 |
redo A; |
redo A; |
| 2061 |
|
} elsif ($self->{state} == MD_HYPHEN_STATE) { |
| 2062 |
## ISSUE: typos in spec: chacacters, is is a parse error |
if ($self->{next_char} == 0x002D) { # - |
| 2063 |
## ISSUE: spec is somewhat unclear on "is the first character that will be in the comment"; what is "that will be in the comment" is what the algorithm defines, isn't it? |
!!!cp (127); |
| 2064 |
|
$self->{current_token} = {type => COMMENT_TOKEN, data => '', |
| 2065 |
|
line => $self->{line_prev}, |
| 2066 |
|
column => $self->{column_prev} - 2, |
| 2067 |
|
}; |
| 2068 |
|
$self->{state} = COMMENT_START_STATE; |
| 2069 |
|
!!!next-input-character; |
| 2070 |
|
redo A; |
| 2071 |
|
} else { |
| 2072 |
|
!!!cp (128); |
| 2073 |
|
!!!parse-error (type => 'bogus comment', |
| 2074 |
|
line => $self->{line_prev}, |
| 2075 |
|
column => $self->{column_prev} - 2); |
| 2076 |
|
$self->{state} = BOGUS_COMMENT_STATE; |
| 2077 |
|
## Reconsume. |
| 2078 |
|
$self->{current_token} = {type => COMMENT_TOKEN, |
| 2079 |
|
data => '-', |
| 2080 |
|
line => $self->{line_prev}, |
| 2081 |
|
column => $self->{column_prev} - 2, |
| 2082 |
|
}; |
| 2083 |
|
redo A; |
| 2084 |
|
} |
| 2085 |
|
} elsif ($self->{state} == MD_DOCTYPE_STATE) { |
| 2086 |
|
## ASCII case-insensitive. |
| 2087 |
|
if ($self->{next_char} == [ |
| 2088 |
|
undef, |
| 2089 |
|
0x004F, # O |
| 2090 |
|
0x0043, # C |
| 2091 |
|
0x0054, # T |
| 2092 |
|
0x0059, # Y |
| 2093 |
|
0x0050, # P |
| 2094 |
|
]->[length $self->{state_keyword}] or |
| 2095 |
|
$self->{next_char} == [ |
| 2096 |
|
undef, |
| 2097 |
|
0x006F, # o |
| 2098 |
|
0x0063, # c |
| 2099 |
|
0x0074, # t |
| 2100 |
|
0x0079, # y |
| 2101 |
|
0x0070, # p |
| 2102 |
|
]->[length $self->{state_keyword}]) { |
| 2103 |
|
!!!cp (131); |
| 2104 |
|
## Stay in the state. |
| 2105 |
|
$self->{state_keyword} .= chr $self->{next_char}; |
| 2106 |
|
!!!next-input-character; |
| 2107 |
|
redo A; |
| 2108 |
|
} elsif ((length $self->{state_keyword}) == 6 and |
| 2109 |
|
($self->{next_char} == 0x0045 or # E |
| 2110 |
|
$self->{next_char} == 0x0065)) { # e |
| 2111 |
|
!!!cp (129); |
| 2112 |
|
$self->{state} = DOCTYPE_STATE; |
| 2113 |
|
$self->{current_token} = {type => DOCTYPE_TOKEN, |
| 2114 |
|
quirks => 1, |
| 2115 |
|
line => $self->{line_prev}, |
| 2116 |
|
column => $self->{column_prev} - 7, |
| 2117 |
|
}; |
| 2118 |
|
!!!next-input-character; |
| 2119 |
|
redo A; |
| 2120 |
|
} else { |
| 2121 |
|
!!!cp (132); |
| 2122 |
|
!!!parse-error (type => 'bogus comment', |
| 2123 |
|
line => $self->{line_prev}, |
| 2124 |
|
column => $self->{column_prev} - 1 - length $self->{state_keyword}); |
| 2125 |
|
$self->{state} = BOGUS_COMMENT_STATE; |
| 2126 |
|
## Reconsume. |
| 2127 |
|
$self->{current_token} = {type => COMMENT_TOKEN, |
| 2128 |
|
data => $self->{state_keyword}, |
| 2129 |
|
line => $self->{line_prev}, |
| 2130 |
|
column => $self->{column_prev} - 1 - length $self->{state_keyword}, |
| 2131 |
|
}; |
| 2132 |
|
redo A; |
| 2133 |
|
} |
| 2134 |
|
} elsif ($self->{state} == MD_CDATA_STATE) { |
| 2135 |
|
if ($self->{next_char} == { |
| 2136 |
|
'[' => 0x0043, # C |
| 2137 |
|
'[C' => 0x0044, # D |
| 2138 |
|
'[CD' => 0x0041, # A |
| 2139 |
|
'[CDA' => 0x0054, # T |
| 2140 |
|
'[CDAT' => 0x0041, # A |
| 2141 |
|
}->{$self->{state_keyword}}) { |
| 2142 |
|
!!!cp (135.1); |
| 2143 |
|
## Stay in the state. |
| 2144 |
|
$self->{state_keyword} .= chr $self->{next_char}; |
| 2145 |
|
!!!next-input-character; |
| 2146 |
|
redo A; |
| 2147 |
|
} elsif ($self->{state_keyword} eq '[CDATA' and |
| 2148 |
|
$self->{next_char} == 0x005B) { # [ |
| 2149 |
|
!!!cp (135.2); |
| 2150 |
|
$self->{current_token} = {type => CHARACTER_TOKEN, |
| 2151 |
|
data => '', |
| 2152 |
|
line => $self->{line_prev}, |
| 2153 |
|
column => $self->{column_prev} - 7}; |
| 2154 |
|
$self->{state} = CDATA_SECTION_STATE; |
| 2155 |
|
!!!next-input-character; |
| 2156 |
|
redo A; |
| 2157 |
|
} else { |
| 2158 |
|
!!!cp (135.3); |
| 2159 |
|
!!!parse-error (type => 'bogus comment', |
| 2160 |
|
line => $self->{line_prev}, |
| 2161 |
|
column => $self->{column_prev} - 1 - length $self->{state_keyword}); |
| 2162 |
|
$self->{state} = BOGUS_COMMENT_STATE; |
| 2163 |
|
## Reconsume. |
| 2164 |
|
$self->{current_token} = {type => COMMENT_TOKEN, |
| 2165 |
|
data => $self->{state_keyword}, |
| 2166 |
|
line => $self->{line_prev}, |
| 2167 |
|
column => $self->{column_prev} - 1 - length $self->{state_keyword}, |
| 2168 |
|
}; |
| 2169 |
|
redo A; |
| 2170 |
|
} |
| 2171 |
} elsif ($self->{state} == COMMENT_START_STATE) { |
} elsif ($self->{state} == COMMENT_START_STATE) { |
| 2172 |
if ($self->{next_char} == 0x002D) { # - |
if ($self->{next_char} == 0x002D) { # - |
| 2173 |
!!!cp (137); |
!!!cp (137); |
| 2434 |
redo A; |
redo A; |
| 2435 |
} elsif ($self->{next_char} == 0x0050 or # P |
} elsif ($self->{next_char} == 0x0050 or # P |
| 2436 |
$self->{next_char} == 0x0070) { # p |
$self->{next_char} == 0x0070) { # p |
| 2437 |
|
$self->{state} = PUBLIC_STATE; |
| 2438 |
|
$self->{state_keyword} = chr $self->{next_char}; |
| 2439 |
!!!next-input-character; |
!!!next-input-character; |
| 2440 |
if ($self->{next_char} == 0x0055 or # U |
redo A; |
|
$self->{next_char} == 0x0075) { # u |
|
|
!!!next-input-character; |
|
|
if ($self->{next_char} == 0x0042 or # B |
|
|
$self->{next_char} == 0x0062) { # b |
|
|
!!!next-input-character; |
|
|
if ($self->{next_char} == 0x004C or # L |
|
|
$self->{next_char} == 0x006C) { # l |
|
|
!!!next-input-character; |
|
|
if ($self->{next_char} == 0x0049 or # I |
|
|
$self->{next_char} == 0x0069) { # i |
|
|
!!!next-input-character; |
|
|
if ($self->{next_char} == 0x0043 or # C |
|
|
$self->{next_char} == 0x0063) { # c |
|
|
!!!cp (168); |
|
|
$self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE; |
|
|
!!!next-input-character; |
|
|
redo A; |
|
|
} else { |
|
|
!!!cp (169); |
|
|
} |
|
|
} else { |
|
|
!!!cp (170); |
|
|
} |
|
|
} else { |
|
|
!!!cp (171); |
|
|
} |
|
|
} else { |
|
|
!!!cp (172); |
|
|
} |
|
|
} else { |
|
|
!!!cp (173); |
|
|
} |
|
|
|
|
|
# |
|
| 2441 |
} elsif ($self->{next_char} == 0x0053 or # S |
} elsif ($self->{next_char} == 0x0053 or # S |
| 2442 |
$self->{next_char} == 0x0073) { # s |
$self->{next_char} == 0x0073) { # s |
| 2443 |
|
$self->{state} = SYSTEM_STATE; |
| 2444 |
|
$self->{state_keyword} = chr $self->{next_char}; |
| 2445 |
!!!next-input-character; |
!!!next-input-character; |
| 2446 |
if ($self->{next_char} == 0x0059 or # Y |
redo A; |
|
$self->{next_char} == 0x0079) { # y |
|
|
!!!next-input-character; |
|
|
if ($self->{next_char} == 0x0053 or # S |
|
|
$self->{next_char} == 0x0073) { # s |
|
|
!!!next-input-character; |
|
|
if ($self->{next_char} == 0x0054 or # T |
|
|
$self->{next_char} == 0x0074) { # t |
|
|
!!!next-input-character; |
|
|
if ($self->{next_char} == 0x0045 or # E |
|
|
$self->{next_char} == 0x0065) { # e |
|
|
!!!next-input-character; |
|
|
if ($self->{next_char} == 0x004D or # M |
|
|
$self->{next_char} == 0x006D) { # m |
|
|
!!!cp (174); |
|
|
$self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE; |
|
|
!!!next-input-character; |
|
|
redo A; |
|
|
} else { |
|
|
!!!cp (175); |
|
|
} |
|
|
} else { |
|
|
!!!cp (176); |
|
|
} |
|
|
} else { |
|
|
!!!cp (177); |
|
|
} |
|
|
} else { |
|
|
!!!cp (178); |
|
|
} |
|
|
} else { |
|
|
!!!cp (179); |
|
|
} |
|
|
|
|
|
# |
|
| 2447 |
} else { |
} else { |
| 2448 |
!!!cp (180); |
!!!cp (180); |
| 2449 |
|
!!!parse-error (type => 'string after DOCTYPE name'); |
| 2450 |
|
$self->{current_token}->{quirks} = 1; |
| 2451 |
|
|
| 2452 |
|
$self->{state} = BOGUS_DOCTYPE_STATE; |
| 2453 |
!!!next-input-character; |
!!!next-input-character; |
| 2454 |
# |
redo A; |
| 2455 |
} |
} |
| 2456 |
|
} elsif ($self->{state} == PUBLIC_STATE) { |
| 2457 |
|
## ASCII case-insensitive |
| 2458 |
|
if ($self->{next_char} == [ |
| 2459 |
|
undef, |
| 2460 |
|
0x0055, # U |
| 2461 |
|
0x0042, # B |
| 2462 |
|
0x004C, # L |
| 2463 |
|
0x0049, # I |
| 2464 |
|
]->[length $self->{state_keyword}] or |
| 2465 |
|
$self->{next_char} == [ |
| 2466 |
|
undef, |
| 2467 |
|
0x0075, # u |
| 2468 |
|
0x0062, # b |
| 2469 |
|
0x006C, # l |
| 2470 |
|
0x0069, # i |
| 2471 |
|
]->[length $self->{state_keyword}]) { |
| 2472 |
|
!!!cp (175); |
| 2473 |
|
## Stay in the state. |
| 2474 |
|
$self->{state_keyword} .= chr $self->{next_char}; |
| 2475 |
|
!!!next-input-character; |
| 2476 |
|
redo A; |
| 2477 |
|
} elsif ((length $self->{state_keyword}) == 5 and |
| 2478 |
|
($self->{next_char} == 0x0043 or # C |
| 2479 |
|
$self->{next_char} == 0x0063)) { # c |
| 2480 |
|
!!!cp (168); |
| 2481 |
|
$self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE; |
| 2482 |
|
!!!next-input-character; |
| 2483 |
|
redo A; |
| 2484 |
|
} else { |
| 2485 |
|
!!!cp (169); |
| 2486 |
|
!!!parse-error (type => 'string after DOCTYPE name', |
| 2487 |
|
line => $self->{line_prev}, |
| 2488 |
|
column => $self->{column_prev} + 1 - length $self->{state_keyword}); |
| 2489 |
|
$self->{current_token}->{quirks} = 1; |
| 2490 |
|
|
| 2491 |
!!!parse-error (type => 'string after DOCTYPE name'); |
$self->{state} = BOGUS_DOCTYPE_STATE; |
| 2492 |
$self->{current_token}->{quirks} = 1; |
## Reconsume. |
| 2493 |
|
redo A; |
| 2494 |
|
} |
| 2495 |
|
} elsif ($self->{state} == SYSTEM_STATE) { |
| 2496 |
|
## ASCII case-insensitive |
| 2497 |
|
if ($self->{next_char} == [ |
| 2498 |
|
undef, |
| 2499 |
|
0x0059, # Y |
| 2500 |
|
0x0053, # S |
| 2501 |
|
0x0054, # T |
| 2502 |
|
0x0045, # E |
| 2503 |
|
]->[length $self->{state_keyword}] or |
| 2504 |
|
$self->{next_char} == [ |
| 2505 |
|
undef, |
| 2506 |
|
0x0079, # y |
| 2507 |
|
0x0073, # s |
| 2508 |
|
0x0074, # t |
| 2509 |
|
0x0065, # e |
| 2510 |
|
]->[length $self->{state_keyword}]) { |
| 2511 |
|
!!!cp (170); |
| 2512 |
|
## Stay in the state. |
| 2513 |
|
$self->{state_keyword} .= chr $self->{next_char}; |
| 2514 |
|
!!!next-input-character; |
| 2515 |
|
redo A; |
| 2516 |
|
} elsif ((length $self->{state_keyword}) == 5 and |
| 2517 |
|
($self->{next_char} == 0x004D or # M |
| 2518 |
|
$self->{next_char} == 0x006D)) { # m |
| 2519 |
|
!!!cp (171); |
| 2520 |
|
$self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE; |
| 2521 |
|
!!!next-input-character; |
| 2522 |
|
redo A; |
| 2523 |
|
} else { |
| 2524 |
|
!!!cp (172); |
| 2525 |
|
!!!parse-error (type => 'string after DOCTYPE name', |
| 2526 |
|
line => $self->{line_prev}, |
| 2527 |
|
column => $self->{column_prev} + 1 - length $self->{state_keyword}); |
| 2528 |
|
$self->{current_token}->{quirks} = 1; |
| 2529 |
|
|
| 2530 |
$self->{state} = BOGUS_DOCTYPE_STATE; |
$self->{state} = BOGUS_DOCTYPE_STATE; |
| 2531 |
# next-input-character is already done |
## Reconsume. |
| 2532 |
redo A; |
redo A; |
| 2533 |
|
} |
| 2534 |
} elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) { |
} elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) { |
| 2535 |
if ({ |
if ({ |
| 2536 |
0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1, |
0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1, |
| 2887 |
!!!next-input-character; |
!!!next-input-character; |
| 2888 |
redo A; |
redo A; |
| 2889 |
} |
} |
| 2890 |
} elsif ($self->{state} == CDATA_BLOCK_STATE) { |
} elsif ($self->{state} == CDATA_SECTION_STATE) { |
| 2891 |
my $s = ''; |
## NOTE: "CDATA section state" in the state is jointly implemented |
| 2892 |
|
## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|, |
| 2893 |
|
## and |CDATA_SECTION_MSE2_STATE|. |
| 2894 |
|
|
| 2895 |
my ($l, $c) = ($self->{line}, $self->{column}); |
if ($self->{next_char} == 0x005D) { # ] |
| 2896 |
|
!!!cp (221.1); |
| 2897 |
|
$self->{state} = CDATA_SECTION_MSE1_STATE; |
| 2898 |
|
!!!next-input-character; |
| 2899 |
|
redo A; |
| 2900 |
|
} elsif ($self->{next_char} == -1) { |
| 2901 |
|
$self->{state} = DATA_STATE; |
| 2902 |
|
!!!next-input-character; |
| 2903 |
|
if (length $self->{current_token}->{data}) { # character |
| 2904 |
|
!!!cp (221.2); |
| 2905 |
|
!!!emit ($self->{current_token}); # character |
| 2906 |
|
} else { |
| 2907 |
|
!!!cp (221.3); |
| 2908 |
|
## No token to emit. $self->{current_token} is discarded. |
| 2909 |
|
} |
| 2910 |
|
redo A; |
| 2911 |
|
} else { |
| 2912 |
|
!!!cp (221.4); |
| 2913 |
|
$self->{current_token}->{data} .= chr $self->{next_char}; |
| 2914 |
|
## Stay in the state. |
| 2915 |
|
!!!next-input-character; |
| 2916 |
|
redo A; |
| 2917 |
|
} |
| 2918 |
|
|
| 2919 |
CS: while ($self->{next_char} != -1) { |
## ISSUE: "text tokens" in spec. |
| 2920 |
if ($self->{next_char} == 0x005D) { # ] |
} elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) { |
| 2921 |
!!!next-input-character; |
if ($self->{next_char} == 0x005D) { # ] |
| 2922 |
if ($self->{next_char} == 0x005D) { # ] |
!!!cp (221.5); |
| 2923 |
!!!next-input-character; |
$self->{state} = CDATA_SECTION_MSE2_STATE; |
| 2924 |
MDC: { |
!!!next-input-character; |
| 2925 |
if ($self->{next_char} == 0x003E) { # > |
redo A; |
| 2926 |
!!!cp (221.1); |
} else { |
| 2927 |
!!!next-input-character; |
!!!cp (221.6); |
| 2928 |
last CS; |
$self->{current_token}->{data} .= ']'; |
| 2929 |
} elsif ($self->{next_char} == 0x005D) { # ] |
$self->{state} = CDATA_SECTION_STATE; |
| 2930 |
!!!cp (221.2); |
## Reconsume. |
| 2931 |
$s .= ']'; |
redo A; |
| 2932 |
!!!next-input-character; |
} |
| 2933 |
redo MDC; |
} elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) { |
| 2934 |
} else { |
if ($self->{next_char} == 0x003E) { # > |
| 2935 |
!!!cp (221.3); |
$self->{state} = DATA_STATE; |
| 2936 |
$s .= ']]'; |
!!!next-input-character; |
| 2937 |
# |
if (length $self->{current_token}->{data}) { # character |
| 2938 |
} |
!!!cp (221.7); |
| 2939 |
} # MDC |
!!!emit ($self->{current_token}); # character |
|
} else { |
|
|
!!!cp (221.4); |
|
|
$s .= ']'; |
|
|
# |
|
|
} |
|
| 2940 |
} else { |
} else { |
| 2941 |
!!!cp (221.5); |
!!!cp (221.8); |
| 2942 |
# |
## No token to emit. $self->{current_token} is discarded. |
| 2943 |
} |
} |
| 2944 |
$s .= chr $self->{next_char}; |
redo A; |
| 2945 |
|
} elsif ($self->{next_char} == 0x005D) { # ] |
| 2946 |
|
!!!cp (221.9); # character |
| 2947 |
|
$self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]". |
| 2948 |
|
## Stay in the state. |
| 2949 |
!!!next-input-character; |
!!!next-input-character; |
| 2950 |
} # CS |
redo A; |
|
|
|
|
$self->{state} = DATA_STATE; |
|
|
## next-input-character done or EOF, which is reconsumed. |
|
|
|
|
|
if (length $s) { |
|
|
!!!cp (221.6); |
|
|
!!!emit ({type => CHARACTER_TOKEN, data => $s, |
|
|
line => $l, column => $c}); |
|
| 2951 |
} else { |
} else { |
| 2952 |
!!!cp (221.7); |
!!!cp (221.11); |
| 2953 |
|
$self->{current_token}->{data} .= ']]'; # character |
| 2954 |
|
$self->{state} = CDATA_SECTION_STATE; |
| 2955 |
|
## Reconsume. |
| 2956 |
|
redo A; |
| 2957 |
|
} |
| 2958 |
|
} elsif ($self->{state} == ENTITY_STATE) { |
| 2959 |
|
if ({ |
| 2960 |
|
0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF, |
| 2961 |
|
0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & |
| 2962 |
|
$self->{entity_additional} => 1, |
| 2963 |
|
}->{$self->{next_char}}) { |
| 2964 |
|
!!!cp (1001); |
| 2965 |
|
## Don't consume |
| 2966 |
|
## No error |
| 2967 |
|
## Return nothing. |
| 2968 |
|
# |
| 2969 |
|
} elsif ($self->{next_char} == 0x0023) { # # |
| 2970 |
|
!!!cp (999); |
| 2971 |
|
$self->{state} = ENTITY_HASH_STATE; |
| 2972 |
|
$self->{state_keyword} = '#'; |
| 2973 |
|
!!!next-input-character; |
| 2974 |
|
redo A; |
| 2975 |
|
} elsif ((0x0041 <= $self->{next_char} and |
| 2976 |
|
$self->{next_char} <= 0x005A) or # A..Z |
| 2977 |
|
(0x0061 <= $self->{next_char} and |
| 2978 |
|
$self->{next_char} <= 0x007A)) { # a..z |
| 2979 |
|
!!!cp (998); |
| 2980 |
|
require Whatpm::_NamedEntityList; |
| 2981 |
|
$self->{state} = ENTITY_NAME_STATE; |
| 2982 |
|
$self->{state_keyword} = chr $self->{next_char}; |
| 2983 |
|
$self->{entity__value} = $self->{state_keyword}; |
| 2984 |
|
$self->{entity__match} = 0; |
| 2985 |
|
!!!next-input-character; |
| 2986 |
|
redo A; |
| 2987 |
|
} else { |
| 2988 |
|
!!!cp (1027); |
| 2989 |
|
!!!parse-error (type => 'bare ero'); |
| 2990 |
|
## Return nothing. |
| 2991 |
|
# |
| 2992 |
} |
} |
| 2993 |
|
|
| 2994 |
redo A; |
## NOTE: No character is consumed by the "consume a character |
| 2995 |
|
## reference" algorithm. In other word, there is an "&" character |
| 2996 |
## ISSUE: "text tokens" in spec. |
## that does not introduce a character reference, which would be |
| 2997 |
## TODO: Streaming support |
## appended to the parent element or the attribute value in later |
| 2998 |
} else { |
## process of the tokenizer. |
| 2999 |
die "$0: $self->{state}: Unknown state"; |
|
| 3000 |
} |
if ($self->{prev_state} == DATA_STATE) { |
| 3001 |
} # A |
!!!cp (997); |
| 3002 |
|
$self->{state} = $self->{prev_state}; |
| 3003 |
die "$0: _get_next_token: unexpected case"; |
## Reconsume. |
| 3004 |
} # _get_next_token |
!!!emit ({type => CHARACTER_TOKEN, data => '&', |
| 3005 |
|
line => $self->{line_prev}, |
| 3006 |
sub _tokenize_attempt_to_consume_an_entity ($$$) { |
column => $self->{column_prev}, |
| 3007 |
my ($self, $in_attr, $additional) = @_; |
}); |
| 3008 |
|
redo A; |
| 3009 |
my ($l, $c) = ($self->{line_prev}, $self->{column_prev}); |
} else { |
| 3010 |
|
!!!cp (996); |
| 3011 |
|
$self->{current_attribute}->{value} .= '&'; |
| 3012 |
|
$self->{state} = $self->{prev_state}; |
| 3013 |
|
## Reconsume. |
| 3014 |
|
redo A; |
| 3015 |
|
} |
| 3016 |
|
} elsif ($self->{state} == ENTITY_HASH_STATE) { |
| 3017 |
|
if ($self->{next_char} == 0x0078 or # x |
| 3018 |
|
$self->{next_char} == 0x0058) { # X |
| 3019 |
|
!!!cp (995); |
| 3020 |
|
$self->{state} = HEXREF_X_STATE; |
| 3021 |
|
$self->{state_keyword} .= chr $self->{next_char}; |
| 3022 |
|
!!!next-input-character; |
| 3023 |
|
redo A; |
| 3024 |
|
} elsif (0x0030 <= $self->{next_char} and |
| 3025 |
|
$self->{next_char} <= 0x0039) { # 0..9 |
| 3026 |
|
!!!cp (994); |
| 3027 |
|
$self->{state} = NCR_NUM_STATE; |
| 3028 |
|
$self->{state_keyword} = $self->{next_char} - 0x0030; |
| 3029 |
|
!!!next-input-character; |
| 3030 |
|
redo A; |
| 3031 |
|
} else { |
| 3032 |
|
!!!parse-error (type => 'bare nero', |
| 3033 |
|
line => $self->{line_prev}, |
| 3034 |
|
column => $self->{column_prev} - 1); |
| 3035 |
|
|
| 3036 |
if ({ |
## NOTE: According to the spec algorithm, nothing is returned, |
| 3037 |
0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF, |
## and then "&#" is appended to the parent element or the attribute |
| 3038 |
0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR |
## value in the later processing. |
| 3039 |
$additional => 1, |
|
| 3040 |
}->{$self->{next_char}}) { |
if ($self->{prev_state} == DATA_STATE) { |
| 3041 |
!!!cp (1001); |
!!!cp (1019); |
| 3042 |
## Don't consume |
$self->{state} = $self->{prev_state}; |
| 3043 |
## No error |
## Reconsume. |
| 3044 |
return undef; |
!!!emit ({type => CHARACTER_TOKEN, |
| 3045 |
} elsif ($self->{next_char} == 0x0023) { # # |
data => '&#', |
| 3046 |
!!!next-input-character; |
line => $self->{line_prev}, |
| 3047 |
if ($self->{next_char} == 0x0078 or # x |
column => $self->{column_prev} - 1, |
| 3048 |
$self->{next_char} == 0x0058) { # X |
}); |
| 3049 |
my $code; |
redo A; |
|
X: { |
|
|
my $x_char = $self->{next_char}; |
|
|
!!!next-input-character; |
|
|
if (0x0030 <= $self->{next_char} and |
|
|
$self->{next_char} <= 0x0039) { # 0..9 |
|
|
!!!cp (1002); |
|
|
$code ||= 0; |
|
|
$code *= 0x10; |
|
|
$code += $self->{next_char} - 0x0030; |
|
|
redo X; |
|
|
} elsif (0x0061 <= $self->{next_char} and |
|
|
$self->{next_char} <= 0x0066) { # a..f |
|
|
!!!cp (1003); |
|
|
$code ||= 0; |
|
|
$code *= 0x10; |
|
|
$code += $self->{next_char} - 0x0060 + 9; |
|
|
redo X; |
|
|
} elsif (0x0041 <= $self->{next_char} and |
|
|
$self->{next_char} <= 0x0046) { # A..F |
|
|
!!!cp (1004); |
|
|
$code ||= 0; |
|
|
$code *= 0x10; |
|
|
$code += $self->{next_char} - 0x0040 + 9; |
|
|
redo X; |
|
|
} elsif (not defined $code) { # no hexadecimal digit |
|
|
!!!cp (1005); |
|
|
!!!parse-error (type => 'bare hcro', line => $l, column => $c); |
|
|
!!!back-next-input-character ($x_char, $self->{next_char}); |
|
|
$self->{next_char} = 0x0023; # # |
|
|
return undef; |
|
|
} elsif ($self->{next_char} == 0x003B) { # ; |
|
|
!!!cp (1006); |
|
|
!!!next-input-character; |
|
| 3050 |
} else { |
} else { |
| 3051 |
!!!cp (1007); |
!!!cp (993); |
| 3052 |
!!!parse-error (type => 'no refc', line => $l, column => $c); |
$self->{current_attribute}->{value} .= '&#'; |
| 3053 |
|
$self->{state} = $self->{prev_state}; |
| 3054 |
|
## Reconsume. |
| 3055 |
|
redo A; |
| 3056 |
} |
} |
| 3057 |
|
} |
| 3058 |
if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) { |
} elsif ($self->{state} == NCR_NUM_STATE) { |
| 3059 |
!!!cp (1008); |
if (0x0030 <= $self->{next_char} and |
| 3060 |
!!!parse-error (type => 'invalid character reference', |
$self->{next_char} <= 0x0039) { # 0..9 |
|
text => (sprintf 'U+%04X', $code), |
|
|
line => $l, column => $c); |
|
|
$code = 0xFFFD; |
|
|
} elsif ($code > 0x10FFFF) { |
|
|
!!!cp (1009); |
|
|
!!!parse-error (type => 'invalid character reference', |
|
|
text => (sprintf 'U-%08X', $code), |
|
|
line => $l, column => $c); |
|
|
$code = 0xFFFD; |
|
|
} elsif ($code == 0x000D) { |
|
|
!!!cp (1010); |
|
|
!!!parse-error (type => 'CR character reference', line => $l, column => $c); |
|
|
$code = 0x000A; |
|
|
} elsif (0x80 <= $code and $code <= 0x9F) { |
|
|
!!!cp (1011); |
|
|
!!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c); |
|
|
$code = $c1_entity_char->{$code}; |
|
|
} |
|
|
|
|
|
return {type => CHARACTER_TOKEN, data => chr $code, |
|
|
has_reference => 1, |
|
|
line => $l, column => $c, |
|
|
}; |
|
|
} # X |
|
|
} elsif (0x0030 <= $self->{next_char} and |
|
|
$self->{next_char} <= 0x0039) { # 0..9 |
|
|
my $code = $self->{next_char} - 0x0030; |
|
|
!!!next-input-character; |
|
|
|
|
|
while (0x0030 <= $self->{next_char} and |
|
|
$self->{next_char} <= 0x0039) { # 0..9 |
|
| 3061 |
!!!cp (1012); |
!!!cp (1012); |
| 3062 |
$code *= 10; |
$self->{state_keyword} *= 10; |
| 3063 |
$code += $self->{next_char} - 0x0030; |
$self->{state_keyword} += $self->{next_char} - 0x0030; |
| 3064 |
|
|
| 3065 |
|
## Stay in the state. |
| 3066 |
!!!next-input-character; |
!!!next-input-character; |
| 3067 |
} |
redo A; |
| 3068 |
|
} elsif ($self->{next_char} == 0x003B) { # ; |
|
if ($self->{next_char} == 0x003B) { # ; |
|
| 3069 |
!!!cp (1013); |
!!!cp (1013); |
| 3070 |
!!!next-input-character; |
!!!next-input-character; |
| 3071 |
|
# |
| 3072 |
} else { |
} else { |
| 3073 |
!!!cp (1014); |
!!!cp (1014); |
| 3074 |
!!!parse-error (type => 'no refc', line => $l, column => $c); |
!!!parse-error (type => 'no refc'); |
| 3075 |
|
## Reconsume. |
| 3076 |
|
# |
| 3077 |
} |
} |
| 3078 |
|
|
| 3079 |
|
my $code = $self->{state_keyword}; |
| 3080 |
|
my $l = $self->{line_prev}; |
| 3081 |
|
my $c = $self->{column_prev}; |
| 3082 |
if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) { |
if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) { |
| 3083 |
!!!cp (1015); |
!!!cp (1015); |
| 3084 |
!!!parse-error (type => 'invalid character reference', |
!!!parse-error (type => 'invalid character reference', |
| 3103 |
line => $l, column => $c); |
line => $l, column => $c); |
| 3104 |
$code = $c1_entity_char->{$code}; |
$code = $c1_entity_char->{$code}; |
| 3105 |
} |
} |
| 3106 |
|
|
| 3107 |
return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1, |
if ($self->{prev_state} == DATA_STATE) { |
| 3108 |
line => $l, column => $c, |
!!!cp (992); |
| 3109 |
}; |
$self->{state} = $self->{prev_state}; |
| 3110 |
} else { |
## Reconsume. |
| 3111 |
!!!cp (1019); |
!!!emit ({type => CHARACTER_TOKEN, data => chr $code, |
| 3112 |
!!!parse-error (type => 'bare nero', line => $l, column => $c); |
line => $l, column => $c, |
| 3113 |
!!!back-next-input-character ($self->{next_char}); |
}); |
| 3114 |
$self->{next_char} = 0x0023; # # |
redo A; |
| 3115 |
return undef; |
} else { |
| 3116 |
} |
!!!cp (991); |
| 3117 |
} elsif ((0x0041 <= $self->{next_char} and |
$self->{current_attribute}->{value} .= chr $code; |
| 3118 |
$self->{next_char} <= 0x005A) or |
$self->{current_attribute}->{has_reference} = 1; |
| 3119 |
(0x0061 <= $self->{next_char} and |
$self->{state} = $self->{prev_state}; |
| 3120 |
$self->{next_char} <= 0x007A)) { |
## Reconsume. |
| 3121 |
my $entity_name = chr $self->{next_char}; |
redo A; |
| 3122 |
!!!next-input-character; |
} |
| 3123 |
|
} elsif ($self->{state} == HEXREF_X_STATE) { |
| 3124 |
my $value = $entity_name; |
if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or |
| 3125 |
my $match = 0; |
(0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or |
| 3126 |
require Whatpm::_NamedEntityList; |
(0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) { |
| 3127 |
our $EntityChar; |
# 0..9, A..F, a..f |
| 3128 |
|
!!!cp (990); |
| 3129 |
while (length $entity_name < 30 and |
$self->{state} = HEXREF_HEX_STATE; |
| 3130 |
## NOTE: Some number greater than the maximum length of entity name |
$self->{state_keyword} = 0; |
| 3131 |
((0x0041 <= $self->{next_char} and # a |
## Reconsume. |
| 3132 |
$self->{next_char} <= 0x005A) or # x |
redo A; |
| 3133 |
(0x0061 <= $self->{next_char} and # a |
} else { |
| 3134 |
$self->{next_char} <= 0x007A) or # z |
!!!parse-error (type => 'bare hcro', |
| 3135 |
(0x0030 <= $self->{next_char} and # 0 |
line => $self->{line_prev}, |
| 3136 |
$self->{next_char} <= 0x0039) or # 9 |
column => $self->{column_prev} - 2); |
| 3137 |
$self->{next_char} == 0x003B)) { # ; |
|
| 3138 |
$entity_name .= chr $self->{next_char}; |
## NOTE: According to the spec algorithm, nothing is returned, |
| 3139 |
if (defined $EntityChar->{$entity_name}) { |
## and then "&#" followed by "X" or "x" is appended to the parent |
| 3140 |
if ($self->{next_char} == 0x003B) { # ; |
## element or the attribute value in the later processing. |
| 3141 |
!!!cp (1020); |
|
| 3142 |
$value = $EntityChar->{$entity_name}; |
if ($self->{prev_state} == DATA_STATE) { |
| 3143 |
$match = 1; |
!!!cp (1005); |
| 3144 |
!!!next-input-character; |
$self->{state} = $self->{prev_state}; |
| 3145 |
last; |
## Reconsume. |
| 3146 |
|
!!!emit ({type => CHARACTER_TOKEN, |
| 3147 |
|
data => '&' . $self->{state_keyword}, |
| 3148 |
|
line => $self->{line_prev}, |
| 3149 |
|
column => $self->{column_prev} - length $self->{state_keyword}, |
| 3150 |
|
}); |
| 3151 |
|
redo A; |
| 3152 |
} else { |
} else { |
| 3153 |
!!!cp (1021); |
!!!cp (989); |
| 3154 |
$value = $EntityChar->{$entity_name}; |
$self->{current_attribute}->{value} .= '&' . $self->{state_keyword}; |
| 3155 |
$match = -1; |
$self->{state} = $self->{prev_state}; |
| 3156 |
|
## Reconsume. |
| 3157 |
|
redo A; |
| 3158 |
|
} |
| 3159 |
|
} |
| 3160 |
|
} elsif ($self->{state} == HEXREF_HEX_STATE) { |
| 3161 |
|
if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) { |
| 3162 |
|
# 0..9 |
| 3163 |
|
!!!cp (1002); |
| 3164 |
|
$self->{state_keyword} *= 0x10; |
| 3165 |
|
$self->{state_keyword} += $self->{next_char} - 0x0030; |
| 3166 |
|
## Stay in the state. |
| 3167 |
|
!!!next-input-character; |
| 3168 |
|
redo A; |
| 3169 |
|
} elsif (0x0061 <= $self->{next_char} and |
| 3170 |
|
$self->{next_char} <= 0x0066) { # a..f |
| 3171 |
|
!!!cp (1003); |
| 3172 |
|
$self->{state_keyword} *= 0x10; |
| 3173 |
|
$self->{state_keyword} += $self->{next_char} - 0x0060 + 9; |
| 3174 |
|
## Stay in the state. |
| 3175 |
|
!!!next-input-character; |
| 3176 |
|
redo A; |
| 3177 |
|
} elsif (0x0041 <= $self->{next_char} and |
| 3178 |
|
$self->{next_char} <= 0x0046) { # A..F |
| 3179 |
|
!!!cp (1004); |
| 3180 |
|
$self->{state_keyword} *= 0x10; |
| 3181 |
|
$self->{state_keyword} += $self->{next_char} - 0x0040 + 9; |
| 3182 |
|
## Stay in the state. |
| 3183 |
|
!!!next-input-character; |
| 3184 |
|
redo A; |
| 3185 |
|
} elsif ($self->{next_char} == 0x003B) { # ; |
| 3186 |
|
!!!cp (1006); |
| 3187 |
|
!!!next-input-character; |
| 3188 |
|
# |
| 3189 |
|
} else { |
| 3190 |
|
!!!cp (1007); |
| 3191 |
|
!!!parse-error (type => 'no refc', |
| 3192 |
|
line => $self->{line}, |
| 3193 |
|
column => $self->{column}); |
| 3194 |
|
## Reconsume. |
| 3195 |
|
# |
| 3196 |
|
} |
| 3197 |
|
|
| 3198 |
|
my $code = $self->{state_keyword}; |
| 3199 |
|
my $l = $self->{line_prev}; |
| 3200 |
|
my $c = $self->{column_prev}; |
| 3201 |
|
if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) { |
| 3202 |
|
!!!cp (1008); |
| 3203 |
|
!!!parse-error (type => 'invalid character reference', |
| 3204 |
|
text => (sprintf 'U+%04X', $code), |
| 3205 |
|
line => $l, column => $c); |
| 3206 |
|
$code = 0xFFFD; |
| 3207 |
|
} elsif ($code > 0x10FFFF) { |
| 3208 |
|
!!!cp (1009); |
| 3209 |
|
!!!parse-error (type => 'invalid character reference', |
| 3210 |
|
text => (sprintf 'U-%08X', $code), |
| 3211 |
|
line => $l, column => $c); |
| 3212 |
|
$code = 0xFFFD; |
| 3213 |
|
} elsif ($code == 0x000D) { |
| 3214 |
|
!!!cp (1010); |
| 3215 |
|
!!!parse-error (type => 'CR character reference', line => $l, column => $c); |
| 3216 |
|
$code = 0x000A; |
| 3217 |
|
} elsif (0x80 <= $code and $code <= 0x9F) { |
| 3218 |
|
!!!cp (1011); |
| 3219 |
|
!!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c); |
| 3220 |
|
$code = $c1_entity_char->{$code}; |
| 3221 |
|
} |
| 3222 |
|
|
| 3223 |
|
if ($self->{prev_state} == DATA_STATE) { |
| 3224 |
|
!!!cp (988); |
| 3225 |
|
$self->{state} = $self->{prev_state}; |
| 3226 |
|
## Reconsume. |
| 3227 |
|
!!!emit ({type => CHARACTER_TOKEN, data => chr $code, |
| 3228 |
|
line => $l, column => $c, |
| 3229 |
|
}); |
| 3230 |
|
redo A; |
| 3231 |
|
} else { |
| 3232 |
|
!!!cp (987); |
| 3233 |
|
$self->{current_attribute}->{value} .= chr $code; |
| 3234 |
|
$self->{current_attribute}->{has_reference} = 1; |
| 3235 |
|
$self->{state} = $self->{prev_state}; |
| 3236 |
|
## Reconsume. |
| 3237 |
|
redo A; |
| 3238 |
|
} |
| 3239 |
|
} elsif ($self->{state} == ENTITY_NAME_STATE) { |
| 3240 |
|
if (length $self->{state_keyword} < 30 and |
| 3241 |
|
## NOTE: Some number greater than the maximum length of entity name |
| 3242 |
|
((0x0041 <= $self->{next_char} and # a |
| 3243 |
|
$self->{next_char} <= 0x005A) or # x |
| 3244 |
|
(0x0061 <= $self->{next_char} and # a |
| 3245 |
|
$self->{next_char} <= 0x007A) or # z |
| 3246 |
|
(0x0030 <= $self->{next_char} and # 0 |
| 3247 |
|
$self->{next_char} <= 0x0039) or # 9 |
| 3248 |
|
$self->{next_char} == 0x003B)) { # ; |
| 3249 |
|
our $EntityChar; |
| 3250 |
|
$self->{state_keyword} .= chr $self->{next_char}; |
| 3251 |
|
if (defined $EntityChar->{$self->{state_keyword}}) { |
| 3252 |
|
if ($self->{next_char} == 0x003B) { # ; |
| 3253 |
|
!!!cp (1020); |
| 3254 |
|
$self->{entity__value} = $EntityChar->{$self->{state_keyword}}; |
| 3255 |
|
$self->{entity__match} = 1; |
| 3256 |
|
!!!next-input-character; |
| 3257 |
|
# |
| 3258 |
|
} else { |
| 3259 |
|
!!!cp (1021); |
| 3260 |
|
$self->{entity__value} = $EntityChar->{$self->{state_keyword}}; |
| 3261 |
|
$self->{entity__match} = -1; |
| 3262 |
|
## Stay in the state. |
| 3263 |
|
!!!next-input-character; |
| 3264 |
|
redo A; |
| 3265 |
|
} |
| 3266 |
|
} else { |
| 3267 |
|
!!!cp (1022); |
| 3268 |
|
$self->{entity__value} .= chr $self->{next_char}; |
| 3269 |
|
$self->{entity__match} *= 2; |
| 3270 |
|
## Stay in the state. |
| 3271 |
!!!next-input-character; |
!!!next-input-character; |
| 3272 |
|
redo A; |
| 3273 |
|
} |
| 3274 |
|
} |
| 3275 |
|
|
| 3276 |
|
my $data; |
| 3277 |
|
my $has_ref; |
| 3278 |
|
if ($self->{entity__match} > 0) { |
| 3279 |
|
!!!cp (1023); |
| 3280 |
|
$data = $self->{entity__value}; |
| 3281 |
|
$has_ref = 1; |
| 3282 |
|
# |
| 3283 |
|
} elsif ($self->{entity__match} < 0) { |
| 3284 |
|
!!!parse-error (type => 'no refc'); |
| 3285 |
|
if ($self->{prev_state} != DATA_STATE and # in attribute |
| 3286 |
|
$self->{entity__match} < -1) { |
| 3287 |
|
!!!cp (1024); |
| 3288 |
|
$data = '&' . $self->{state_keyword}; |
| 3289 |
|
# |
| 3290 |
|
} else { |
| 3291 |
|
!!!cp (1025); |
| 3292 |
|
$data = $self->{entity__value}; |
| 3293 |
|
$has_ref = 1; |
| 3294 |
|
# |
| 3295 |
} |
} |
| 3296 |
} else { |
} else { |
| 3297 |
!!!cp (1022); |
!!!cp (1026); |
| 3298 |
$value .= chr $self->{next_char}; |
!!!parse-error (type => 'bare ero', |
| 3299 |
$match *= 2; |
line => $self->{line_prev}, |
| 3300 |
!!!next-input-character; |
column => $self->{column_prev}); |
| 3301 |
|
$data = '&' . $self->{state_keyword}; |
| 3302 |
|
# |
| 3303 |
} |
} |
| 3304 |
} |
|
| 3305 |
|
## NOTE: In these cases, when a character reference is found, |
| 3306 |
if ($match > 0) { |
## it is consumed and a character token is returned, or, otherwise, |
| 3307 |
!!!cp (1023); |
## nothing is consumed and returned, according to the spec algorithm. |
| 3308 |
return {type => CHARACTER_TOKEN, data => $value, has_reference => 1, |
## In this implementation, anything that has been examined by the |
| 3309 |
line => $l, column => $c, |
## tokenizer is appended to the parent element or the attribute value |
| 3310 |
}; |
## as string, either literal string when no character reference or |
| 3311 |
} elsif ($match < 0) { |
## entity-replaced string otherwise, in this stage, since any characters |
| 3312 |
!!!parse-error (type => 'no refc', line => $l, column => $c); |
## that would not be consumed are appended in the data state or in an |
| 3313 |
if ($in_attr and $match < -1) { |
## appropriate attribute value state anyway. |
| 3314 |
!!!cp (1024); |
|
| 3315 |
return {type => CHARACTER_TOKEN, data => '&'.$entity_name, |
if ($self->{prev_state} == DATA_STATE) { |
| 3316 |
line => $l, column => $c, |
!!!cp (986); |
| 3317 |
}; |
$self->{state} = $self->{prev_state}; |
| 3318 |
} else { |
## Reconsume. |
| 3319 |
!!!cp (1025); |
!!!emit ({type => CHARACTER_TOKEN, |
| 3320 |
return {type => CHARACTER_TOKEN, data => $value, has_reference => 1, |
data => $data, |
| 3321 |
line => $l, column => $c, |
line => $self->{line_prev}, |
| 3322 |
}; |
column => $self->{column_prev} + 1 - length $self->{state_keyword}, |
| 3323 |
|
}); |
| 3324 |
|
redo A; |
| 3325 |
|
} else { |
| 3326 |
|
!!!cp (985); |
| 3327 |
|
$self->{current_attribute}->{value} .= $data; |
| 3328 |
|
$self->{current_attribute}->{has_reference} = 1 if $has_ref; |
| 3329 |
|
$self->{state} = $self->{prev_state}; |
| 3330 |
|
## Reconsume. |
| 3331 |
|
redo A; |
| 3332 |
} |
} |
| 3333 |
} else { |
} else { |
| 3334 |
!!!cp (1026); |
die "$0: $self->{state}: Unknown state"; |
|
!!!parse-error (type => 'bare ero', line => $l, column => $c); |
|
|
## NOTE: "No characters are consumed" in the spec. |
|
|
return {type => CHARACTER_TOKEN, data => '&'.$value, |
|
|
line => $l, column => $c, |
|
|
}; |
|
| 3335 |
} |
} |
| 3336 |
} else { |
} # A |
| 3337 |
!!!cp (1027); |
|
| 3338 |
## no characters are consumed |
die "$0: _get_next_token: unexpected case"; |
| 3339 |
!!!parse-error (type => 'bare ero', line => $l, column => $c); |
} # _get_next_token |
|
return undef; |
|
|
} |
|
|
} # _tokenize_attempt_to_consume_an_entity |
|
| 3340 |
|
|
| 3341 |
sub _initialize_tree_constructor ($) { |
sub _initialize_tree_constructor ($) { |
| 3342 |
my $self = shift; |
my $self = shift; |
| 3401 |
## language. |
## language. |
| 3402 |
my $doctype_name = $token->{name}; |
my $doctype_name = $token->{name}; |
| 3403 |
$doctype_name = '' unless defined $doctype_name; |
$doctype_name = '' unless defined $doctype_name; |
| 3404 |
$doctype_name =~ tr/a-z/A-Z/; |
$doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive |
| 3405 |
if (not defined $token->{name} or # <!DOCTYPE> |
if (not defined $token->{name} or # <!DOCTYPE> |
|
defined $token->{public_identifier} or |
|
| 3406 |
defined $token->{system_identifier}) { |
defined $token->{system_identifier}) { |
| 3407 |
!!!cp ('t1'); |
!!!cp ('t1'); |
| 3408 |
!!!parse-error (type => 'not HTML5', token => $token); |
!!!parse-error (type => 'not HTML5', token => $token); |
| 3409 |
} elsif ($doctype_name ne 'HTML') { |
} elsif ($doctype_name ne 'HTML') { |
| 3410 |
!!!cp ('t2'); |
!!!cp ('t2'); |
|
## ISSUE: ASCII case-insensitive? (in fact it does not matter) |
|
| 3411 |
!!!parse-error (type => 'not HTML5', token => $token); |
!!!parse-error (type => 'not HTML5', token => $token); |
| 3412 |
|
} elsif (defined $token->{public_identifier}) { |
| 3413 |
|
if ($token->{public_identifier} eq 'XSLT-compat') { |
| 3414 |
|
!!!cp ('t1.2'); |
| 3415 |
|
!!!parse-error (type => 'XSLT-compat', token => $token, |
| 3416 |
|
level => $self->{level}->{should}); |
| 3417 |
|
} else { |
| 3418 |
|
!!!parse-error (type => 'not HTML5', token => $token); |
| 3419 |
|
} |
| 3420 |
} else { |
} else { |
| 3421 |
!!!cp ('t3'); |
!!!cp ('t3'); |
| 3422 |
|
# |
| 3423 |
} |
} |
| 3424 |
|
|
| 3425 |
my $doctype = $self->{document}->create_document_type_definition |
my $doctype = $self->{document}->create_document_type_definition |
| 6555 |
} elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) { |
} elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) { |
| 6556 |
!!!cp ('t312'); |
!!!cp ('t312'); |
| 6557 |
!!!parse-error (type => 'after frameset:#text', token => $token); |
!!!parse-error (type => 'after frameset:#text', token => $token); |
| 6558 |
} else { # "after html frameset" |
} else { # "after after frameset" |
| 6559 |
!!!cp ('t313'); |
!!!cp ('t313'); |
| 6560 |
!!!parse-error (type => 'after html:#text', token => $token); |
!!!parse-error (type => 'after html:#text', token => $token); |
|
|
|
|
$self->{insertion_mode} = AFTER_FRAMESET_IM; |
|
|
## Reprocess in the "after frameset" insertion mode. |
|
|
!!!parse-error (type => 'after frameset:#text', token => $token); |
|
| 6561 |
} |
} |
| 6562 |
|
|
| 6563 |
## Ignore the token. |
## Ignore the token. |
| 6573 |
|
|
| 6574 |
die qq[$0: Character "$token->{data}"]; |
die qq[$0: Character "$token->{data}"]; |
| 6575 |
} elsif ($token->{type} == START_TAG_TOKEN) { |
} elsif ($token->{type} == START_TAG_TOKEN) { |
|
if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) { |
|
|
!!!cp ('t316'); |
|
|
!!!parse-error (type => 'after html', |
|
|
text => $token->{tag_name}, token => $token); |
|
|
|
|
|
$self->{insertion_mode} = AFTER_FRAMESET_IM; |
|
|
## Process in the "after frameset" insertion mode. |
|
|
} else { |
|
|
!!!cp ('t317'); |
|
|
} |
|
|
|
|
| 6576 |
if ($token->{tag_name} eq 'frameset' and |
if ($token->{tag_name} eq 'frameset' and |
| 6577 |
$self->{insertion_mode} == IN_FRAMESET_IM) { |
$self->{insertion_mode} == IN_FRAMESET_IM) { |
| 6578 |
!!!cp ('t318'); |
!!!cp ('t318'); |
| 6593 |
## NOTE: As if in head. |
## NOTE: As if in head. |
| 6594 |
$parse_rcdata->(CDATA_CONTENT_MODEL); |
$parse_rcdata->(CDATA_CONTENT_MODEL); |
| 6595 |
next B; |
next B; |
| 6596 |
|
|
| 6597 |
|
## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>| |
| 6598 |
|
## has no parse error. |
| 6599 |
} else { |
} else { |
| 6600 |
if ($self->{insertion_mode} == IN_FRAMESET_IM) { |
if ($self->{insertion_mode} == IN_FRAMESET_IM) { |
| 6601 |
!!!cp ('t321'); |
!!!cp ('t321'); |
| 6602 |
!!!parse-error (type => 'in frameset', |
!!!parse-error (type => 'in frameset', |
| 6603 |
text => $token->{tag_name}, token => $token); |
text => $token->{tag_name}, token => $token); |
| 6604 |
} else { |
} elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) { |
| 6605 |
!!!cp ('t322'); |
!!!cp ('t322'); |
| 6606 |
!!!parse-error (type => 'after frameset', |
!!!parse-error (type => 'after frameset', |
| 6607 |
text => $token->{tag_name}, token => $token); |
text => $token->{tag_name}, token => $token); |
| 6608 |
|
} else { # "after after frameset" |
| 6609 |
|
!!!cp ('t322.2'); |
| 6610 |
|
!!!parse-error (type => 'after after frameset', |
| 6611 |
|
text => $token->{tag_name}, token => $token); |
| 6612 |
} |
} |
| 6613 |
## Ignore the token |
## Ignore the token |
| 6614 |
!!!nack ('t322.1'); |
!!!nack ('t322.1'); |
| 6616 |
next B; |
next B; |
| 6617 |
} |
} |
| 6618 |
} elsif ($token->{type} == END_TAG_TOKEN) { |
} elsif ($token->{type} == END_TAG_TOKEN) { |
|
if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) { |
|
|
!!!cp ('t323'); |
|
|
!!!parse-error (type => 'after html:/', |
|
|
text => $token->{tag_name}, token => $token); |
|
|
|
|
|
$self->{insertion_mode} = AFTER_FRAMESET_IM; |
|
|
## Process in the "after frameset" insertion mode. |
|
|
} else { |
|
|
!!!cp ('t324'); |
|
|
} |
|
|
|
|
| 6619 |
if ($token->{tag_name} eq 'frameset' and |
if ($token->{tag_name} eq 'frameset' and |
| 6620 |
$self->{insertion_mode} == IN_FRAMESET_IM) { |
$self->{insertion_mode} == IN_FRAMESET_IM) { |
| 6621 |
if ($self->{open_elements}->[-1]->[1] & HTML_EL and |
if ($self->{open_elements}->[-1]->[1] & HTML_EL and |
| 6650 |
!!!cp ('t330'); |
!!!cp ('t330'); |
| 6651 |
!!!parse-error (type => 'in frameset:/', |
!!!parse-error (type => 'in frameset:/', |
| 6652 |
text => $token->{tag_name}, token => $token); |
text => $token->{tag_name}, token => $token); |
| 6653 |
} else { |
} elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) { |
| 6654 |
!!!cp ('t331'); |
!!!cp ('t330.1'); |
| 6655 |
!!!parse-error (type => 'after frameset:/', |
!!!parse-error (type => 'after frameset:/', |
| 6656 |
text => $token->{tag_name}, token => $token); |
text => $token->{tag_name}, token => $token); |
| 6657 |
|
} else { # "after after html" |
| 6658 |
|
!!!cp ('t331'); |
| 6659 |
|
!!!parse-error (type => 'after after frameset:/', |
| 6660 |
|
text => $token->{tag_name}, token => $token); |
| 6661 |
} |
} |
| 6662 |
## Ignore the token |
## Ignore the token |
| 6663 |
!!!next-token; |
!!!next-token; |
| 7380 |
!!!cp ('t413'); |
!!!cp ('t413'); |
| 7381 |
!!!parse-error (type => 'unmatched end tag', |
!!!parse-error (type => 'unmatched end tag', |
| 7382 |
text => $token->{tag_name}, token => $token); |
text => $token->{tag_name}, token => $token); |
| 7383 |
|
## NOTE: Ignore the token. |
| 7384 |
} else { |
} else { |
| 7385 |
## Step 1. generate implied end tags |
## Step 1. generate implied end tags |
| 7386 |
while ({ |
while ({ |
| 7440 |
!!!cp ('t421'); |
!!!cp ('t421'); |
| 7441 |
!!!parse-error (type => 'unmatched end tag', |
!!!parse-error (type => 'unmatched end tag', |
| 7442 |
text => $token->{tag_name}, token => $token); |
text => $token->{tag_name}, token => $token); |
| 7443 |
|
## NOTE: Ignore the token. |
| 7444 |
} else { |
} else { |
| 7445 |
## Step 1. generate implied end tags |
## Step 1. generate implied end tags |
| 7446 |
while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) { |
while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) { |
| 7487 |
!!!cp ('t425.1'); |
!!!cp ('t425.1'); |
| 7488 |
!!!parse-error (type => 'unmatched end tag', |
!!!parse-error (type => 'unmatched end tag', |
| 7489 |
text => $token->{tag_name}, token => $token); |
text => $token->{tag_name}, token => $token); |
| 7490 |
|
## NOTE: Ignore the token. |
| 7491 |
} else { |
} else { |
| 7492 |
## Step 1. generate implied end tags |
## Step 1. generate implied end tags |
| 7493 |
while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) { |
while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) { |
| 7690 |
## TODO: script stuffs |
## TODO: script stuffs |
| 7691 |
} # _tree_construct_main |
} # _tree_construct_main |
| 7692 |
|
|
| 7693 |
sub set_inner_html ($$$) { |
sub set_inner_html ($$$;$) { |
| 7694 |
my $class = shift; |
my $class = shift; |
| 7695 |
my $node = shift; |
my $node = shift; |
| 7696 |
my $s = \$_[0]; |
my $s = \$_[0]; |
| 7697 |
my $onerror = $_[1]; |
my $onerror = $_[1]; |
| 7698 |
|
my $get_wrapper = $_[2] || sub ($) { return $_[0] }; |
| 7699 |
|
|
| 7700 |
## ISSUE: Should {confident} be true? |
## ISSUE: Should {confident} be true? |
| 7701 |
|
|
| 7714 |
} |
} |
| 7715 |
|
|
| 7716 |
## Step 3, 4, 5 # MUST |
## Step 3, 4, 5 # MUST |
| 7717 |
$class->parse_string ($$s => $node, $onerror); |
$class->parse_char_string ($$s => $node, $onerror, $get_wrapper); |
| 7718 |
} elsif ($nt == 1) { |
} elsif ($nt == 1) { |
| 7719 |
## TODO: If non-html element |
## TODO: If non-html element |
| 7720 |
|
|
| 7721 |
## NOTE: Most of this code is copied from |parse_string| |
## NOTE: Most of this code is copied from |parse_string| |
| 7722 |
|
|
| 7723 |
|
## TODO: Support for $get_wrapper |
| 7724 |
|
|
| 7725 |
## Step 1 # MUST |
## Step 1 # MUST |
| 7726 |
my $this_doc = $node->owner_document; |
my $this_doc = $node->owner_document; |
| 7727 |
my $doc = $this_doc->implementation->create_document; |
my $doc = $this_doc->implementation->create_document; |
| 7794 |
}; |
}; |
| 7795 |
$p->{prev_char} = [-1, -1, -1]; |
$p->{prev_char} = [-1, -1, -1]; |
| 7796 |
$p->{next_char} = -1; |
$p->{next_char} = -1; |
| 7797 |
|
|
| 7798 |
|
$p->{read_until} = sub { |
| 7799 |
|
## TODO: ... |
| 7800 |
|
return 0; |
| 7801 |
|
}; # $p->{read_until}; |
| 7802 |
|
|
| 7803 |
my $ponerror = $onerror || sub { |
my $ponerror = $onerror || sub { |
| 7804 |
my (%opt) = @_; |
my (%opt) = @_; |
| 7805 |
my $line = $opt{line}; |
my $line = $opt{line}; |