| 561 |
my $char_onerror = sub { |
my $char_onerror = sub { |
| 562 |
my (undef, $type, %opt) = @_; |
my (undef, $type, %opt) = @_; |
| 563 |
!!!parse-error (layer => 'encode', |
!!!parse-error (layer => 'encode', |
| 564 |
%opt, type => $type, |
line => $self->{line}, column => $self->{column} + 1, |
| 565 |
line => $self->{line}, column => $self->{column} + 1); |
%opt, type => $type); |
| 566 |
if ($opt{octets}) { |
if ($opt{octets}) { |
| 567 |
${$opt{octets}} = "\x{FFFD}"; # relacement character |
${$opt{octets}} = "\x{FFFD}"; # relacement character |
| 568 |
} |
} |
| 618 |
sub parse_char_string ($$$;$$) { |
sub parse_char_string ($$$;$$) { |
| 619 |
#my ($self, $s, $doc, $onerror, $get_wrapper) = @_; |
#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]) { |
if ($_[3]) { |
| 625 |
$input = $_[3]->($input); |
$input = $_[3]->($input); |
| 626 |
} |
} |
| 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}; |
| 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 |
|
|
| 1743 |
} else { |
} else { |
| 1744 |
!!!cp (100); |
!!!cp (100); |
| 1745 |
$self->{current_attribute}->{value} .= chr ($self->{next_char}); |
$self->{current_attribute}->{value} .= chr ($self->{next_char}); |
| 1746 |
|
$self->{read_until}->($self->{current_attribute}->{value}, |
| 1747 |
|
q["&], |
| 1748 |
|
length $self->{current_attribute}->{value}); |
| 1749 |
|
|
| 1750 |
## Stay in the state |
## Stay in the state |
| 1751 |
!!!next-input-character; |
!!!next-input-character; |
| 1752 |
redo A; |
redo A; |
| 1794 |
} else { |
} else { |
| 1795 |
!!!cp (106); |
!!!cp (106); |
| 1796 |
$self->{current_attribute}->{value} .= chr ($self->{next_char}); |
$self->{current_attribute}->{value} .= chr ($self->{next_char}); |
| 1797 |
|
$self->{read_until}->($self->{current_attribute}->{value}, |
| 1798 |
|
q['&], |
| 1799 |
|
length $self->{current_attribute}->{value}); |
| 1800 |
|
|
| 1801 |
## Stay in the state |
## Stay in the state |
| 1802 |
!!!next-input-character; |
!!!next-input-character; |
| 1803 |
redo A; |
redo A; |
| 1880 |
!!!cp (116); |
!!!cp (116); |
| 1881 |
} |
} |
| 1882 |
$self->{current_attribute}->{value} .= chr ($self->{next_char}); |
$self->{current_attribute}->{value} .= chr ($self->{next_char}); |
| 1883 |
|
$self->{read_until}->($self->{current_attribute}->{value}, |
| 1884 |
|
q["'=& >], |
| 1885 |
|
length $self->{current_attribute}->{value}); |
| 1886 |
|
|
| 1887 |
## Stay in the state |
## Stay in the state |
| 1888 |
!!!next-input-character; |
!!!next-input-character; |
| 1889 |
redo A; |
redo A; |
| 2028 |
} else { |
} else { |
| 2029 |
!!!cp (126); |
!!!cp (126); |
| 2030 |
$self->{current_token}->{data} .= chr ($self->{next_char}); # comment |
$self->{current_token}->{data} .= chr ($self->{next_char}); # comment |
| 2031 |
|
$self->{read_until}->($self->{current_token}->{data}, |
| 2032 |
|
q[>], |
| 2033 |
|
length $self->{current_token}->{data}); |
| 2034 |
|
|
| 2035 |
## Stay in the state. |
## Stay in the state. |
| 2036 |
!!!next-input-character; |
!!!next-input-character; |
| 2037 |
redo A; |
redo A; |
| 2266 |
} else { |
} else { |
| 2267 |
!!!cp (147); |
!!!cp (147); |
| 2268 |
$self->{current_token}->{data} .= chr ($self->{next_char}); # comment |
$self->{current_token}->{data} .= chr ($self->{next_char}); # comment |
| 2269 |
|
$self->{read_until}->($self->{current_token}->{data}, |
| 2270 |
|
q[-], |
| 2271 |
|
length $self->{current_token}->{data}); |
| 2272 |
|
|
| 2273 |
## Stay in the state |
## Stay in the state |
| 2274 |
!!!next-input-character; |
!!!next-input-character; |
| 2275 |
redo A; |
redo A; |
| 2635 |
!!!cp (190); |
!!!cp (190); |
| 2636 |
$self->{current_token}->{public_identifier} # DOCTYPE |
$self->{current_token}->{public_identifier} # DOCTYPE |
| 2637 |
.= chr $self->{next_char}; |
.= chr $self->{next_char}; |
| 2638 |
|
$self->{read_until}->($self->{current_token}->{public_identifier}, |
| 2639 |
|
q[">], |
| 2640 |
|
length $self->{current_token}->{public_identifier}); |
| 2641 |
|
|
| 2642 |
## Stay in the state |
## Stay in the state |
| 2643 |
!!!next-input-character; |
!!!next-input-character; |
| 2644 |
redo A; |
redo A; |
| 2675 |
!!!cp (194); |
!!!cp (194); |
| 2676 |
$self->{current_token}->{public_identifier} # DOCTYPE |
$self->{current_token}->{public_identifier} # DOCTYPE |
| 2677 |
.= chr $self->{next_char}; |
.= chr $self->{next_char}; |
| 2678 |
|
$self->{read_until}->($self->{current_token}->{public_identifier}, |
| 2679 |
|
q['>], |
| 2680 |
|
length $self->{current_token}->{public_identifier}); |
| 2681 |
|
|
| 2682 |
## Stay in the state |
## Stay in the state |
| 2683 |
!!!next-input-character; |
!!!next-input-character; |
| 2684 |
redo A; |
redo A; |
| 2815 |
!!!cp (210); |
!!!cp (210); |
| 2816 |
$self->{current_token}->{system_identifier} # DOCTYPE |
$self->{current_token}->{system_identifier} # DOCTYPE |
| 2817 |
.= chr $self->{next_char}; |
.= chr $self->{next_char}; |
| 2818 |
|
$self->{read_until}->($self->{current_token}->{system_identifier}, |
| 2819 |
|
q[">], |
| 2820 |
|
length $self->{current_token}->{system_identifier}); |
| 2821 |
|
|
| 2822 |
## Stay in the state |
## Stay in the state |
| 2823 |
!!!next-input-character; |
!!!next-input-character; |
| 2824 |
redo A; |
redo A; |
| 2855 |
!!!cp (214); |
!!!cp (214); |
| 2856 |
$self->{current_token}->{system_identifier} # DOCTYPE |
$self->{current_token}->{system_identifier} # DOCTYPE |
| 2857 |
.= chr $self->{next_char}; |
.= chr $self->{next_char}; |
| 2858 |
|
$self->{read_until}->($self->{current_token}->{system_identifier}, |
| 2859 |
|
q['>], |
| 2860 |
|
length $self->{current_token}->{system_identifier}); |
| 2861 |
|
|
| 2862 |
## Stay in the state |
## Stay in the state |
| 2863 |
!!!next-input-character; |
!!!next-input-character; |
| 2864 |
redo A; |
redo A; |
| 2919 |
redo A; |
redo A; |
| 2920 |
} else { |
} else { |
| 2921 |
!!!cp (221); |
!!!cp (221); |
| 2922 |
|
my $s = ''; |
| 2923 |
|
$self->{read_until}->($s, q[>], 0); |
| 2924 |
|
|
| 2925 |
## Stay in the state |
## Stay in the state |
| 2926 |
!!!next-input-character; |
!!!next-input-character; |
| 2927 |
redo A; |
redo A; |
| 2950 |
} else { |
} else { |
| 2951 |
!!!cp (221.4); |
!!!cp (221.4); |
| 2952 |
$self->{current_token}->{data} .= chr $self->{next_char}; |
$self->{current_token}->{data} .= chr $self->{next_char}; |
| 2953 |
|
$self->{read_until}->($self->{current_token}->{data}, |
| 2954 |
|
q<]>, |
| 2955 |
|
length $self->{current_token}->{data}); |
| 2956 |
|
|
| 2957 |
## Stay in the state. |
## Stay in the state. |
| 2958 |
!!!next-input-character; |
!!!next-input-character; |
| 2959 |
redo A; |
redo A; |
| 7837 |
}; |
}; |
| 7838 |
$p->{prev_char} = [-1, -1, -1]; |
$p->{prev_char} = [-1, -1, -1]; |
| 7839 |
$p->{next_char} = -1; |
$p->{next_char} = -1; |
| 7840 |
|
|
| 7841 |
|
$p->{read_until} = sub { |
| 7842 |
|
## TODO: ... |
| 7843 |
|
return 0; |
| 7844 |
|
}; # $p->{read_until}; |
| 7845 |
|
|
| 7846 |
my $ponerror = $onerror || sub { |
my $ponerror = $onerror || sub { |
| 7847 |
my (%opt) = @_; |
my (%opt) = @_; |
| 7848 |
my $line = $opt{line}; |
my $line = $opt{line}; |