289 |
} |
} |
290 |
|
|
291 |
our %FallbackFromUCS = ( |
our %FallbackFromUCS = ( |
292 |
perl => sub { my $c = $_[1]; sprintf '\x{%04X}', ord $c }, |
perl => sub { my $c = $_[2]; sprintf '\x{%04X}', ord $c }, |
293 |
sgml => sub { my $c = $_[1]; sprintf '&#%d;', ord $c }, |
sgml => sub { my $c = $_[2]; sprintf '&#%d;', ord $c }, |
294 |
'sgml-hex' => sub { my $c = $_[1]; sprintf '&#x%04X;', ord $c }, |
'sgml-hex' => sub { my $c = $_[2]; sprintf '&#x%04X;', ord $c }, |
295 |
'x-u-escaped' => sub { my $c = $_[1]; my $C = ord $c; sprintf $C > 0xFFFF ? '\U%08X' : '\u%04X', $C }, |
'x-u-escaped' => sub { my $c = $_[2]; my $C = ord $c; sprintf $C > 0xFFFF ? '\U%08X' : '\u%04X', $C }, |
296 |
); |
); |
297 |
|
|
298 |
sub fallback_escape ($$;%) { |
sub fallback_escape ($$$;%) { |
299 |
my ($C, $c, %option) = @_; |
my (undef, $C, $c, %option) = @_; |
300 |
my $f = ref ($C->{option}->{fallback_from_ucs}) eq 'CODE' ? $C->{option}->{fallback_from_ucs} : |
my $f = $option{fallback_from_ucs} ? |
301 |
$FallbackFromUCS{$C->{option}->{fallback_from_ucs}}; |
(ref ($option{fallback_from_ucs}) eq 'CODE' ? $option{fallback_from_ucs} : |
302 |
|
$FallbackFromUCS{$option{fallback_from_ucs}}): |
303 |
|
(ref ($C->{option}->{fallback_from_ucs}) eq 'CODE' ? $C->{option}->{fallback_from_ucs} : |
304 |
|
$FallbackFromUCS{$C->{option}->{fallback_from_ucs}}); |
305 |
if (ref $f) { |
if (ref $f) { |
306 |
|
return undef if $option{_recursive} <= -10; $option{_recursive}--; ## To avoid loop |
307 |
|
my $self = bless {}, __PACKAGE__; |
308 |
Encode::_utf8_on ($c); |
Encode::_utf8_on ($c); |
309 |
return &$f ($C, $c, %option); |
return &$f ($self, $C, $c, \%option); |
310 |
} |
} |
311 |
undef; |
undef; |
312 |
} |
} |