File Coverage

blib/lib/Lingua/Han/PinYin.pm

Criterion	Covered	Total	%
statement	76	78	97.4
branch	51	66	77.2
condition			n/a
subroutine	9	9	100.0
pod	3	4	75.0
total	139	157	88.5

package Lingua::Han::PinYin;

use strict;
use warnings;
our $VERSION = '0.23';

use File::Spec ();
use Lingua::Han::Utils qw/Unihan_value/;

sub new {
    my $class = shift;

    my $dir   = __FILE__;
    $dir =~ s/\.pm//o;
    -d $dir or die "Directory $dir does not exists, please consider to reinstall this module.";

    my %args = (@_ % 2 == 1) ? %{ $_[0] } : (@_);

    my %py;
    my $file = File::Spec->catfile( $dir, 'Mandarin.dat' );
    open(my $fh, '<', $file) or die "Can't open $file: $!";
    while (my $line = <$fh>) {
        chomp($line);
        my ( $uni, $py ) = split(/\s+/, $line);
        $py{$uni} = $py;
    }
    close($fh);

    $args{'py'} = \%py;

    return bless \%args => $class;
}

sub han2pinyin1 {
    my ($self, $word) = @_;
    my $code = Unihan_value($word);
    my $value = $self->{'py'}->{$code};
    if (defined $value) {
        $value = $self->_fix_val( $value );
    } else {
        # not found in dictionary, return original word
        $value = $word;
    }
    return $value;
}

sub han2pinyin {
    my ( $self, $hanzi ) = @_;

    my @code = Unihan_value($hanzi);

    my @result;
    foreach my $code (@code) {
        my $value = $self->{'py'}->{$code};
        if ( defined $value ) {
            $value = $self->_fix_val( $value );
        }
        else {
            # if it's not a Chinese, return original word
            $value = pack( "U*", hex $code );
        }
        push @result, ($self->{capitalize} ? ucfirst $value : $value);
    }

    return wantarray ? @result : join( '', @result );

}

sub gb2pinyin {
    my ($self, $hanzi) = @_;

    # convert only normal Chinese letter. Ignore Chinese symbols
    # which fall within [0xa1,0xb0) region. 0xb0==0260
    # if it is not normal Chinese, retain original characters
    $hanzi =~ s/[\260-\377][\200-\377]/$self->han2pinyin1($&)/ge;
    return $hanzi;
}

sub _fix_val {
    my ( $self, $value ) = @_;

    if ($self->{unicode}) {
        return $value;
    }

    # convert into ascii
    $value =~ s/ū/u/g and $value .= '1';
    $value =~ s/ǖ/u/g and $value .= '1';
    $value =~ s/ī/i/g and $value .= '1';
    $value =~ s/ō/o/g and $value .= '1';
    $value =~ s/ā/a/g and $value .= '1';
    $value =~ s/ē/e/g and $value .= '1';

    $value =~ s/í/i/g and $value .= '2';
    $value =~ s/é/e/g and $value .= '2';
    $value =~ s/ú/u/g and $value .= '2';
    $value =~ s/ó/o/g and $value .= '2';
    $value =~ s/ǘ/v/g and $value .= '2';
    $value =~ s/á/a/g and $value .= '2';

    $value =~ s/ě/e/g and $value .= '3';
    $value =~ s/ǎ/a/g and $value .= '3';
    $value =~ s/ǒ/o/g and $value .= '3';
    $value =~ s/ǔ/u/g and $value .= '3';
    $value =~ s/ǚ/v/g and $value .= '3';
    $value =~ s/ǐ/i/g and $value .= '3';

    $value =~ s/ò/o/g and $value .= '4';
    $value =~ s/à/a/g and $value .= '4';
    $value =~ s/è/e/g and $value .= '4';
    $value =~ s/ù/u/g and $value .= '4';
    $value =~ s/ǜ/v/g and $value .= '4';
    $value =~ s/ì/i/g and $value .= '4';

    $value =~ s/\d//g unless $self->{tone};
    return $value;
}

1;
__END__