Need someone to look over a perl script

Sector11 · 2024-01-18 16:57:33

# Description:  Translates positive integer as argument to English words.
# Based on a Tcl script found at http://mini.net/tcl/.
# tcl script site no longer exists - 2022

It works great sometimes, but '0s' toss in errors

 18 Jan 24 @ 12:44:29 ~
   $ num 75
seventy-five
 
 18 Jan 24 @ 12:44:36 ~
   $ num 750
seven hundred fifty
 
 18 Jan 24 @ 12:44:40 ~
   $ num 7500
seven thousand five hundred zero
 
 18 Jan 24 @ 12:44:45 ~
   $ num 75000
seventy-five thousand zero
 
 18 Jan 24 @ 12:44:49 ~
   $ num 750000
seven hundred fifty thousand zero
 
 18 Jan 24 @ 12:44:56 ~
   $ num 7500000
seven million five hundred zero thousand zero
 
 18 Jan 24 @ 12:45:00 ~
   $ num 75000000
seventy-five million zero thousand zero
 
 18 Jan 24 @ 12:45:06 ~
   $ num 12345678963258741
twelve quadrillion three hundred forty-five trillion six hundred seventy-eight billion nine hundred sixty-three million two hundred fifty-eight thousand seven hundred forty-one
 
 18 Jan 24 @ 13:06:21 ~
   $ num 12300321
twelve million three hundred zero thousand three hundred twenty-one
 
 18 Jan 24 @ 13:32:03 ~
   $ num 1230321
one million two hundred thirty thousand three hundred twenty-one
 
 18 Jan 24 @ 13:32:23 ~
   $ num 12345054321
twelve billion three hundred forty-five million eighteen-five thousand three hundred twenty-one
 
 18 Jan 24 @ 13:32:36 ~
   $

Obviously 12300321 !=
twelve million three hundred zero thousand three hundred twenty-one

And this:
12345054321 != - there isn't even a 'one-eight' combo in there
twelve billion three hundred forty-five million eighteen-five thousand three hundred twenty-one
so that number is another OOPS!

#!/usr/bin/perl -w
use strict;
#-------------------------------------------------------------------------
# Description:  Translates positive integer as argument to English words.
# Based on a Tcl script found at http://mini.net/tcl/591.
# tcl script site no longer exists - 2022
#-------------------------------------------------------------------------
# Changelog:
# 021014 Smitty created.
# 021016 Smitty modified to print all answers on STDOUT.
# Smitty no longer online 2022
# fron: /media/5/spanish/spelnum by Smitty
#-------------------------------------------------------------------------
my($N,@U);
@U=qw(zero one two three four five six seven eight nine ten eleven
 twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen
 twenty thirty forty fifty sixty seventy eighty ninety thousand million
 billion trillion quadrillion quintillion sextillion septillion octillion
 nonillion decillion undecillion duodecillion tredecillion quattuordecillion
 quindecillion sexdecillion septendecillion octodecillion novemdecillion
 vigintillion);

&help() unless(scalar(@ARGV)==1); # Must be an argument!
$N=shift;
&help() unless($N=~s/^0*(\d+)$/$1/); # Argument m/b positive integer.
&prt("zero") unless($N);
&prt(&recurse($N,0));

sub help {
	die "I need one positive integer as argument!";
} # End help

sub hundreds {
#-------------------------------------------------------------------------
# Translates up to three digits in $num, with $unit being 0 for hundreds,
# 1 for thousands, etc.
#-------------------------------------------------------------------------
	my($num,$unit)=@_;
	my($pad,$str);

	$str=$pad='';
	if($num=~/^(.)(..)$/ && $1 ne '0') {
		$str=$U[$1].' hundred'; # one hundred, two hundred, etc.
		$num=$2; # Set $num to the last two digits.
		$pad=' ';
	}
	if($num) { # Do if $num>0 && $num<99.
		if($num<21) {
			$str.=$pad.$U[$num];
		} else {
			$str.=$pad.$U[substr($num,0,1)+18]; # twenty, thirty...
			$num=substr($num,1,1); # Set $num to second digit.
			$str.='-'.$U[$num] if($num); # -one, -two, etc.
		}
	}
	$str.=' '.$U[$unit+27] if($unit); # thousand, million, etc.
	return($str);
} # End hundreds

sub prt {
#-------------------------------------------------------------------------
# Prints message and exits.
#-------------------------------------------------------------------------
	my($msg)=@_;

	print "$msg\n";
	exit(0);
}

sub recurse {
#-------------------------------------------------------------------------
# Called from mainline and recursively by itself to translate successive
# sets of three digits in the original argument.
#-------------------------------------------------------------------------
	my($num,$unit)=@_;
	my($i,$j,$str);

	if ($num=~/^(.+?)(...)$/) {
		($i,$j)=($1,$2);
		$str=&recurse($i,$unit+1);
		$str.=' '.&hundreds($j,$unit) if($j);
	} else {
		$str=&hundreds($num,$unit);
	}
	return($str);
} # End recurse

The number 100 is a good place to start:

   $ num 100
one hundred zero

YUP, I saw this:

Translates up to three digits in $num, with $unit being 0 for hundreds, 1 for thousands, etc.

that why I saw number 100 a good place to start and I also saw this

@U=qw(zero one two three four five six seven eight nine ten eleven
 twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen
 twenty thirty forty fifty sixty seventy eighty ninety thousand million
 billion trillion quadrillion quintillion sextillion septillion octillion
 nonillion decillion undecillion duodecillion tredecillion quattuordecillion
 quindecillion sexdecillion septendecillion octodecillion novemdecillion
 vigintillion);

To be fair this is YEARS old and perl has been update over the years I'm sure.

Anyone out there want to tackle it?

Robi · 2024-01-31 00:07:51

sudo apt install cpan
perl -MCPAN -c shell
install Number::Spell

use Number::Spell;
my $string = spell_number($N);

Should you insist fixing the script I had only some partial results. What's your preference debugging or using a verified module?
----------------------------------------------

diff num2.pl num.pl --horizon-lines=80
14,15d13
< use Number::Spell;
< 
29,30d26
< my $string = spell_number($N);
< #print "$string\n";
47c43
< 		$str=$U[$1].' hundred '; # one hundred, two hundred, etc.
---
> 		$str=$U[$1].' hundred'; # one hundred, two hundred, etc.
61d56
< 	$str=~ s/\s{2}/ /;
82d76
< 	
88d81
<     $str =~ s/\s?zero\s?(\S+\s?)?// if ($i && $j eq '000');
91d83
< 		$str =~ s/\s?zero\s?/ /;

--------------------------
here is a test version difference list

Last edited by Robi (2024-01-31 14:17:56)

brontosaurusrex · 2024-01-31 14:45:16

@Robi, I've added code tags, hopefully not messing anything.

#1 2024-01-18 16:57:33

Need someone to look over a perl script

#2 2024-01-31 00:07:51

Re: Need someone to look over a perl script

#3 2024-01-31 14:45:16

Re: Need someone to look over a perl script

Board footer