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