File Coverage

blib/lib/Lingua/LTZ/Num2Word.pm

Criterion	Covered	Total	%
statement	67	78	85.9
branch	44	60	73.3
condition	18	36	50.0
subroutine	10	12	83.3
pod	3	3	100.0
total	142	189	75.1

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

package Lingua::LTZ::Num2Word;
# ABSTRACT: Number to word conversion in Luxembourgish

use 5.16.0;
use utf8;
use warnings;

# {{{ use block

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

# }}}
# {{{ variable declarations

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

# }}}

# {{{ num2ltz_cardinal                 convert number to text

sub num2ltz_cardinal :Export {
    my $positive = shift;

    croak 'You should specify a number from interval [0, 999_999_999]'
        if    !defined $positive
           || $positive !~ m{\A\d+\z}xms
           || $positive < 0
           || $positive > 999_999_999;

    # 0..12 are irregular standalone forms
    my @tokens1 = qw(null een zwee dräi véier fënnef sechs siwen aacht néng zéng eelef zwielef);

    # tens 20..90 (index 0=20, 1=30, ...)
    my @tokens2 = qw(zwanzeg drësseg véierzeg fofzeg sechzeg siwwenzeg achtzeg nonzeg);

    # standalone 0
    return 'null'           if $positive == 0;

    # standalone 1 has trailing 't'
    return 'eent'           if $positive == 1;

    return $tokens1[$positive]              if ($positive >= 2 && $positive < 13);   # 2 .. 12
    return 'fofzéng'                        if ($positive == 15);                    # 15 exception
    return 'siechzéng'                      if ($positive == 16);                    # 16 exception
    return 'siwwenzéng'                     if ($positive == 17);                    # 17 exception
    return 'uechtzéng'                      if ($positive == 18);                    # 18 exception
    return 'nonzéng'                        if ($positive == 19);                    # 19 exception
    return $tokens1[$positive-10] . 'zéng'  if ($positive > 12 && $positive < 20);  # 13, 14

    my $out;          # string for return value construction
    my $one_idx;      # index for array
    my $remain;       # remainder

    if ($positive > 19 && $positive < 100) {              # 20 .. 99
        $one_idx = int ($positive / 10);
        $remain  = $positive % 10;

        if ($remain) {
            my $unit = $tokens1[$remain];
            my $tens = $tokens2[$one_idx - 2];
            my $connector = _connector($tens);
            $out = $unit . $connector . $tens;
        }
        else {
            $out = $tokens2[$one_idx - 2];
        }
    }
    elsif ($positive >= 100 && $positive < 1000) {      # 100 .. 999
        $one_idx = int ($positive / 100);
        $remain  = $positive % 100;

        $out  = ($one_idx == 1 ? '' : $tokens1[$one_idx]) . 'honnert';
        $out .= $remain ? num2ltz_cardinal($remain) : '';
    }
    elsif ($positive > 999 && $positive < 1_000_000) {  # 1000 .. 999_999
        $one_idx = int ($positive / 1000);
        $remain  = $positive % 1000;

        $out  = ($one_idx == 1 ? '' : num2ltz_cardinal($one_idx)) . 'dausend';
        $out .= $remain ? num2ltz_cardinal($remain) : '';
    }
    elsif (   $positive > 999_999
           && $positive < 1_000_000_000) {                 # 1_000_000 .. 999_999_999
        $one_idx = int ($positive / 1000000);
        $remain  = $positive % 1000000;

        # "eng Millioun" for 1M, "zwee Milliounen" for 2M+
        if ($one_idx == 1) {
            $out = 'eng Millioun';
        }
        else {
            $out = num2ltz_cardinal($one_idx) . ' Milliounen';
        }
        $out .= $remain ? ' ' . num2ltz_cardinal($remain) : '';
    }

    return $out;
}

# }}}
# {{{ _connector                       apply n-rule (Eifel rule) for 'an'

sub _connector {
    my $tens = shift;

    # The Eifel rule (n-Regel): final 'n' is dropped before a consonant,
    # EXCEPT before n, d, t, z, h.
    # Applied to the connector 'an' before the tens word.
    my $first_char = substr($tens, 0, 1);

    # Before a vowel: keep 'n'
    return 'an' if $first_char =~ m/[aeiouäëéAEIOU]/;

    # Before consonants n, d, t, z, h: keep 'n'
    return 'an' if $first_char =~ m/[ndtzh]/;

    # Before all other consonants: drop 'n'
    return 'a';
}

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

sub num2ltz_ordinal :Export {
    my $number = shift;

    croak 'You should specify a number from interval [1, 999_999_999]'
        if    !defined $number
           || $number !~ m{\A\d+\z}xms
           || $number < 1
           || $number > 999_999_999;

    # Fully irregular forms
    return 'éischt'  if $number == 1;
    return 'zweet'   if $number == 2;
    return 'drëtt'   if $number == 3;

    # Stem irregulars
    return 'siiwent' if $number == 7;
    return 'aacht'   if $number == 8;

    my $cardinal = num2ltz_cardinal($number);

    # Numbers 4-19 get suffix "t", 20+ get "st"
    my $suffix = $number < 20 ? 't' : 'st';

    return $cardinal . $suffix;
}

# }}}

# {{{ capabilities              declare supported features

sub capabilities {
    return {
        cardinal => 1,
        ordinal  => 1,
    };
}

# }}}
1;

__END__