01 1:11 "ˆl–Ü4ý(TËmJq@†ã/ܔţ¿ ƒh¹ÃÂ"ˆl–Ü4ý(TËmJq@‚ã,ÜlJbÑ¿À ƒh¹ÄÃ2 1:8 0ˆl–ßi~”ËmJi@ ãOܪbÑ¿Á „dO´ï_‹uÐb &=LV[(ÆÅ?÷# # $Id: Encode.pm,v 2.51 2013/04/29 22:19:11 dankogai Exp dankogai $ # package Encode; use strict; use warnings; our $VERSION = sprintf "%d.%02d", q$Revision: 2.51 $ =~ /(\d+)/g; use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG}; use XSLoader (); XSLoader::load( __PACKAGE__, $VERSION ); require Exporter; use base qw/Exporter/; # Public, encouraged API is exported by default our @EXPORT = qw( decode decode_utf8 encode encode_utf8 str2bytes bytes2str encodings find_encoding clone_encoding ); our @FB_FLAGS = qw( DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL ); our @FB_CONSTS = qw( FB_DEFAULT FB_CROAK FB_QUIET FB_WARN FB_PERLQQ FB_HTMLCREF FB_XMLCREF ); our @EXPORT_OK = ( qw( _utf8_off _utf8_on define_encoding from_to is_16bit is_8bit is_utf8 perlio_ok resolve_alias utf8_downgrade utf8_upgrade ), @FB_FLAGS, @FB_CONSTS, ); our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_OK ], default => [ @EXPORT ], fallbacks => [ @FB_CONSTS ], fallback_all => [ @FB_CONSTS, @FB_FLAGS ], ); # Documentation moved after __END__ for speed - NI-S our $ON_EBCDIC = ( ord("A") == 193 ); use Encode::Alias; # Make a %Encoding package variable to allow a certain amount of cheating our %Encoding; our %ExtModule; require Encode::Config; # See # https://bugzilla.redhat.com/show_bug.cgi?id=435505#c2 # to find why sig handers inside eval{} are disabled. eval { local $SIG{__DIE__}; local $SIG{__WARN__}; require Encode::ConfigLocal; }; sub encodings { my %enc; my $arg = $_[1] || ''; if ( $arg eq ":all" ) { %enc = ( %Encoding, %ExtModule ); } else { %enc = %Encoding; for my $mod ( map { m/::/ ? $_ : "Encode::$_" } @_ ) { DEBUG and warn $mod; for my $enc ( keys %ExtModule ) { $ExtModule{$enc} eq $mod and $enc{$enc} = $mod; } } } return sort { lc $a cmp lc $b } grep { !/^(?:Internal|Unicode|Guess)$/o } keys %enc; } sub perlio_ok { my $obj = ref( $_[0] ) ? $_[0] : find_encoding( $_[0] ); $obj->can("perlio_ok") and return $obj->perlio_ok(); return 0; # safety net } sub define_encoding { my $obj = shift; my $name = shift; $Encoding{$name} = $obj; my $lc = lc($name); define_alias( $lc => $obj ) unless $lc eq $name; while (@_) { my $alias = shift; define_alias( $alias, $obj ); } return $obj; } sub getEncoding { my ( $class, $name, $skip_external ) = @_; $name =~ s/\s+//g; # https://rt.cpan.org/Ticket/Display.html?id=65796 ref($name) && $name->can('renew') and return $name; exists $Encoding{$name} and return $Encoding{$name}; my $lc = lc $name; exists $Encoding{$lc} and return $Encoding{$lc}; my $oc = $class->find_alias($name); defined($oc) and return $oc; $lc ne $name and $oc = $class->find_alias($lc); defined($oc) and return $oc; unless ($skip_external) { if ( my $mod = $ExtModule{$name} || $ExtModule{$lc} ) { $mod =~ s,::,/,g; $mod .= '.pm'; eval { require $mod; }; exists $Encoding{$name} and return $Encoding{$name}; } } return; } sub find_encoding($;$) { my ( $name, $skip_external ) = @_; return __PACKAGE__->getEncoding( $name, $skip_external ); } sub resolve_alias($) { my $obj = find_encoding(shift); defined $obj and return $obj->name; return; } sub clone_encoding($) { my $obj = find_encoding(shift); ref $obj or return; eval { require Storable }; $@ and return; return Storable::dclone($obj); } sub encode($$;$) { my ( $name, $string, $check ) = @_; return undef unless defined $string; $string .= ''; # stringify; $check ||= 0; unless ( defined $name ) { requir