File Coverage

blib/lib/Lingua/Num2Word.pm

Criterion	Covered	Total	%
statement	50	112	44.6
branch	5	54	9.2
condition	5	28	17.8
subroutine	17	21	80.9
pod	8	8	100.0
total	85	223	38.1

# For Emacs: -*- mode:cperl; eval: (folding-mode 1) -*-
#
# Copyright (c) PetaMem, s.r.o. 2002-present
#
package Lingua::Num2Word;
# ABSTRACT: Multi-language number to word conversion wrapper

use 5.16.0;
use utf8;
use warnings;

# {{{ use block

use Carp;
use Encode;
use Export::Attrs;

# }}}
# {{{ var block
our $VERSION = '0.2603300';
our %known;

# }}}

# {{{ templates for functional and object interface

my $template_func = q{ use __PACKAGE_WITH_VERSION__ ();
                       $result = __PACKAGE__::__FUNCTION__($number);
                     };

my $template_obj  = q{ use __PACKAGE_WITH_VERSION__ ();
                       my $tmp_obj = new __PACKAGE__;
                       $result = $tmp_obj->__FUNCTION__($number);
                     };

# ISO 639-1 to 639-3 mapping for supported languages
# {{{ ISO 639-1 to 639-3 mapping
my %iso1_to_3 = (
    af => 'afr', ar => 'ara', az => 'aze', bg => 'bul', ca => 'cat',
    cs => 'ces', da => 'dan', de => 'deu', el => 'ell',
    en => 'eng', es => 'spa', et => 'est', eu => 'eus',
    fa => 'fas', fi => 'fin', fr => 'fra', he => 'heb',
    hi => 'hin', hr => 'hrv', hu => 'hun', hy => 'hye',
    id => 'ind', is => 'isl', it => 'ita', ja => 'jpn',
    kk => 'kaz', ko => 'kor', ky => 'kir', la => 'lat',
    lt => 'lit', lv => 'lav', mn => 'mon', nl => 'nld',
    'no' => 'nor',
    pl => 'pol', pt => 'por', ro => 'ron', ru => 'rus',
    sk => 'slk', sv => 'swe', sw => 'swa', th => 'tha',
    be => 'bel', cy => 'cym', ga => 'gle', gl => 'glg',
    lb => 'ltz', mk => 'mkd', mt => 'mlt', oc => 'oci',
    sc => 'srd',
    sl => 'slv', so => 'som', sq => 'sqi', sr => 'srp',
    tr => 'tur', ug => 'uig', uk => 'ukr', vi => 'vie',
    yi => 'yid', zh => 'zho',
);
# }}}

# {{{ %known — auto-discovered from lib/Lingua/*/Num2Word.pm

# Override table for legacy modules with non-standard API
# Override table: only for modules with non-default limits or legacy function names.
# All modules now live in Num2Word.pm with num2XXX_cardinal as canonical function.
my %n2w_override = (
    afr => { limit_hi => 99_999_999_999 },
    eng => { limit_lo => 1, limit_hi => 999_999_999_999_999 },
    eus => { limit_hi => 999_999_999_999 },
    fra => { limit_hi => 999_999_999_999_999 },
    ind => { limit_hi => 999_999_999_999_999 },
    ita => { limit_hi => 999_999_999_999 },
    jpn => { limit_lo => 1, limit_hi => 999_999_999_999_999,
             code => q{ use __PACKAGE_WITH_VERSION__ ();
                        my @words = __PACKAGE__::to_string($number);
                        $result = join ' ', @words;
                      },
           },
    nor => { function => 'num2no_cardinal', code => $template_obj },
    pol => { limit_hi => 9_999_999_999_999 },
    por => { limit_hi => 999_999_999_999_999 },
    rus => { limit_hi => 999_999_999_999_999 },
    spa => { limit_hi => 999_999_999_999_999 },
    swe => { function => 'num2sv_cardinal' },
    zho => { limit_lo => 1, limit_hi => 999_999_999_999_999,
             code => q{ use Lingua::ZHO::Num2Word qw(traditional);
                        $result = Lingua::ZHO::Num2Word::number_to_zh($number);
                      },
           },
);

# auto-discover: scan for Lingua::*::Num2Word modules
{
    my $lingua_dir;
    for my $inc (@INC) {
        my $try = "$inc/Lingua";
        if (-d $try) { $lingua_dir = $try; last; }
    }

    if ($lingua_dir) {
        for my $dir (glob "$lingua_dir/*/") {
            my ($lang) = $dir =~ m{/([A-Z]{3})/\z};
            next unless $lang;
            $lang = lc $lang;

            # standard pattern: Num2Word.pm with num2XXX_cardinal function
            if (-e "$dir/Num2Word.pm" || exists $n2w_override{$lang}) {
                my $ov = $n2w_override{$lang} // {};
                $known{$lang} = {
                    package  => $ov->{package}  // 'Num2Word',
                    version  => $ov->{version}  // '',
                    limit_lo => $ov->{limit_lo} // 0,
                    limit_hi => $ov->{limit_hi} // 999_999_999,
                    function => $ov->{function} // "num2${lang}_cardinal",
                    code     => $ov->{code}     // $template_func,
                };
            }
        }
    }
}

# }}}
# {{{ default capabilities

my %default_capabilities = (
    cardinal => 1,
    ordinal  => 0,
    negative => 0,
    decimal  => 0,
    currency => 0,
);

# }}}
# {{{ capabilities              query what a language module can do

sub capabilities :Export {
    my $self = ref($_[0]) ? shift : undef;
    my $lang = shift // return;

    $lang = lc $lang;
    $lang = $iso1_to_3{$lang} if exists $iso1_to_3{$lang};

    return if !exists $known{$lang};

    # try to load the module's capabilities() if it has one
    my $pkg = 'Lingua::' . uc($lang) . '::' . $known{$lang}{package};
    my $caps;
    eval {
        (my $file = $pkg) =~ s{::}{/}g;
        require "$file.pm";
        if ($pkg->can('capabilities')) {
            $caps = $pkg->capabilities();
        }
    };

    # merge with defaults — module caps override defaults
    my %result = %default_capabilities;
    if ($caps && ref $caps eq 'HASH') {
        $result{$_} = $caps->{$_} for keys %{$caps};
    }

    # add range from %known
    $result{range} = [$known{$lang}{limit_lo} // 0, $known{$lang}{limit_hi} // 999_999_999];

    return \%result;
}

# }}}
# {{{ has_capability            check if a language supports a feature

sub has_capability :Export {
    my $self = ref($_[0]) ? shift : undef;
    my $lang    = shift // return 0;
    my $feature = shift // return 0;

    my $caps = capabilities($lang);
    return 0 unless $caps;
    return $caps->{$feature} ? 1 : 0;
}

# }}}
# {{{ ordinal                   convert number to ordinal text

sub ordinal :Export {
    my $self   = ref($_[0]) ? shift : Lingua::Num2Word->new();
    my $result = '';
    my $lang   = shift // return $result;
    my $number = shift // return $result;

    $lang = lc $lang;
    $lang = $iso1_to_3{$lang} if exists $iso1_to_3{$lang};

    return $result if !exists $known{$lang};
    return $result if !has_capability($lang, 'ordinal');

    my $pkg = 'Lingua::' . uc($lang) . '::' . $known{$lang}{package};
    # derive ordinal function name from cardinal (handles legacy names like num2sv_)
    my $cardinal_func = $known{$lang}{function} // "num2${lang}_cardinal";
    my $func;
    if ($cardinal_func =~ /_cardinal$/) {
        ($func = $cardinal_func) =~ s/_cardinal$/_ordinal/;
    }
    else {
        $func = "num2${lang}_ordinal";  # fallback for OO/legacy modules
    }

    eval "use $pkg (); \$result = ${pkg}::${func}(\$number);"; ## no critic
    carp $@ if $@;

    return $result;
}

# }}}
# {{{ new                       constructor

sub new {
    return bless {}, shift;
}

# }}}
# {{{ known_langs               list of currently supported languages

sub known_langs :Export {
    return wantarray ? sort keys %known : [ sort keys %known ];
}

# }}}
# {{{ get_interval              get minimal and maximal supported number

# Return:
#  undef for unsupported language
#  list or list reference (depending to calling context) with
#  minimal and maximal supported number
#
sub get_interval :Export {
    my $self = ref($_[0]) ? shift : Lingua::Num2Word->new();
    my $lang = shift // return;
    $lang = lc $lang;
    $lang = $iso1_to_3{$lang} if exists $iso1_to_3{$lang};

    return if (!defined $known{$lang});

    my @limits = ($known{$lang}{limit_lo}, $known{$lang}{limit_hi});

    return wantarray ? @limits : \@limits;
}

# }}}
# {{{ cardinal                  convert number to text

sub cardinal :Export {
    my $self   = ref($_[0]) ? shift : Lingua::Num2Word->new();
    my $result = '';
    my $lang   = shift // return $result;
    my $number = shift // return $result;

    $lang = lc $lang;
    $lang = $iso1_to_3{$lang} if exists $iso1_to_3{$lang};

    return $result if (!defined $known{$lang});

    if (defined $known{$lang}{lang}) {
        eval $self->preprocess_code($known{$lang}{lang}); ## no critic
        carp $@ if ($@);
    }
    else {
        eval $self->preprocess_code($lang); ## no critic
        carp $@ if ($@);
    }

    return $result;
}

# }}}
# {{{ preprocess_code           prepare code for evaluation

sub preprocess_code :Export {
    my $self                  = shift;
    my $lang                  = shift // return;

    return if !exists $known{$lang};

    my $result                = $known{$lang}{code};
    my $pkg_name              = 'Lingua::' . uc($lang) . '::' . $known{$lang}{package};
    my $pkg_name_with_version = $known{$lang}{version} ne ''
                              ? "$pkg_name $known{$lang}{version}"
                              : $pkg_name
                              ;

    my $function              = $known{$lang}{function};

    $result =~ s/__PACKAGE_WITH_VERSION__/$pkg_name_with_version/g;
    $result =~ s/__PACKAGE__/$pkg_name/g;
    $result =~ s/__FUNCTION__/$function/g;

    return $result;
}
# }}}

1;
__END__