view release on metacpan or  search on metacpan

lib/Encode/Encoder.pm  view on Meta::CPAN

#
# $Id: Encoder.pm,v 2.3 2013/09/14 07:51:59 dankogai Exp $
#
package Encode::Encoder;
use strict;
use warnings;
our $VERSION = do { my @r = ( q$Revision: 2.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw ( encoder );

our $AUTOLOAD;
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
use Encode qw(encode decode find_encoding from_to);
use Carp;

sub new {
    my ( $class, $data, $encname ) = @_;
    unless ($encname) {
        $encname = Encode::is_utf8($data) ? 'utf8' : '';
    }
    else {
        my $obj = find_encoding($encname)
          or croak __PACKAGE__, ": unknown encoding: $encname";
        $encname = $obj->name;
    }
    my $self = {
        data     => $data,
        encoding => $encname,
    };
    bless $self => $class;
}

sub encoder { __PACKAGE__->new(@_) }

sub data {
    my ( $self, $data ) = @_;
    if ( defined $data ) {
        $self->{data} = $data;
        return $data;
    }
    else {
        return $self->{data};
    }
}

sub encoding {
    my ( $self, $encname ) = @_;
    if ($encname) {
        my $obj = find_encoding($encname)
          or confess __PACKAGE__, ": unknown encoding: $encname";
        $self->{encoding} = $obj->name;
        return $self;
    }
    else {
        return $self->{encoding};
    }
}

sub bytes {
    my ( $self, $encname ) = @_;
    $encname ||= $self->{encoding};
    my $obj = find_encoding($encname)
      or confess __PACKAGE__, ": unknown encoding: $encname";
    $self->{data} = $obj->decode( $self->{data}, 1 );
    $self->{encoding} = '';
    return $self;
}

sub DESTROY {    # defined so it won't autoload.
    DEBUG and warn shift;
}

sub AUTOLOAD {
    my $self = shift;
    my $type = ref($self)
      or confess "$self is not an object";
    my $myname = $AUTOLOAD;
    $myname =~ s/.*://;    # strip fully-qualified portion
    my $obj = find_encoding($myname)
      or confess __PACKAGE__, ": unknown encoding: $myname";
    DEBUG and warn $self->{encoding}, " => ", $obj->name;
    if ( $self->{encoding} ) {
        from_to( $self->{data}, $self->{encoding}, $obj->name, 1 );
    }
    else {
        $self->{data} = $obj->encode( $self->{data}, 1 );
    }
    $self->{encoding} = $obj->name;
    return $self;
}