File Coverage

blib/lib/Lingua/EN/Numbers/Years.pm

Criterion	Covered	Total	%
statement	38	39	97.4
branch	40	44	90.9
condition	6	6	100.0
subroutine	6	6	100.0
pod	0	1	0.0
total	90	96	93.7

package Lingua::EN::Numbers::Years;
$Lingua::EN::Numbers::Years::VERSION = '1.03';
use 5.006;
use strict;
use warnings;

use Lingua::EN::Numbers 1.01 qw(num2en);

require Exporter;
our @ISA = qw(Exporter);

my $T    = 'thousand';
my $H    = 'hundred';
my $Oh   = 'oh';
my $Zero = 'zero';
my %DD;
my %OhDD;
my %D;

our @EXPORT    = qw(year2en);

BEGIN { *DEBUG = sub () {0} unless defined &DEBUG } # setup a DEBUG constant

#--------------------------------------------------------------------------

@DD{ '00' .. '09' } = @DD{ '0' .. '9' } = @D{ '0' .. '9' }
 = @OhDD{ '0' .. '9' }
 = qw(oh one two three four five six seven eight nine);

@OhDD{ '00' .. '09' } = map "$Oh $_", @D{  '0' ..  '9' };
 # Altho "oh oh" presumably is never used

for my $num ('10' .. '99') {
  $OhDD{$num} = $DD{$num} = num2en($num);
  DEBUG > 1 and print "$num = $DD{$num}\n";
}

#--------------------------------------------------------------------------

sub year2en ($) {
  my $y = $_[0];
  return undef unless defined $y and length $y;
  $y =~ s/,//g;
  if( $y =~ m/\d/  and  $y =~ m/^(-?)(\d{1,5})$/s  ) {
    my $neg =  $1 ? "negative " : '';
    local $_ = $2;
    return $Zero if $_ eq '0';
    return "$neg$DD{$_}" if $DD{$_};

    m/^(..)000$/     and return "$neg$DD{$1} $T";

    if( m/^.0...$/ ) {
      # A family of troublesome cases: things like "60123".
      # We can't say "sixty one twenty-three" because that sounds
      #  just like sixty-one twenty-three.  So we special-case this
      #  whole group.
      m/^(.0)000$/     and return "$neg$DD{$1} $T";
      m/^(.0)00(.)$/   and return "$neg$DD{$1} $T $D{$2}";
      m/^(.0)0(..)$/   and return "$neg$DD{$1} $T $DD{$2}";
      m/^(.0)(.)00$/   and return "$neg$DD{$1} $T $D{$2} $H";
      m/^(.0)(.)(..)$/ and return "$neg$DD{$1} $T $D{$2} $OhDD{$3}";
      DEBUG and print "Falling thru with x0,xxx number $_ !\n";
    }

    m/^(.)000$/      and return "$neg$DD{$1} $T";
    m/^(..)00$/      and return "$neg$DD{$1} $H";
    m/^(.)00$/       and return "$neg$DD{$1} $H";

    m/^(..)00(.)$/   and return "$neg$DD{$1} $Oh $Oh $DD{$2}";
    m/^(..)0(..)$/   and return "$neg$DD{$1} $Oh $DD{$2}";

    m/^(.)00(.)$/    and return "$neg$DD{$1} $T $DD{$2}";
    #m/^(..)00(.)$/  and return "$neg$DD{$1} $T $DD{$2}";

    m/^(..)(.)(..)$/ and return "$neg$OhDD{$1} $D{$2} $OhDD{$3}";
    m/^(..)(..)$/    and return "$neg$OhDD{$1} $OhDD{$2}";
    m/^(.)(..)$/     and return "$neg$OhDD{$1} $OhDD{$2}";

    # Else fallthru:
  }

  if(DEBUG) {
    my $x = num2en($y);
    print "Using superclass to return numerification \"$x\".\n";
    return $x;
  } else {
    return num2en($y);
  }
}
#--------------------------------------------------------------------------

1;

__END__