File Coverage

blib/lib/Lingua/ZHO/Numbers.pm

Criterion	Covered	Total	%
statement	70	82	85.3
branch	21	32	65.6
condition	20	35	57.1
subroutine	11	15	73.3
pod	6	6	100.0
total	128	170	75.2

# For Emacs: -*- mode:cperl; mode:folding; coding:utf-8; -*-
#
# (c) 2003-2010 PetaMem, s.r.o.
#

package Lingua::ZHO::Numbers;
# ABSTRACT: Number 2 word conversion in ZHO.

# {{{ use block

use 5.10.1;
use strict;
use Carp;
use Exporter;
use base 'Exporter';
use vars qw($Charset $VERSION @EXPORT_OK);

# }}}
# {{{ variables declaration

$Lingua::ZHO::Numbers::VERSION = 0.1192;

@EXPORT_OK = 'number_to_zh';

$Charset = 'pinyin';

our %MAP = (
($] >= 5.006) ? eval  ## no critic
  q(
    'traditional'   => {
        mag => [ '', split(' ', "\x{842c} \x{5104} \x{5146} \x{4eac} \x{5793} \x{79ed} \x{7a70} \x{6e9d} \x{6f97} \x{6b63} \x{8f09} \x{6975} \x{6046}\x{6cb3}\x{6c99} \x{963f}\x{50e7}\x{7947} \x{90a3}\x{7531}\x{4ed6} \x{4e0d}\x{53ef}\x{601d}\x{8b70} \x{7121}\x{91cf}\x{5927}\x{6578}") ],
        ord => [ '', split(' ', "\x{5341} \x{767e} \x{5343}") ],
        dig => [ split(' ', "\x{96f6} \x{4e00} \x{4e8c} \x{4e09} \x{56db} \x{4e94} \x{516d} \x{4e03} \x{516b} \x{4e5d} \x{5341}") ],
        dot => "\x{9ede}",
        neg => "\x{8ca0}",
    },
    'simplified'    => {
        mag => [ '', split(' ', "\x{4e07} \x{4ebf} \x{5146} \x{4eac} \x{5793} \x{79ed} \x{7a70} \x{6c9f} \x{6da7} \x{6b63} \x{8f7d} \x{6781} \x{6052}\x{6cb3}\x{6c99} \x{963f}\x{50e7}\x{7957} \x{90a3}\x{7531}\x{4ed6} \x{4e0d}\x{53ef}\x{601d}\x{8bae} \x{65e0}\x{91cf}\x{5927}\x{6570}") ],
        ord => [ '', split(' ', "\x{5341} \x{767e} \x{5343}") ],
        dig => [ split(' ', "\x{96f6} \x{4e00} \x{4e8c} \x{4e09} \x{56db} \x{4e94} \x{516d} \x{4e03} \x{516b} \x{4e5d} \x{5341}") ],
        dot => "\x{70b9}",
        neg => "\x{8d1f}",
    },
) : (),
    'big5'          => {
        mag => [ '', split(' ', "\xB8U \xBB\xF5 \xA5\xFC \xA8\xCA \xAB\xB2 \xD2\xF1 \xF6\xF8 \xB7\xBE \xBC\xEE \xA5\xBF \xB8\xFC \xB7\xA5 \xAB\xED\xAAe\xA8F \xAA\xFC\xB9\xAC\xAC\xE9 \xA8\xBA\xA5\xD1\xA5L \xA4\xA3\xA5i\xAB\xE4\xC4\xB3 \xB5L\xB6q\xA4j\xBC\xC6") ],
        ord => [ '', split(' ', "\xA4Q \xA6\xCA \xA4d") ],
        dig => [ split(' ', "\xB9s \xA4\@ \xA4G \xA4T \xA5| \xA4\xAD \xA4\xBB \xA4C \xA4K \xA4E \xA4Q") ],
        dot => "\xC2I",
        neg => "\xADt",
    },
    'gb'            => {
        mag => [ '', split(' ', "\xCD\xF2 \xD2\xDA \xD5\xD7 \xBE\xA9 \xDB\xF2 \xEF\xF6 \xF0\xA6 \xB9\xB5 \xBD\xA7 \xD5\xFD \xD4\xD8 \xBC\xAB \xBA\xE3\xBA\xD3\xC9\xB3 \xB0\xA2\xC9\xAE\xEC\xF3 \xC4\xC7\xD3\xC9\xCB\xFB \xB2\xBB\xBF\xC9\xCB\xBC\xD2\xE9 \xCE\xDE\xC1\xBF\xB4\xF3\xCA\xFD") ],
        ord => [ '', split(' ', "\xCA\xAE \xB0\xD9 \xC7\xA7") ],
        dig => [ split(' ', "\xC1\xE3 \xD2\xBB \xB6\xFE \xC8\xFD \xCB\xC4 \xCE\xE5 \xC1\xF9 \xC6\xDF \xB0\xCB \xBE\xC5 \xCA\xAE") ],
        dot => "\xB5\xE3",
        neg => "\xB8\xBA",
    },
    'pinyin'        => {
        mag => [ '', map {$_ } qw(
            Wan Yi Zhao Jing Gai Zi Rang Gou Jian Zheng Zai Ji
            HengHeSha AZengZhi NaYouTa BuKeSiYi WuLiangDaShu
        ) ],
        ord => [ '', map {$_ } qw(Shi Bai Qian) ],
        dig => [ qw(Ling Yi Er San Si Wu Liu Qi Ba Jiu Shi) ],
        dot => ' Dian ',
        neg => 'Fu ',
    },
);
# }}}

# {{{ import

sub import {
    my ($class, $charset) = @_;
    $class->charset($charset);
    return $class->export_to_level(1, $class);
}

# }}}
# {{{ charset

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

    no strict 'refs'; ## no critic
    return ${"$class\::Charset"} unless defined $charset;

    $charset = 'gb' if $charset =~ /^gb/i or $charset =~ /^euc-cn$/i;
    $charset = 'big5' if $charset =~ /big5/i;
    return ${"$class\::Charset"} = lc($charset) if exists ${"$class\::MAP"}{lc($charset)};
}

# }}}
# {{{ map_zho

sub map_zho {
    return \%MAP;
}

# }}}
# {{{ new

sub new {
    my ($class, $num) = @_;
    bless (\$num, $class);
}

# }}}
# {{{ parse

sub parse {
    my ($self, $num) = @_;
    ${$self} = $num;
}

# }}}
# {{{ get_string

sub get_string {
    my ($self) = @_;
    return number_to_zh($$self);
}

# }}}
# {{{ number_to_zh

sub number_to_zh {
    my @a = @_;
    return __PACKAGE__->_convert($MAP{$Charset}, @a);
}

# }}}
# {{{ convert

sub _convert {
    my ($class, $map, $input) = @_;

    croak 'You should specify a number from interval [0, trillion)'
        if    !defined $input
           || $input !~ m{\A[\-\.\d]+\z}xms
           || $input >= 10 ** 15;


    $input =~ s/[^\d\.\-]//;

    my @dig = @{$map->{dig}};
    my @ord = @{$map->{ord}};
    my @mag = @{$map->{mag}};
    my $dot = $map->{dot};
    my $neg = $map->{neg};

    my $out = '';
    my $delta;
    if ($input =~ s/\.(.*)//) {
        $delta = $1;
    }

    $out = $neg if $input =~ s/^\-//;
    $input =~ s/^0+//;
    $input ||= '0';

    my @chunks;
    unshift @chunks, $1 while ($input =~ s/(\d{1,4})$//g);
    my $mag = $#chunks;
    my $zero = ($] >= 5.005) ? eval 'qr/$dig[0]$/' : quotemeta($dig[0]) . '$'; ## no critic

    foreach my $num (@chunks) {
        my $tmp = '';

        for (reverse 0..3) {
            my $n = int($num / (10 ** $_)) % 10;
            next unless $tmp or $n;
            $tmp .= $dig[$n] unless ($n == 0 and $tmp =~ $zero)
                                 or ($_ == 1 and $n == 1 and not $tmp);
            $tmp .= $ord[$_] if $n;
        }

        $tmp =~ s/$zero// unless $tmp eq $dig[0];
        $tmp .= $mag[$mag] if $tmp;
        $tmp = $dig[0].$tmp if $num < 1000 and $mag != $#chunks
                                           and $out !~ $zero;
        $out .= $tmp;
        $mag--;
    }

    $out =~ s/$zero// unless $out eq $dig[0];

    if ($delta) {
        $delta =~ s/^0\.//;
        $out .= $dot;
        $out .= $dig[$_] for split(//, $delta);
    }

    return $out || $dig[0];
}

# }}}

1;
__END__