File Coverage

blib/lib/Locale/Recode.pm

Criterion	Covered	Total	%
statement	36	60	60.0
branch	9	20	45.0
condition	2	6	33.3
subroutine	5	7	71.4
pod	4	6	66.6
total	56	99	56.5

#! /bin/false

# vim: set autoindent shiftwidth=4 tabstop=4:

# Portable character conversion for Perl.
# Copyright (C) 2002-2017 Guido Flohr ,
# all rights reserved.

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see .

package Locale::Recode;

use strict;

require Locale::Recode::_Conversions;

my $loaded = {};
my $has_encode;

sub new
{
    my $class = ref($_[0]) || $_[0];
    shift;
    my %args = @_;

    my $self = bless {}, $class;

    my ($from_codeset, $to_codeset) = @args{qw (from to)};

    unless ($from_codeset && $to_codeset) {
		require Carp;
        Carp::croak (<
	Usage: $class->new (from => FROM_CODESET, to => TO_CODESET);
EOF
    }

    # Find a conversion path.
	my $path = Locale::Recode::_Conversions->findPath ($from_codeset,
													   $to_codeset);
	unless ($path) {
		$self->{__error} = 'EINVAL';
		return $self;
	}

	my @conversions = ();
	foreach (@$path) {
		my ($module, $from, $to) = @$_;

		unless ($loaded->{$module}) {
			eval "require Locale::RecodeData::$module";
			if ($@) {
				$self->{__error} = $@;
				return $self;
			}

			$loaded->{$module} = 1;
		}

		my $module_name = "Locale::RecodeData::$module";
		my $method = 'new';
		my $object = $module_name->$method (from => $from,
											to => $to);

		push @conversions, $object;
	}

	$self->{__conversions} = \@conversions;

    return $self;
}

sub resolveAlias
{
	my ($class, $alias) = @_;

	return Locale::Recode::_Conversions->resolveAlias ($alias);
}

sub getSupported
{
	return [ Locale::Recode::_Conversions->listSupported ];
}

sub getCharsets
{
	my $self = shift;
	my %all = map { $_ => 1 } @{&getSupported};

	require Locale::Recode::_Aliases;

	my $conversions = Locale::Recode::_Conversions->listSupported;
	foreach my $charset (keys %{Locale::Recode::_Aliases::ALIASES()}) {
		my $mime_name = $self->resolveAlias ($charset);
		next unless exists $all{$mime_name};
		$all{$charset} = 1;
	}

	return [ keys %all ];
}

sub recode
{
    my $self = $_[0];

    return if $self->{__error};

    return 1 unless defined $_[1];

    my $chain = $self->{__conversions};

    foreach my $module (@$chain) {
		my $success = $module->_recode ($_[1]);

		unless ($success) {
			$self->{__error} = $module->_getError;
			return;
		}
    }

    return 1;
}

sub getError
{
    my $self = shift;
    my $error = $self->{__error} or return;

    if ('EINVAL' eq $error) {
		return 'Invalid conversion';
    } else {
		return $error;
    }
}

1;

__END__