File Coverage

blib/lib/Lingua/Han/Utils.pm

Criterion	Covered	Total	%
statement	45	45	100.0
branch	9	14	64.2
condition			n/a
subroutine	11	11	100.0
pod	5	5	100.0
total	70	75	93.3

package Lingua::Han::Utils;

use warnings;
use strict;
use base 'Exporter';
use vars qw/$VERSION @EXPORT_OK/;
$VERSION = '0.13';
@EXPORT_OK = qw/Unihan_value csplit cdecode csubstr clength/;

use Encode;
use Encode::Detect::CJK qw(detect);

sub cdecode {
	my $word = shift;
	my $encoding = detect($word);
	$encoding = 'cp936' if $encoding eq 'iso-8859-1'; # hard fix
	$word = decode($encoding, $word);
	return $word;
}

sub Unihan_value {
	my $word = shift;
	$word = cdecode($word) unless Encode::is_utf8($word);
	my @unihan = map { uc sprintf("%x",$_) } unpack ("U*", $word);
	return wantarray?@unihan:(join('', @unihan));
}

sub csplit {
	my $word = shift;
	my $encoding = detect($word);
	my @return_words;
	my @code = Unihan_value($word);
	foreach my $code (@code) {
		my $value = pack("U*", hex $code);
		$value = encode($encoding, $value);
		push @return_words, $value if ($value);
	}
	return wantarray?@return_words:(join('', @return_words));
}

sub csubstr {
	my ($word, $offset, $len) = @_;
	my @words = csplit($word);
	$len = scalar @words - $offset unless ($len);
	@words = splice(@words, $offset, $len);
	return wantarray?@words:(join('', @words));
}

sub clength {
	my $word = shift;
	my @words = csplit($word);
	return scalar @words;
}

1;
__END__