Data::Visitor::Encode - Encode/Decode Values In A Structure

Data-Visitor-Encode documentation Contained in the Data-Visitor-Encode distribution.

Index

Code Index:

NAME

Top

Data::Visitor::Encode - Encode/Decode Values In A Structure

SYNOPSIS

Top

  use Data::Visitor::Encode;

  my $dev = Data::Visitor::Encode->new();
  my %hash = (...); # assume data is in Perl native Unicode
  $dev->encode('euc-jp', \%hash); # now strings are in euc-jp
  $dev->decode('euc-jp', \%hash); # now strings are back in unicode
  $dev->utf8_on(\%hash);
  $dev->utf8_off(\%hash);

DEPRECATION WARNING

Top

In all honesty, this module is a bit too much for what it's doing. Please checkout Data::Recursive::Encode for a faster implementation with less dependencies.

I'll support the module for a while, but be advised that I will probably deprecate it sometime in the future

DESCRIPTION

Top

Data::Visitor::Encode visits each node of a structure, and returns a new structure with each node's encoding (or similar action). If you ever wished to do a bulk encode/decode of the contents of a structure, then this module may help you.

Starting from 0.09000, you can directly use the methods without instantiating the object:

  Data::Visitor::Encode->encode('euc-jp', $obj);
  # instead of Data::Visitor::Encode->new->encod('euc-jp', $obj)

METHODS

Top

utf8_on

  $dev->utf8_on(\%hash);
  $dev->utf8_on(\@list);
  $dev->utf8_on(\$scalar);
  $dev->utf8_on($scalar);
  $dev->utf8_on($object);

Returns a structure containing nodes with utf8 flag on

utf8_off

  $dev->utf8_off(\%hash);
  $dev->utf8_off(\@list);
  $dev->utf8_off(\$scalar);
  $dev->utf8_off($scalar);
  $dev->utf8_off($object);

Returns a structure containing nodes with utf8 flag off

encode

  $dev->encode($encoding, \%hash   [, CHECK]);
  $dev->encode($encoding, \@list   [, CHECK]);
  $dev->encode($encoding, \$scalar [, CHECK]);
  $dev->encode($encoding, $scalar  [, CHECK]);
  $dev->encode($encoding, $object  [, CHECK]);

Returns a structure containing nodes which are encoded in the specified encoding.

decode

  $dev->decode($encoding, \%hash);
  $dev->decode($encoding, \@list);
  $dev->decode($encoding, \$scalar);
  $dev->decode($encoding, $scalar);
  $dev->decode($encoding, $object);

Returns a structure containing nodes which are decoded from the specified encoding.

decode_utf8

  $dev->decode_utf8(\%hash);
  $dev->decode_utf8(\@list);
  $dev->decode_utf8(\$scalar);
  $dev->decode_utf8($scalar);
  $dev->decode_utf8($object);

Returns a structure containing nodes which have been processed through decode_utf8.

encode_utf8

  $dev->encode_utf8(\%hash);
  $dev->encode_utf8(\@list);
  $dev->encode_utf8(\$scalar);
  $dev->encode_utf8($scalar);
  $dev->encode_utf8($object);

Returns a structure containing nodes which have been processed through encode_utf8.

h2z

z2h

  $dev->h2z($encoding, \%hash);
  $dev->h2z($encoding, \@list);
  $dev->h2z($encoding, \$scalar);
  $dev->h2z($encoding, $scalar);
  $dev->h2z($encoding, $object);

h2z and z2h are Japanese-only methods (hey, I'm a little biased like that). They perform the task of mapping half-width katakana to full-width katakana and vice-versa.

These methods use Encode::JP::H2Z, which requires us to go from the original encoding to euc-jp and then back. There are other modules that are built to handle exactly this problem, which may come out to be faster than using Encode.pm's somewhat hidden Encode::JP::H2Z, but I really don't care for adding another dependency to this module other than Encode.pm, so here it is.

If you're significantly worried about performance, I'll gladly accept patches as long as there are no prerequisite modules or the prerequisite is optional.

decode_utf8

  $dev->decode_utf8(\%hash);
  $dev->decode_utf8(\@list);
  $dev->decode_utf8(\$scalar);
  $dev->decode_utf8($scalar);
  $dev->decode_utf8($object);

Returns a structure containing nodes which have been processed through decode_utf8.

encode_utf8

  $dev->encode_utf8(\%hash);
  $dev->encode_utf8(\@list);
  $dev->encode_utf8(\$scalar);
  $dev->encode_utf8($scalar);
  $dev->encode_utf8($object);

Returns a structure containing nodes which have been processed through encode_utf8.

do_decode

do_encode

do_utf8_off

do_utf8_on

do_h2z

do_z2h

do_encode_utf8

do_decode_utf8

visit_glob

visit_hash

visit_object

visit_scalar

visit_value

These methods are private. Only use if it you are subclassing this class.

AUTHOR

Top

Copyright (c) 2007 Daisuke Maki <daisuke@endeworks.jp>

SEE ALSO

Top

Data::Visitor, Encode

LICENSE

Top

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html

Data-Visitor-Encode documentation Contained in the Data-Visitor-Encode distribution. 
package Data::Visitor::Encode;
use Moose;
use Encode();
use Scalar::Util ();

extends 'Data::Visitor';

our $VERSION = '0.10006';

has 'visit_method' => (
    is => 'rw',
    isa => 'Str'
);

has 'extra_args' => (
    is => 'rw',
);

__PACKAGE__->meta->make_immutable;

no Moose;

sub _object { ref $_[0] ? $_[0] : $_[0]->new }

sub visit_glob
{
    return $_[1];
}

sub visit_scalar
{
    my ($self, $ref) = @_;

    my $ret = $self->visit_value($$ref);
    if ($ret) {
        return \$ret;
    }
    return undef;
}

# We care about the hash key as well, so override
sub visit_hash
{
    my ($self, $hash) = @_;

    my %map = map {
        (
            $self->visit_value($_),
            $self->visit($hash->{$_})
        )
    } keys %$hash;
    return \%map;
}

sub visit_object
{
    my ($self, $data) = @_;

    my $type = lc (Scalar::Util::reftype($data));
    my $method = "visit_$type";
    my $ret    = $self->$method($data);

    return bless $ret, Scalar::Util::blessed($data);
}

sub visit_value
{
    my ($self, $data) = @_;

    # return as-is if undefined
    return $data unless defined $data;

    # return as-is if no method
    my $method = $self->visit_method();
    return $data unless $method;

    # return if unimplemented
    $method = "do_$method";
#    return $data if (! $self->can($method));

    return $self->$method($data);
}

sub do_utf8_on
{
    my $self = shift;
    my $data = shift;

    Encode::_utf8_on($data);
    return $data;
}

sub do_utf8_off
{
    my $self = shift;
    my $data = shift;

    Encode::_utf8_off($data);
    return $data;
}

sub utf8_on
{
    my $self = _object(shift);
    $self->visit_method('utf8_on');
    $self->visit($_[0]);
}

sub utf8_off
{
    my $self = _object(shift);
    $self->visit_method('utf8_off');
    $self->visit($_[0]);
}

sub do_encode {
    my $self = shift;
    return $_[0] = $self->{__encoding}->encode($_[0]);
}

sub do_decode {
    my $self = shift;
    return $_[0] = $self->{__encoding}->decode($_[0]);
}

sub decode
{
    my $self = _object(shift);
    my $code = shift;

    my $encoding = Encode::find_encoding( $code );
    if (! $encoding) {
        Carp::confess("Could not find encoding by the name of $encoding");
    }
    local $self->{__encoding} = $encoding;
    $self->extra_args($code);
    $self->visit_method('decode');
    $_[0] = $self->visit($_[0]);
}

sub encode
{
    my $self = _object(shift);
    my $code = shift;

    my $encoding = Encode::find_encoding( $code );
    if (! $encoding) {
        Carp::confess("Could not find encoding by the name of $encoding");
    }
    local $self->{__encoding} = $encoding;
    $self->extra_args($code);
    $self->visit_method('encode');
    $_[0] = $self->visit($_[0]);
}

sub do_decode_utf8 {
    my $self = shift;
    return $_[0] = Encode::decode_utf8($_[0]);
}

sub decode_utf8
{
    my $self = _object(shift);
    $self->visit_method('decode_utf8');
    $_[0] = $self->visit($_[0]);
}

sub do_encode_utf8
{
    my $self = shift;
    return $_[0] = Encode::encode_utf8($_[0]);
}

sub encode_utf8
{
    my $self = _object(shift);
    my $enc  = $_[1];
    $self->visit_method('encode_utf8');
    $_[0] = $self->visit($_[0]);
}

sub do_h2z
{
    my $self = shift;

    my $is_euc = ($self->extra_args =~ /^euc-jp$/i);
    my $utf8_on = Encode::is_utf8($_[0]);
    my $euc_encoding = $self->{__euc};
    my $encoding = $self->{__encoding};
    my $euc  =
        $is_euc ?
            $_[0] :
        $utf8_on ?
            $euc_encoding->encode($_[0]) :
            $euc_encoding->encode($encoding->decode($_[0]))
    ;

    Encode::JP::H2Z::h2z(\$euc);

    return $_[0] = (
        $is_euc ?
            $euc :
        $utf8_on ?
            $euc_encoding->decode($euc) :
            $encoding->encode($euc_encoding->decode($euc))
    );   
}

sub h2z
{
    my $self = _object(shift);
    my $code = shift;

    require Encode::JP::H2Z;

    local $self->{__euc} = Encode::find_encoding('euc-jp');
    my $encoding = Encode::find_encoding( $code );
    if (! $encoding) {
        Carp::confess("Could not find encoding by the name of $encoding");
    }
    local $self->{__encoding} = $encoding;

    $self->visit_method('h2z');
    $self->extra_args($code);
    $self->visit($_[0]);
}

sub do_z2h
{
    my $self = shift;

    my $is_euc = ($self->extra_args =~ /^euc-jp$/i);
    my $utf8_on = Encode::is_utf8($_[0]);
    my $euc_encoding = $self->{__euc};
    my $encoding = $self->{__encoding};
    my $euc  =
        $is_euc ?
            $_[0] :
        $utf8_on ?
            $euc_encoding->encode($_[0]) :
            $euc_encoding->encode($encoding->decode($_[0]))
    ;

    Encode::JP::H2Z::z2h(\$euc);
        
    return $_[0] = (
        $is_euc ?
            $euc :
        $utf8_on ?
            $euc_encoding->decode($euc) :
            $encoding->encode($euc_encoding->decode($euc))
    );   
}

sub z2h
{
    my $self = _object(shift);
    my $code = shift;

    require Encode::JP::H2Z;

    local $self->{__euc} = Encode::find_encoding('euc-jp');
    my $encoding = Encode::find_encoding( $code );
    if (! $encoding) {
        Carp::confess("Could not find encoding by the name of $encoding");
    }
    local $self->{__encoding} = $encoding;

    $self->visit_method('z2h');
    $self->extra_args($code);
    $self->visit($_[0]);
}

1;

__END__