File Coverage

blib/lib/CCCP/Encode.pm

Criterion	Covered	Total	%
statement	12	34	35.2
branch	0	20	0.0
condition	0	8	0.0
subroutine	4	6	66.6
pod	1	1	100.0
total	17	69	24.6

package CCCP::Encode;

use strict;
use warnings;

use Encode;
use Text::Unidecode;

our $VERSION = '0.03';

$CCCP::Encode::ToText = 0;
$CCCP::Encode::Entities = 'xml';
$CCCP::Encode::CharMap = {};
$CCCP::Encode::Regexp = '[^\p{Cyrillic}|\p{IsLatin}|\p{InBasic_Latin}]';

my $xml_entities = {
	'&' => '&',
	'"' => '"',
	"'" => ''',
	'>' => '>',
	'<' => '<'
};

my $f = find_encoding('utf-8');
my $t = undef;
__err_msg("Unknown encoding 'utf-8'") unless defined $f;

sub utf2cyrillic {
    my ( $class, $str, $to ) = @_;

    if ($CCCP::Encode::ToText and not UNIVERSAL::isa($CCCP::Encode::CharMap,'HASH') ) {
        __err_msg("\$CCCP::Encode::CharMap must be hash ref");
    };

    return undef unless defined $str;

    __err_msg("missing 'to' argument") unless $to;
    return $str if ($to =~ /^utf/i);

    $t = find_encoding($to) unless ($t and $t->name eq $to);
    __err_msg("Unknown encoding '$to'") unless defined $t;

    Encode::_utf8_off($str);

    unless ($CCCP::Encode::ToText) {
	    # decode with html entities
        $CCCP::Encode::Entities ||= 'xml';
    	my $str = $t->encode($f->decode($str), $CCCP::Encode::Entities eq 'xml' ? Encode::FB_XMLCREF : Encode::FB_HTMLCREF);
    	if ($CCCP::Encode::Entities eq 'xml') {
    		$str =~ s/('|"|<|>|&(?!#x))/$xml_entities->{$1}/geo;
    	};
    	return $str;
    } else {
    	# decode in text mode
	    ($str = $f->decode($str)) =~ s/($CCCP::Encode::Regexp)/exists $CCCP::Encode::CharMap->{$1} ? $CCCP::Encode::CharMap->{$1} : unidecode($1)/sexg;
	    return $t->encode($str);
    };
}

sub __err_msg {
	my ($str) = @_;

    require Carp;
    Carp::croak(__PACKAGE__.": ".$str);
}

1;
__END__