1# $File: //member/autrijus/Encode-compat/lib/Encode/compat/common.pm $ $Author: autrijus $ 2# $Revision: #7 $ $Change: 10024 $ $DateTime: 2004/02/13 21:42:35 $ 3 4package Encode::compat::common; 5our $VERSION = '0.06'; 6 71; 8 9package Encode; 10 11use strict; 12our $VERSION = '0.06'; 13 14our @EXPORT = qw( 15 decode decode_utf8 encode encode_utf8 16 encodings find_encoding 17); 18 19use constant DIE_ON_ERR => 1; 20use constant WARN_ON_ERR => 2; 21use constant RETURN_ON_ERR => 4; 22use constant LEAVE_SRC => 8; 23 24use constant PERLQQ => 256; 25use constant HTMLCREF => 512; 26use constant XMLCREF => 1024; 27 28use constant FB_DEFAULT => 0; 29use constant FB_CROAK => 1; 30use constant FB_QUIET => 4; 31use constant FB_WARN => 6; 32use constant FB_PERLQQ => 256; 33use constant FB_HTMLCREF => 512; 34use constant FB_XMLCREF => 1024; 35 36our @FB_FLAGS = qw(DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC 37 PERLQQ HTMLCREF XMLCREF); 38our @FB_CONSTS = qw(FB_DEFAULT FB_CROAK FB_QUIET FB_WARN 39 FB_PERLQQ FB_HTMLCREF FB_XMLCREF); 40 41our @EXPORT_OK = 42 ( 43 qw( 44 _utf8_off _utf8_on define_encoding from_to is_16bit is_8bit 45 is_utf8 perlio_ok resolve_alias utf8_downgrade utf8_upgrade 46 ), 47 @FB_FLAGS, @FB_CONSTS, 48 ); 49 50our %EXPORT_TAGS = 51 ( 52 all => [ @EXPORT, @EXPORT_OK ], 53 fallbacks => [ @FB_CONSTS ], 54 fallback_all => [ @FB_CONSTS, @FB_FLAGS ], 55 ); 56 57sub from_to ($$$;$) { 58 use utf8; 59 60 # XXX: bad hack 61 if ($_[3] and $_[3] == FB_HTMLCREF() and lc($_[2]) eq 'latin1') { 62 $_[0] = join('', map { 63 ord($_) < 128 64 ? $_ : '&#' . ord($_) . ';' 65 } split(//, decode($_[1], $_[0]))); 66 } 67 else { 68 $_[0] = _convert(@_[0..2]); 69 } 70} 71 72sub encodings { 73 # XXX: revisit 74 require Encode::Alias; 75 return sort values %Encode::Alias::Alias; 76} 77 78sub find_encoding { 79 return $_[0]; 80} 81 82sub decode_utf8($;$) { 83 return decode("utf-8", @_); 84} 85 86sub encode_utf8($;$) { 87 return encode("utf-8", @_); 88} 89 90sub decode($$;$) { 91 my $result = ($_[0] =~ /utf-?8/i) 92 ? $_[1] : _convert($_[1], $_[0] => 'utf-8'); 93 _utf8_on($result); 94 return $result; 95} 96 97sub encode($$;$) { 98 my $result = ($_[0] =~ /utf-?8/i) 99 ? $_[1] : _convert($_[1], 'utf-8' => $_[0]); 100 _utf8_off($result); 101 return $result; 102} 103 104{ 105 my %decoder; 106 sub _convert { 107 require Text::Iconv; 108 Text::Iconv->raise_error(1); 109 110 require Encode::Alias; 111 my ($from, $to) = map { 112 s/^utf8$/utf-8/i; 113 s/^big5-eten$/big5/i; 114 $_; 115 } map { 116 Encode::Alias->find_alias($_) || lc($_) 117 } ($_[1], $_[2]); 118 119 my $result = ($from eq $to) ? $_[0] : ( 120 $decoder{$from, $to} ||= Text::Iconv->new( $from, $to ) 121 )->convert($_[0]); 122 123 return $result; 124 } 125} 126 1271; 128