/[pub]/test/oldencodeutils/lib/Encode/Charset.pm
Suika

Diff of /test/oldencodeutils/lib/Encode/Charset.pm

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

revision 1.5 by wakaba, Wed Oct 16 10:39:35 2002 UTC revision 1.6 by wakaba, Sat Dec 14 11:02:25 2002 UTC
# Line 240  sub new_object { Line 240  sub new_object {
240                          default => -1,                          default => -1,
241                  },                  },
242          },          },
243            fallback_from_ucs       => 'replacement',
244                    ## 'replacement' / 'perl' / 'sgml' / 'sgml-hex' / 'x-u-escaped' / 'code'
245                    ## / 'quiet' / 'quiet+back' / 'quiet+warn' / 'quiet+back+warn' / 'croak'
246                    ## / code
247          final_to_set    => {          final_to_set    => {
248                  C0 => {}, C1 => {}, G94 => {}, G94n => {},                  C0 => {}, C1 => {}, G94 => {}, G94n => {},
249                  G96 => {}, G96n => {}, coding_system => {},                  G96 => {}, G96n => {}, coding_system => {},
# Line 284  sub new_object_sjis { Line 288  sub new_object_sjis {
288    $C;    $C;
289  }  }
290    
291  1;  our %FallbackFromUCS = (
292  __END__          perl    => sub { my $c = $_[1]; sprintf '\x{%04X}', ord $c },
293            sgml    => sub { my $c = $_[1]; sprintf '&#%d;', ord $c },
294            'sgml-hex'      => sub { my $c = $_[1]; 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 },
296    );
297    
298    sub fallback_escape ($$;%) {
299      my ($C, $c, %option) = @_;
300      my $f = ref ($C->{option}->{fallback_from_ucs}) eq 'CODE' ? $C->{option}->{fallback_from_ucs} :
301              $FallbackFromUCS{$C->{option}->{fallback_from_ucs}};
302      if (ref $f) {
303        Encode::_utf8_on ($c);
304        return &$f ($C, $c, %option);
305      }
306      undef;
307    }
308    
309  =head1 AUTHORS  =head1 AUTHORS
310    
311  Nanashi-san  Nanashi-san <nanashi-san@nanashi.invalid>
312    
313  Wakaba <w@suika.fam.cx>  Wakaba <w@suika.fam.cx>
314    
315  =head1 LICENSE  =head1 LICENSE
316    
317  Copyright 2002 AUTHORS  Copyright 2002 AUTHORS, all rights reserved.
318    
319  This library is free software; you can redistribute it  This library is free software; you can redistribute it
320  and/or modify it under the same terms as Perl itself.  and/or modify it under the same terms as Perl itself.
321    
322  =cut  =cut
323    
324  # $Date$  1; # $Date$
 ### Charset.pm ends here  
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24