Support building nonxs extensions from cpan/ on Unix.
[perl.git] / ext / Encode / lib / Encode / Encoder.pm
1 #
2 # $Id: Encoder.pm,v 2.1 2006/05/03 18:24:10 dankogai Exp $
3 #
4 package Encode::Encoder;
5 use strict;
6 use warnings;
7 our $VERSION = do { my @r = ( q$Revision: 2.1 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
8
9 require Exporter;
10 our @ISA       = qw(Exporter);
11 our @EXPORT_OK = qw ( encoder );
12
13 our $AUTOLOAD;
14 sub DEBUG () { 0 }
15 use Encode qw(encode decode find_encoding from_to);
16 use Carp;
17
18 sub new {
19     my ( $class, $data, $encname ) = @_;
20     unless ($encname) {
21         $encname = Encode::is_utf8($data) ? 'utf8' : '';
22     }
23     else {
24         my $obj = find_encoding($encname)
25           or croak __PACKAGE__, ": unknown encoding: $encname";
26         $encname = $obj->name;
27     }
28     my $self = {
29         data     => $data,
30         encoding => $encname,
31     };
32     bless $self => $class;
33 }
34
35 sub encoder { __PACKAGE__->new(@_) }
36
37 sub data {
38     my ( $self, $data ) = @_;
39     if ( defined $data ) {
40         $self->{data} = $data;
41         return $data;
42     }
43     else {
44         return $self->{data};
45     }
46 }
47
48 sub encoding {
49     my ( $self, $encname ) = @_;
50     if ($encname) {
51         my $obj = find_encoding($encname)
52           or confess __PACKAGE__, ": unknown encoding: $encname";
53         $self->{encoding} = $obj->name;
54         return $self;
55     }
56     else {
57         return $self->{encoding};
58     }
59 }
60
61 sub bytes {
62     my ( $self, $encname ) = @_;
63     $encname ||= $self->{encoding};
64     my $obj = find_encoding($encname)
65       or confess __PACKAGE__, ": unknown encoding: $encname";
66     $self->{data} = $obj->decode( $self->{data}, 1 );
67     $self->{encoding} = '';
68     return $self;
69 }
70
71 sub DESTROY {    # defined so it won't autoload.
72     DEBUG and warn shift;
73 }
74
75 sub AUTOLOAD {
76     my $self = shift;
77     my $type = ref($self)
78       or confess "$self is not an object";
79     my $myname = $AUTOLOAD;
80     $myname =~ s/.*://;    # strip fully-qualified portion
81     my $obj = find_encoding($myname)
82       or confess __PACKAGE__, ": unknown encoding: $myname";
83     DEBUG and warn $self->{encoding}, " => ", $obj->name;
84     if ( $self->{encoding} ) {
85         from_to( $self->{data}, $self->{encoding}, $obj->name, 1 );
86     }
87     else {
88         $self->{data} = $obj->encode( $self->{data}, 1 );
89     }
90     $self->{encoding} = $obj->name;
91     return $self;
92 }
93
94 use overload
95   q("") => sub { $_[0]->{data} },
96   q(0+) => sub { use bytes(); bytes::length( $_[0]->{data} ) },
97   fallback => 1,
98   ;
99
100 1;
101 __END__
102
103 =head1 NAME
104
105 Encode::Encoder -- Object Oriented Encoder
106
107 =head1 SYNOPSIS
108
109   use Encode::Encoder;
110   # Encode::encode("ISO-8859-1", $data); 
111   Encode::Encoder->new($data)->iso_8859_1; # OOP way
112   # shortcut
113   use Encode::Encoder qw(encoder);
114   encoder($data)->iso_8859_1;
115   # you can stack them!
116   encoder($data)->iso_8859_1->base64;  # provided base64() is defined
117   # you can use it as a decoder as well
118   encoder($base64)->bytes('base64')->latin1;
119   # stringified
120   print encoder($data)->utf8->latin1;  # prints the string in latin1
121   # numified
122   encoder("\x{abcd}\x{ef}g")->utf8 == 6; # true. bytes::length($data)
123
124 =head1 ABSTRACT
125
126 B<Encode::Encoder> allows you to use Encode in an object-oriented
127 style.  This is not only more intuitive than a functional approach,
128 but also handier when you want to stack encodings.  Suppose you want
129 your UTF-8 string converted to Latin1 then Base64: you can simply say
130
131   my $base64 = encoder($utf8)->latin1->base64;
132
133 instead of
134
135   my $latin1 = encode("latin1", $utf8);
136   my $base64 = encode_base64($utf8);
137
138 or the lazier and more convoluted
139
140   my $base64 = encode_base64(encode("latin1", $utf8));
141
142 =head1 Description
143
144 Here is how to use this module.
145
146 =over 4
147
148 =item *
149
150 There are at least two instance variables stored in a hash reference,
151 {data} and {encoding}.
152
153 =item *
154
155 When there is no method, it takes the method name as the name of the
156 encoding and encodes the instance I<data> with I<encoding>.  If successful,
157 the instance I<encoding> is set accordingly.
158
159 =item *
160
161 You can retrieve the result via -E<gt>data but usually you don't have to 
162 because the stringify operator ("") is overridden to do exactly that.
163
164 =back
165
166 =head2 Predefined Methods
167
168 This module predefines the methods below:
169
170 =over 4
171
172 =item $e = Encode::Encoder-E<gt>new([$data, $encoding]);
173
174 returns an encoder object.  Its data is initialized with $data if
175 present, and its encoding is set to $encoding if present.
176
177 When $encoding is omitted, it defaults to utf8 if $data is already in
178 utf8 or "" (empty string) otherwise.
179
180 =item encoder()
181
182 is an alias of Encode::Encoder-E<gt>new().  This one is exported on demand.
183
184 =item $e-E<gt>data([$data])
185
186 When $data is present, sets the instance data to $data and returns the
187 object itself.  Otherwise, the current instance data is returned.
188
189 =item $e-E<gt>encoding([$encoding])
190
191 When $encoding is present, sets the instance encoding to $encoding and
192 returns the object itself.  Otherwise, the current instance encoding is
193 returned.
194
195 =item $e-E<gt>bytes([$encoding])
196
197 decodes instance data from $encoding, or the instance encoding if
198 omitted.  If the conversion is successful, the instance encoding
199 will be set to "".
200
201 The name I<bytes> was deliberately picked to avoid namespace tainting
202 -- this module may be used as a base class so method names that appear
203 in Encode::Encoding are avoided.
204
205 =back
206
207 =head2 Example: base64 transcoder
208
209 This module is designed to work with L<Encode::Encoding>.
210 To make the Base64 transcoder example above really work, you could
211 write a module like this:
212
213   package Encode::Base64;
214   use base 'Encode::Encoding';
215   __PACKAGE__->Define('base64');
216   use MIME::Base64;
217   sub encode{ 
218       my ($obj, $data) = @_; 
219       return encode_base64($data);
220   }
221   sub decode{
222       my ($obj, $data) = @_; 
223       return decode_base64($data);
224   }
225   1;
226   __END__
227
228 And your caller module would be something like this:
229
230   use Encode::Encoder;
231   use Encode::Base64;
232
233   # now you can really do the following
234
235   encoder($data)->iso_8859_1->base64;
236   encoder($base64)->bytes('base64')->latin1;
237
238 =head2 Operator Overloading
239
240 This module overloads two operators, stringify ("") and numify (0+).
241
242 Stringify dumps the data inside the object.
243
244 Numify returns the number of bytes in the instance data.
245
246 They come in handy when you want to print or find the size of data.
247
248 =head1 SEE ALSO
249
250 L<Encode>,
251 L<Encode::Encoding>
252
253 =cut