File Coverage

blib/lib/Lingua/Word2Num.pm

Criterion	Covered	Total	%
statement	30	50	60.0
branch	2	16	12.5
condition	3	9	33.3
subroutine	11	12	91.6
pod	4	4	100.0
total	50	91	54.9

# For Emacs: -*- mode:cperl; eval: (folding-mode 1) -*-

package Lingua::Word2Num;
# ABSTRACT: A wrapper for Lingua:XXX::word2num modules Lingua::Word2Num is a module for converting texts in their spoken language representation into numbers.

use 5.16.0;
use utf8;
use warnings;

# {{{ use block

use Carp;
use Export::Attrs;
use Readonly;

# }}}
# {{{ var block

my  Readonly::Scalar $COPY    = 'Copyright (c) PetaMem, s.r.o. 2004-present';
our $VERSION = '0.2603250';

# templates for functional and object interface

my $template_func = 'use __PACKAGE_WITH_VERSION__ ();'."\n".
                    '$result = __PACKAGE__::__FUNCTION__($word);'."\n";

my $template_obj  = 'use __PACKAGE_WITH_VERSION__ ();'."\n".
                    'my $tmp_obj = new __PACKAGE__;'."\n".
                    '$result = $tmp_obj->__FUNCTION__("$word");'."\n";

# {{{ ISO 639-1 to 639-3 mapping
my %iso1_to_3 = (
    af => 'afr', ar => 'ara', bg => 'bul', ca => 'cat',
    cs => 'ces', da => 'dan', de => 'deu', el => 'ell',
    en => 'eng', es => 'spa', eu => 'eus', fi => 'fin',
    fr => 'fra', hi => 'hin', hr => 'hrv', hu => 'hun',
    id => 'ind', it => 'ita', ja => 'jpn', ko => 'kor',
    lt => 'lit', nl => 'nld', 'no' => 'nor', pl => 'pol',
    pt => 'por', ro => 'ron', ru => 'rus', sk => 'slk',
    sv => 'swe', sw => 'swa', th => 'tha', tr => 'tur',
    uk => 'ukr', vi => 'vie', zh => 'zho',
);
# }}}

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

# Override table for legacy modules with non-standard API
my %w2n_override = (
    ind => { package => 'Words2Nums', function => 'words2nums' },
    por => { package => 'Words2Nums', function => 'word2num'   },
);

our %known;

# auto-discover: scan for Lingua::*::Word2Num 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;

            if (-e "$dir/Word2Num.pm" || exists $w2n_override{$lang}) {
                my $ov = $w2n_override{$lang} // {};
                $known{$lang} = {
                    package  => $ov->{package}  // 'Word2Num',
                    version  => $ov->{version}  // '',
                    function => $ov->{function} // 'w2n',
                    code     => $ov->{code}     // $template_func,
                };
            }
        }
    }
}

# }}}

# {{{ new                       constructor

sub new {
    return bless {}, shift;
}

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

sub cardinal :Export {
    my $self   = ref($_[0]) ? shift : __PACKAGE__->new();
    my $result = '';

    my $lang   = shift // return $result;
    my $word   = shift // return $result;

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

    my @langs = ($lang eq '*')
              ? sort keys %known
              : ($lang)
              ;

    return $result if (!defined $known{$langs[0]});

    for my $lang (@langs) {
        eval $self->preprocess_code($lang);                 ## no critic 'eval'
        carp $@ if $@;

        return $result if (defined $result && $result ne '');
    }

    return '';
}

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

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

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

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

    return if !defined $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;
    $result =~ s/__CHARSET__/$known{$lang}{charset}/g;

    return $result;
}

# }}}

1;
__END__