1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
#========================================================================
#
# Badger::Codec::Unicode
#
# DESCRIPTION
# Codec module for encoding/decoding Unicode via Encode
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
#========================================================================
package Badger::Codec::Unicode;
use 5.008; # Unicode not fully supported prior to 5.8
use Badger::Class
version => 0.01,
base => 'Badger::Codec::Encode';
use Encode qw();
use bytes;
# Default encoding
our $ENCODING = 'UTF-8';
# Byte Order Markers for different UTF encodings
our $UTFBOMS = [
'UTF-8' => "\x{ef}\x{bb}\x{bf}",
'UTF-32BE' => "\x{0}\x{0}\x{fe}\x{ff}",
'UTF-32LE' => "\x{ff}\x{fe}\x{0}\x{0}",
'UTF-16BE' => "\x{fe}\x{ff}",
'UTF-16LE' => "\x{ff}\x{fe}",
];
sub encode {
my ($self, $enc, $data) = @_ == 3 ? @_ : (shift, $ENCODING, shift);
Encode::encode($enc, $data);
}
sub decode {
my $self = shift;
if (@_ >= 2) {
goto &Encode::decode; # not a real GOTO - more like a magic
} # subroutine call - see perldoc -f goto
else {
my $data = shift;
my $count = 0;
# try all the BOMs in order looking for one (order is important
# 32bit BOMs look like 16bit BOMs)
while ($count < @$UTFBOMS) {
my $enc = $UTFBOMS->[$count++];
my $bom = $UTFBOMS->[$count++];
# does the string start with the bom?
if ($bom eq substr($data, 0, length($bom))) {
# decode it and hand it back
# return Encode::decode($enc, $data);
return Encode::decode($enc, substr($data, length($bom)), 1);
}
}
return $data;
}
}
sub encoder {
my $self = shift;
return sub { $self->encode(@_) };
}
sub decoder {
my $self = shift;
return sub { $self->decode(@_) };
}
1;
__END__
=head1 NAME
Badger::Codec::Unicode - encode/decode Unicode
=head1 SYNOPSIS
use Badger::Codec::Unicode;
my $codec = Badger::Codec::Unicode->new();
my $uncoded = "...some Unicode data...";
my $encoded = $codec->encode($uncoded);
my $decoded = $codec->decode($encoded);
=head1 DESCRIPTION
This module is a subclass of L<Badger::Codec> implementing a very thin wrapper
around the L<Encode> module for encoding and decoding Unicode.
A C<Badger::Codec::Unicode> object provides the L<encode()> and L<decode()>
methods for encoding and decoding Unicode.
use Badger::Codec::Unicode;
my $codec = Badger::Codec::Unicode->new();
my $uncoded = "...some Unicode data...";
my $encoded = $codec->encode($uncoded);
my $decoded = $codec->decode($encoded);
You can also call L<encode()> and L<decode()> as class methods.
my $encoded = Badger::Code::Unicode->encode($uncoded);
my $decoded = Badger::Code::Unicode->decode($encoded);
You can also use a codec via the L<Badger::Codecs> module.
use Badger::Codecs
codec => 'unicode';
This exports the C<encode()> and C<decode()> subroutines.
my $uncoded = "...some Unicode data...";
my $encoded = encode($uncoded);
my $decoded = decode($encoded)
=head1 METHODS
=head2 encode($encoding, $data)
Method for encoding Unicode data. If two arguments are provided then
the first is the encoding and the second the data to encode.
$encoded = $codec->encode( utf8 => $data );
If one argument is provided then the encoding defaults to C<UTF-8>.
$utf8 = $codec->encode($data);
=head2 decode($encoding, $data)
Method for decoding Unicode data. If two arguments are provided then
the first is the encoding and the second the data to decode.
$decoded = $codec->decode( utf8 => $encoded );
If one argument is provided then the method will look for a Byte Order
Mark (BOM) to determine the encoding. If a BOM isn't present, or if the
BOM doesn't match a supported Unicode BOM (any of C<UTF-8>, C<UTF-32BE>
C<UTF-32LE>, C<UTF-16BE> or C<UTF-16LE>) then the data will not be
decoded as Unicode.
$decoded = $codec->decode($encoded); # use BOM to detect encoding
=head2 encoder()
This method returns a subroutine reference which can be called to encode
Unicode data. Internally it calls the L<encode()> method.
my $encoder = $codec->encode;
$encoded = $encoder->($data);
=head2 decoder()
This method returns a suboroutine reference which can be called to decode
Unicode data. Internally it calls the L<decode()> method.
my $decoder = $codec->decode;
$decoded = $decoder->($data);
=head1 AUTHOR
Andy Wardley L<http://wardley.org/>
=head1 COPYRIGHT
Copyright (C) 2005-2009 Andy Wardley. All rights reserved.
=head1 SEE ALSO
L<Encode>, L<Badger::Codec::Encode>, L<Badger::Codecs>, L<Badger::Codec>.
=cut
# Local Variables:
# mode: Perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4:
|
