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