Lingua::TR::Numbers - Converts numbers into Turkish text.

   use Lingua::TR::Numbers qw(num2tr num2tr_ordinal);

   my $x = 234;
   my $y = 54;
   print "Bugün yapman gereken ", num2tr($x), " tane işin var!\n";
   print "Yarın annemin ", num2tr_ordinal($y), " yaşgününü kutlayacağız.\n";

   Bugün yapman gereken iki yüz otuz dört tane işin var!
   Yarın annemin elli dördüncü yaşgününü kutlayacağız.

   use Lingua::TR::Numbers qw(num2tr num2tr_ordinal);

   use Lingua::TR::Numbers qw(:all);

#BEGIN { if($] < 5.006) { package utf8; $INC{'utf8.pm'} = 1; } }
package Lingua::TR::Numbers;
use 5.006;
use utf8;
use strict;
use vars qw(@ISA $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
#use constant IS_LEGACY => $] < 5.006;
use Exporter ();

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

$VERSION = '0.23';

@ISA         = qw( Exporter              );
@EXPORT_OK   = qw( num2tr num2tr_ordinal );
%EXPORT_TAGS =   ( all => \@EXPORT_OK    );

my($RE_VOWEL, %D, %Mult, %Card2ord, %Card2ordTR);

POPULATE: {
  @D{ 0,1 ,2 ,3 ,4 ,5 ,6 ,7 ,8 ,9  } = qw| sıfır bir iki   üç   dört beş  altı   yedi   sekiz  dokuz  |;
  @D{   10,20,30,40,50,60,70,80,90 } = qw|       on  yirmi otuz kırk elli altmış yetmiş seksen doksan |;

  @Card2ord{  qw| bir     iki    üç     dört     beş     altı    yedi    sekiz     dokuz     |}
            = qw| birinci ikinci üçüncü dördüncü beşinci altıncı yedinci sekizinci dokuzuncu |;

  @Card2ordTR{ qw|a   e   ı   i   u   ü   o   ö   |}
            =  qw|ncı nci ncı nci ncu ncü ncu ncü |;

  $RE_VOWEL = join '', keys %Card2ordTR;
  $RE_VOWEL = qr{([$RE_VOWEL])}o;

  my @large = qw|
                   bin       milyon    milyar    trilyon  katrilyon
                   kentilyon seksilyon septilyon oktilyon nobilyon
                   desilyon
                |;
  my $c = 0;
  $Mult{$c++} = $_ for '', @large;
}

#==========================================================================

sub num2tr_ordinal {
   #  Cardinals are [bir     iki    üç     ...]
   #  Ordinals  are [birinci ikinci üçüncü ...]
  
  return undef unless defined $_[0] and length $_[0];
  my($x) = $_[0];
  
  $x = num2tr($x);
  return $x unless $x;
  $x =~ s/(\w+)$//s   or return $x . ".";
  my $last = $1;
  my @l = split //, $last;
  my $ok;
  my $step = 1;;
  for my $l (reverse @l) {
     next if not $l;
     if($l =~ $RE_VOWEL) {
        $ok = $1;
        last;
     }
     $step++;
  }
  if(!$ok) {
     #return $last if IS_LEGACY;
     #die "Can not happen: '$last'";
     return undef;
  }

  $last = $Card2ord{$last} || sub {
     my $val = $Card2ordTR{$ok};
     return $last . $val if $step == 1;
     my $letter = (split //, $val)[-1];
     return $last.$letter.$val;
  }->();

  return "$x$last";
}

#==========================================================================

sub num2tr {
  my $x = $_[0];
  return undef unless defined $x and length $x;

  return 'sayı-değil'     if $x eq 'NaN';
  return 'eksi sonsuz' if $x =~ m/^\+inf(?:inity)?$/si;
  return 'artı sonsuz' if $x =~ m/^\-inf(?:inity)?$/si;
  return      'sonsuz' if $x =~  m/^inf(?:inity)?$/si;

  return $D{$x} if exists $D{$x};  # the most common cases

  # Make sure it's not in scientific notation:
  {  my $e = _e2tr($x);  return $e if defined $e; }
  
  my $orig = $x;

  $x =~ s/,//g; # nix any commas

  my $sign;
  $sign = $1 if $x =~ s/^([-+])//s;
  
  my($int, $fract);
  if(    $x =~ m<^\d+$>          ) { $int = $x }
  elsif( $x =~ m<^(\d+)\.(\d+)$> ) { $int = $1; $fract = $2 }
  elsif( $x =~ m<^\.(\d+)$>      ) { $fract = $1 }
  else {
    DEBUG and print "Not a number: \"orig\"\n";
    return undef;
  }
  
  DEBUG and printf " Working on Sign[%s]  Int2tr[%s]  Fract[%s]  < \"%s\"\n",
   map defined($_) ? $_ : "nil", $sign, $int, $fract, $orig;
  
  return join ' ', grep defined($_) && length($_),
    _sign2tr($sign),
    _int2tr($int),
    _fract2tr($fract),
  ;
}

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

sub _sign2tr {
  return undef unless defined $_[0] and length $_[0];  
  return 'eksi' if $_[0] eq '-';
  return 'artı' if $_[0] eq '+';
  return "WHAT_IS_$_[0]";
}

sub _fract2tr {    # "1234" => "point one two three four"
  return undef unless defined $_[0] and length $_[0];  
  my $x = $_[0];
  return join ' ', 'nokta', map $D{$_}, split '', $x;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The real work:

sub _int2tr {
  return undef unless defined $_[0] and length $_[0]
   and $_[0] =~ m/^\d+$/s;

  my($x) = $_[0];

  return $D{$x} if defined $D{$x};  # most common/irreg cases
  
  if( $x =~ m/^(.)(.)$/ ) {
    return  $D{$1 . '0'} . ' ' . $D{$2};
     # like    forty        -     two
      # note that neither bit can be zero at this point
     
  } elsif( $x =~ m/^(.)(..)$/ ) {
    my $tmp = $1 == 1 ? '' : $D{$1}.' ';
    my($h, $rest) = ($tmp.'yüz', $2);
    return $h if $rest eq '00';
    return "$h " . _int2tr(0 + $rest);
  } else {
    return _bigint2tr($x);
  }
}

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

sub _bigint2tr {
  return undef unless defined $_[0] and length $_[0]
   and $_[0] =~ m/^\d+$/s;

  my($x) = $_[0];

  my @chunks;  # each:  [ string, exponent ]
  
  {
    my $groupnum = 0;
    my $num;
    while( $x =~ s<(\d{1,3})$><>s ) { # pull at most three digits from the end
      $num = $1 + 0;
      unshift @chunks, [ $num, $groupnum ] if $num;
      ++$groupnum;
    }
    return $D{'0'} unless @chunks;  # rare but possible
  }
  
  my $and;
  # junk
  $and = '' if  $chunks[-1][1] == 0  and  $chunks[-1][0] < 100;
   # The special 'and' that shows up in like "one thousand and eight"
   # and "two billion and fifteen", but not "one thousand [*and] five hundred"
   # or "one million, [*and] nine"

  _chunks2tr( \@chunks );

  $chunks[-2] .= " " if $and and @chunks > 1;
  return "$chunks[0] $chunks[1]" if @chunks == 2;
   # Avoid having a comma if just two units
  return join ", ", @chunks;
}


sub _chunks2tr {
  my $chunks = $_[0];
  return unless @$chunks;
  my @out;
  foreach my $c (@$chunks) {
    push @out,   $c = _groupify( _int2tr( $c->[0] ),  $c->[1] ,$c->[0])  if $c->[0];
  }
  @$chunks = @out;
  return;
}

sub _groupify {
  # turn ("seventeen", 3) => "seventeen billion"
  my($basic, $multnum, $raw) = @_;
  return  $basic unless $multnum;  # the first group is unitless
  DEBUG > 2 and print "  Groupifying $basic x $multnum mults\n";
  return "$basic $Mult{$multnum}"  if  $Mult{$multnum};
   # Otherwise it must be huuuuuge, so fake it with scientific notation
  return "$basic " . "çarpı on üzeri " . num2tr($raw * 3);
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
# Because I can never remember this:
#
#  3.1E8
#  ^^^   is called the "mantissa"
#      ^ is called the "exponent"
#         (the implicit "10" is the "base" a/k/a "radix")

sub _e2tr {
  my $x = $_[0];

  my($m, $e);
  if( $x =~
    m<
            ^(
                [-+]?  # leading sign
                (?:
                    [\d,]+  |  [\d,]*\.\d+  # number
                )
              )
            [eE]
            (-?\d+)   # mantissa, has to be an integer
            $
        >x
  ) {
    ($m, $e) = ($1, $2);
    DEBUG and print "  Scientific notation: [$x] => $m E $e\n";
    $e += 0;
    return num2tr($m) . ' çarpı on üzeri ' . num2tr($e);
  } else {
    DEBUG and print "  Okay, $x isn't in exponential notation\n";
    return undef;
  }
}

#==========================================================================

1;

__END__

#1 milyon    1.000.000
#1 milyar    1.000.000.000
#1 trilyon   1.000.000.000.000
#1 katrilyon 1.000.000.000.000.000
#1 kentilyon 1.000.000.000.000.000.000
#1 seksilyon 1.000.000.000.000.000.000.000
#1 septilyon 1.000.000.000.000.000.000.000.000
#1 oktilyon  1.000.000.000.000.000.000.000.000.000
#1 nobilyon  1.000.000.000.000.000.000.000.000.000.000
#1 desilyon  1.000.000.000.000.000.000.000.000.000.000.000