File Coverage

blib/lib/Number/Spell.pm

Criterion	Covered	Total	%
statement	42	76	55.2
branch	15	38	39.4
condition	1	3	33.3
subroutine	3	3	100.0
pod	0	1	0.0
total	61	121	50.4

package Number::Spell;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	spell_number
);
$VERSION = '0.04';


# Preloaded methods go here.


my %expo=(
        0       =>      '',
        1       =>      'thousand',
        2       =>      'million',
        3       =>      'billion',
        4       =>      'trillion',
        5       =>      'quadrillion',
        6       =>      'quintillion',
        7       =>      'sextillion',
        8       =>      'septillion',
        9       =>      'octillion',
        10      =>      'nonillion',
        11      =>      'decillion',
        12      =>      'undecillion',
        13      =>      'duodecillion',
        14      =>      'tredecillion',
        15      =>      'quattuordecillion',
        16      =>      'quindecillion',
        17      =>      'sexdecillion',
        18      =>      'septendecillion',
        19      =>      'octodecillion',
        20      =>      'novemdecillion',
        21      =>      'vigintillion',
);


my %digit=(
         0      =>      '',
         1      =>      'one',
         2      =>      'two',
         3      =>      'three',
         4      =>      'four',
         5      =>      'five',
         6      =>      'six',
         7      =>      'seven',
         8      =>      'eight',
         9      =>      'nine',
        10      =>      'ten',
        11      =>      'eleven',
        12      =>      'twelve',
        13      =>      'thirteen',
        14      =>      'fourteen',
        15      =>      'fifteen',
        16      =>      'sixteen',
        17      =>      'seventeen',
        18      =>      'eighteen',
        19      =>      'nineteen',
        '2*'    =>      'twenty',
        '3*'    =>      'thirty',
        '4*'    =>      'forty',
        '5*'    =>      'fifty',
        '6*'    =>      'sixty',
        '7*'    =>      'seventy',
        '8*'    =>      'eighty',
        '9*'    =>      'ninety',
);

sub spell_number{
  my $data=shift;
  my %opts=@_;


  if($data=~/(\-?)\s*(\d+)/){
    my ($s,$d)=($1,$2);
    if($d == 0){
      return "zero";
    }
    my $ret='';
    if($s eq '-'){
      $ret='negative ';
    }
    my $l=length($d);

    if(defined($opts{Format})&&($opts{Format} eq "eu")){
      #European formatting
      my $c=1;
      while($l>0){
        my $o=$l-6;
        my $len=6;
        if($o<0){
          $len=$len+$o;
          $o=0;
        }
        my $ss=substr $d,$o,$len;
        while(length($ss)<6){
          $ss='0'.$ss;
        }

        my ($hun1,$tn1,$dig1,$hun2,$tn2,$dig2)=unpack("A1A1A1A1A1A",$ss);

        my $sp='';
        if($hun1!=0){
          $sp.=$digit{$hun1}." hundred ";
        }
        if($tn1==0){
          $sp.=" ".$digit{$dig1}." ";
        }elsif($tn1==1){
          $sp.=" ".$digit{$tn1.$dig1}." ";
        }else{
          $sp.=" ".$digit{$tn1."*"}." ".$digit{$dig1}." ";
        }

        if($sp!~/^\s*$/){
          $sp.=" thousand ";
        }

        if($hun2!=0){
          $sp.=$digit{$hun2}." hundred ";
        }
        if($tn2==0){
          $sp.=" ".$digit{$dig2}." ";
        }elsif($tn2==1){
          $sp.=" ".$digit{$tn2.$dig2}." ";
        }else{
          $sp.=" ".$digit{$tn2."*"}." ".$digit{$dig2}." ";
        }

        if($c==1){
          if($sp!~/^\s*$/){
           $ret=$sp;
	  }
        }else{
          $ret=$sp.' '.$expo{$c}.' '.$ret;
        }
        $l-=6;
        $c++;
      }

    }else{
      #American formatting
      my $c=0;
      while($l>0){
        my $o=$l-3;
        my $len=3;
        if($o<0){
          $len=$len+$o;
          $o=0;
        }
        my $ss=substr $d,$o,$len;
        my $sp='';
        while(length($ss)<3){
          $ss='0'.$ss;
        }
        my ($hun,$tn,$dig)=unpack("A1A1A1",$ss);
        if($hun!=0){
          $sp.=$digit{$hun}." hundred ";
        }
        if($tn==0){
          $sp.=" ".$digit{$dig}." ";
        }elsif($tn==1){
          $sp.=" ".$digit{$tn.$dig}." ";
        }else{
          $sp.=" ".$digit{$tn."*"}." ".$digit{$dig}." ";
        }
        if($sp!~/^\s*$/){
          $ret=$sp.' '.$expo{$c}.' '.$ret;
        }
        $l-=3;
        $c++;
      }
    }


    $ret=~s/\s\s+/ /g;
    $ret=~s/^\s//g;
    $ret=~s/\s$//g;
    return $ret;
  }else{
    return "";
  }
}



# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__