#!/usr/bin/env perl # # number - print the English name of a number of any size # # usage: # number [-p] [-l] [-d] [-m] [-c] [-o] [-i] # [-r ruleset | -e] [-h] [[--] number] # # -p input is a power of 10 # -l input is a Latin power (1000^x) # -d add dashes to help with pronunciation # -m output name in a more compact exponential form # -c output number in comma/dot form # -o output number on a single line # -i Use informal Latin powers (default: use formal) # Use dodec over duodec and ducen over duocen # # -r ruleset Output using ruleset: (conflicts with -e) # # -r american Output using the American ruleset (default) # -r us Short for -r american # -r european Output using the European ruleset # -r euro Short for -r european # # NOTE: ruleset names are case independent # # -e Short for -r european (conflicts with -r ruleset) # # -h print a help message only # # If number is omitted, then it is read from standard input. # # When run as: # # number.cgi # # then it will act like a CGI script with suitable size limits for # web applications. # # When run as: # # number (or number.pl or anything not ending in .cgi) # # then the program will run without the web/CGI size limitations. # The size of number, in the non-cgi mode, is only limited by the # amount of virtual memory in your computer! # #### # # The GitHub repo for number is: # # https://github.com/lcn2/number # # To be sure your copy is up to date, please clone that repo: # # git clone https://github.com/lcn2/number.git # #### # # Be sure to visit: # # http://www.isthe.com/chongo/tech/math/number/number.html # and: # http://www.isthe.com/chongo/tech/math/number/howhigh.html # and: # http://www.isthe.com/chongo/tech/math/prime/mersenne.html # #### # # Copyright (c) 1998-2011,2016,2023,2024 by Landon Curt Noll. All Rights Reserved. # # Permission to use, copy, modify, and distribute this software and # its documentation for any purpose and without fee is hereby granted, # provided that the above copyright, this permission notice and text # this comment, and the disclaimer below appear in all of the following: # # supporting documentation # source copies # source works derived from this source # binaries derived from this source or from derived source # # LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, # INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO # EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR # CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF # USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR # OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR # PERFORMANCE OF THIS SOFTWARE. # # With many thanks for Latin suggestions from: # # Jeff Drummond # # as well as thanks to these people for their bug reports on earlier versions: # # Dr K.M. Briggs Fredrik Mansfeld # # Comments, suggestions, bug fixes and questions about these routines # are welcome. # # Happy bit twiddling, # # Landon Curt Noll # http://www.isthe.com/chongo/index.html # # chongo (Share and enjoy! :-) - chongo was here) /\../\ # #### #### # HELP WANTED: # # This code uses the CGI.pm perl module, which is no longer actively # maintained. If you want to help convert this code away from using # the CGI.pm perl module and instead using a CGI-like module that is # actively maintained AND is part of core perl, please submit a # pull request with such a change: # # https://github.com/lcn2/number/pulls # # The GitHub repo for number is: # # https://github.com/lcn2/number # # To be sure your copy is up to date, please clone that repo: # # git clone https://github.com/lcn2/number.git # #### #### # # PLEASE READ PLEASE READ PLEASE READ PLEASE READ # ########################################### # On the purpose and history of this code # ########################################### # # The English number system we use today is a mix of old English, old # French and old commercial Latin to name just a few sources. Extensions # beyond the Latin power of 21 was based in part commercial Latin of # Venice, particularly of the 14th and early 15th century when Republic # of Venice. This Latin differs from liturgical Latin and modern # standard Latin in several ways. One of these differences is # "do" vs. "duo" as in "do-dec-illion" vs. "duo-dec-illion", and is # "du" vs. "duo" as in "ducen-tillion" vs. "duo-cen-tillion". Additional # differences include, but are not limited and "millia" vs. "milia". # It is unfortunate that consistent spelling was not a hallmark of that era! # # When we codifying the rules for "The English name of a number", we # were tempted to "improve" the system today. For example there are # a number of aspects to the system that we do not like. The # inconsistency of "do/du" (as in "do-dec-illion" and "ducen-tillion") # and the "four and twenty" rule (as in the name "quattuor-vigin-tillion") # is unfortunate. # # When we set down the "name of the number" system we were attempting # to programmatically describe the system we had using the roots of # the language on which it was based. If we tweaked the system to # our preferences in one place then soon we would have been describing # our preferences instead of the system we use today. So we resisted # the temptation to improve and stuck to strict codification of the # names of the Latin powers. # # However since that time, we have uncovered use of "duo" in the 14th # and early 15th centuries. And since spelling then was often # inconsistent (it was not unusual to find a word spelled several # ways in some documents), we feel safe to select "duo" in the name # of consistency. I.e., if we are forced to choose a spelling, then # we will opt for the more consistent spelling that produces a simpler # algorithm. Therefore starting with version 3, we will use "duo" # in place of "du" and "do". However for backward compatibility, a # flag will be used to generate original Latin power roots. # ############################################################ # Regarding those proposing improved number naming systems # ############################################################ # # There exist a number of proposals offering improved number naming # systems. We agree that names of numbers used in English could be # improved if one was not interested in remaining backward compatible # with the system in use today. We also agree that the extension # beyond the Latin power of 21 may be improved if one is willing to # ignore the historic Latin power roots. # # This program will NOT be modified to reflect such recommendations # for improvements for two important reasons: # # 1) The "name of the number" system algorithm only describes an # extension to a historical system using the spelling and grammar # rules of that era. Modern Latin rules and more general proposals # for improved number naming systems are focused in ideas of # today, not what was in place centuries ago when the English # number naming system began. # # 2) We do not have time or the energy required to codify alternate # proposals. While we wish the proponents of those systems success, # the purpose this algorithm is to describe the extension of the # common naming system today using the historic rules of the # languages on which today's system is based. # ################################################## # Regarding regional English language variations # ################################################## # # There exist many of variations of the names of numbers in the English # language. Examples include this such as "zero" vs. "naught", # "thousand million" vs. "millard", "one thousand two hundred" vs. # "twelve hundred", "two hundred and forty" vs. "two hundred forty", # etc. English is a multifaceted language. English spelling and # grammar of New Zealand, Canada, Australia, U.K., U.S.A., just to # name a few places will differ. Even the output of digits can differ # among English speaking countries. For example: "123,456.789" vs. # "123 456.789". # # The original code only described just the "American" and "European" # systems. We don't have the time, or the energy to codify the many # English variations. If you wish extend this code to describes a # favorite variation, then you are welcome to submit a # pull request to: # # https://github.com/lcn2/number/pulls # # The GitHub repo for number is: # # https://github.com/lcn2/number # # To be sure your copy is up to date, please clone that repo: # # git clone https://github.com/lcn2/number.git # # To invoke your variation, please use: # # -r name_of_your_ruleset # # We will consider pull requests that describe a regional English variation # only. Please do not submit a patch for an "improved number naming # systems" (see the previous section). # #### # requirements # use strict; use bytes; use Math::BigInt; use vars qw($opt_p $opt_l $opt_d $opt_m $opt_c $opt_o $opt_i $opt_r $opt_h $opt_e); use Getopt::Long; # version my $version = '3.10.3 2024-05-02'; # CGI / HTML variables # # NOTE: This code uses CGI.pm, which while not part of core perl, # may be installed via the command: # # cpanm CGI # # See: # # http://search.cpan.org/perldoc?cpanm # # NOTE: RHEL (and systems that use yum) users may install cpanm via: # # yum install perl-App-cpanminus # # NOTE: See above in the "HELP WANTED" section for a request # to convert this code to something that uses a better CGI # perl module that is maintained and is part of core perl. # my $html = 0; # 1 ==> be are being invoked as a CGI script my $cgi = 0; # CGI object, if invoked as a CGI script my $preblock = 0; # 1 ==> we have output
if ($0 =~ /\.cgi$/) { $html = 1; use CGI qw(:standard :cgi-lib use_named_parameters -debug); } # GetOptions argument # my %optctl = ( "p" => \$opt_p, "l" => \$opt_l, "d" => \$opt_d, "m" => \$opt_m, "c" => \$opt_c, "o" => \$opt_o, "i" => \$opt_i, "r=s" => \$opt_r, "h" => \$opt_h, "e" => \$opt_e ); # Warning state my $warn = $^W; # We setup this arbitrary limit so that people to not enter # very large numbers and drive that server crazy. The algorithm # used has no limit so we pick an arbitrary limit. # my $big_input = 20480; # too many input digits for the web my $big_latin_power = 100000; # 1000^big_latin_power is limit for the web my $big_decimal = 1000000; # don't expand >$big_decimal digits on the web my $big_digits = $big_input; # too many digits to produce a name for the web my $big_timeout = 100; # max time to do anything # For DOS (Denial Of Service) protection prevent file uploads and # really big "POSTS" # $CGI::POST_MAX = $big_input + 8192; # limit post size to max digits + 8k $CGI::DISABLE_UPLOADS = 1; # no uploads # We have optimizations that allow us to treat a large power of 10 bias # (due to conversion of a very large scientific notation number) in # a different fashion from a small bias. # # This value must be able to be be represented as an integer (say < 2^31). # In practice this should be even smaller. # my $big_bias = 10000; # a big bias (should be < 2^31). # misc BigInt # my $two = Math::BigInt->new("2"); my $three = Math::BigInt->new("3"); my $eight = Math::BigInt->new("8"); my $neg_eight = Math::BigInt->new("-8"); my $ten = Math::BigInt->new("10"); my $hundred = Math::BigInt->new("100"); my $five_hundred = Math::BigInt->new("500"); # ruleset (using -r) # # map ruleset strings into canonical ruleset names # my %ruleset_canonical = ( "american" => "american", "us" => "american", "usa" => "american", "european" => "european", "euro" => "european", ); # tables based on the canonical ruleset name (see above) # my %ruleset_sep = ( "american" => ",", "european" => ".", ); my %ruleset_point = ( "american" => ".", "european" => ",", ); my %ruleset_point_name = ( "american" => "point", "european" => "comma", ); my %ruleset_kilo = ( "american" => \&american_kilo, "european" => \&european_kilo, ); my %ruleset_latin_root = ( "american" => \&american_latin_root, "european" => \&european_latin_root, ); # To help pronounce values we put $dash between word parts # my $dash = ""; # Informal Latin root tables (using -i) # my @old_unit = ( "" , qw( un do tre quattuor quin sex septen octo novem )); my @old_ten = ("", qw( dec vigin trigin quadragin quinquagin sexagin septuagin octogin nonagin )); my @old_hundred = ("", qw( cen ducen trecen quadringen quingen sescen septingen octingen nongen )); my @old_special = ("", qw( mi bi tri quadri quinti sexti septi octi noni )); # Formal Latin root tables (without -i) # my @new_unit = ( "" , qw( un duo tre quattuor quin sex septen octo novem )); my @new_ten = ("", qw( dec vigin trigin quadragin quinquagin sexagin septuagin octogin nonagin )); my @new_hundred = ("", qw( cen duocen trecen quadringen quingen sescen septingen octingen nongen )); my @new_special = ("", qw( mi bi tri quadri quinti sexti septi octi noni )); # The selected Latin root table (depends on -u or not -u) # my @l_unit; my @l_ten; my @l_hundred; my @l_special; # English names - names from 0 thru 999 # # The english_3 array gets loaded by the print_3() function as # names of 3 digit values are computed. Values previously computed # will be returned by table lookup. # my @english_3; my @digits = qw(zero one two three four five six seven eight nine); my @tens = qw(zero ten twenty thirty forty fifty sixty seventy eighty ninety); my @teens = qw(ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen); # usage and help # my $usage = "[-p] [-l] [-d] [-m] [-c] [-o] [-i]\n" . "\t\t[-r ruleset | -e] [-h] [[--] number]"; my $help = qq{Usage: $0\t$usage -p input is a power of 10 -l input is a Latin power (1000^x) -d add dashes to help with pronunciation -m output name in a more compact exponentiation form -c output number in comma/dot form -o output number on a single line -i Use informal Latin powers (default: use formal) Use dodec over duodec and ducen over duocen -r ruleset Output using ruleset: (conflicts with -e) -r american Output using the American ruleset (default) -r us Short for -r american -r european Output using the European ruleset -r euro Short for -r european NOTE: ruleset names are case independent -e Short for -r european (conflicts with -r ruleset) -h print a help message only -- the arg that follows is a number (useful if number is <0) If number is not given on the command line it is read from standard input. All whitespace (including newlines), commas and periods are ignored, with the exception of a single (optional) decimal point (or decimal comma if european name system), which if found will be processed. In the case of reading from standard input, all valid data found on standard input will be considered as if it were a single number. A number may be either in decimal or in scientific notation (e.g., 2.5e100). Negative and floating point numbers are allowed. Be careful when using negative on the command line. One must give an -- argument so as to not confuse command parsing. E.g.: ./number -- -123 Updates from time to time are made to this program. See: https://github.com/lcn2/number for the latest version of this code. See also: http://www.isthe.com/chongo/tech/math/number/howhigh.html You are using Version: $version }; # forward declarations # sub exp_number($$$); sub print_number($$$$$$$); sub latin_root($$); sub american_kilo($); sub european_kilo($); sub american_latin_root($$); sub european_latin_root($$); sub power_of_ten($$$); sub print_name($$$$$); sub print_3($); sub cgi_form(); sub trailer($); sub big_err(); sub err($); # signal processing # $SIG{PIPE} = sub { exit(2); }; $SIG{ALRM} = sub { err("timeout"); }; # main # MAIN: { # my vars # my $sep; # set of 3 digits separator my $point; # decimal point or comma my $integer; # integer part my $fract; # fractional part my $ruleset; # american, european, etc. (but not a Swallow :-)) my $visit; # visit counter or error message my $num; # input value my $bias; # power of 10 bias (as BigInt) during de-sci conversion my $neg; # 1 => number if < 0 # setup # select(STDOUT); $| = 1; # set the defaults # $opt_p = 0; $opt_l = 0; $opt_d = 0; $opt_m = 0; $opt_c = 0; $opt_o = 0; $opt_i = 0; $opt_r = undef; $opt_h = 0; $opt_e = undef; # determine if we are CGI based # if ($html) { # CGI setup # alarm($big_timeout); $cgi = new CGI; if (cgi_error()) { print "Content-type: text/plain\n\n"; print "Your browser sent bad or too much data!\n"; print "Error: ", cgi_error(), "\n"; exit(1); } $cgi->use_named_parameters(1); # print CGI form # $num = cgi_form(); # If no number (as displayed the blank form), just exit # if (! defined $num) { print $cgi->p, "\n"; trailer(0); exit(0); } # non-CGI parsed args # # NOTE: The -0 thru -9 are hacks to deal with negative numbers # on the command line. # } elsif (!GetOptions(%optctl)) { err("usage: $0 $usage"); exit(1); } # Print help if that is all that is required # if ($opt_h) { print $help; exit(0); } # -c conflicts with -l and -p # if ($opt_c && ($opt_l || $opt_p)) { if ($html == 0) { err("-c conflicts with either -l and/or -p"); } else { err("You may only print decimal digits when the Type of " . "input\nis just a number."); } } # -e conflicts with -r ruleset # if (defined $opt_r && defined $opt_e) { err("-e conflicts with -r ruleset"); } # -e implies -r european # if (defined $opt_e) { $opt_r = "european"; } # default to American ruleset # if (! defined $opt_r) { $opt_r = "american"; } # canonicalize ruleset to all lower case # $opt_r = lc($opt_r); # determine the name system being used # if (defined $ruleset_canonical{$opt_r}) { $ruleset = $ruleset_canonical{$opt_r}; } else { err("Unknown -r ruleset name: $opt_r"); } $sep = $ruleset_sep{$ruleset}; if (!defined $sep) { err("FATAL: Undefined separator value for ruleset: $ruleset"); } $point = $ruleset_point{$ruleset}; if (!defined $point) { err("FATAL: Undefined point value for ruleset: $ruleset"); } # determine if dashes will appear in the name # if ($opt_d) { # print -'s between useful parts of the name # $dash = "-"; } # determine the Latin root naming system # if ($opt_i) { # informal Latin room system (using du/do) @l_unit = @old_unit; @l_ten = @old_ten; @l_hundred = @old_hundred; @l_special = @old_special; } else { # formal Latin room system (using duo) @l_unit = @new_unit; @l_ten = @new_ten; @l_hundred = @new_hundred; @l_special = @new_special; } # get the number # if (defined $ARGV[0]) { $num = $ARGV[0]; } elsif ($html == 0) { # snarf the number from the entire stdin # $/ = undef; $num = <>; } # Web firewall # if ($html && length($num) > $big_input) { big_err(); } # strip separators and whitespace # $num =~ s/[\s\Q$sep\E]+//g; # note if negative or positive # # We remove any leading - to optimize for the positive case. # if ($neg = ($num =~ /^-/)) { $num =~ s/^-//; } # strip leading 0's # if ($num =~ /^0/) { if ($num =~ /^00+$/) { # deal with only 0's case $num = "0"; } else { # strip off leading 0's $num =~ s/^0+//; } } # firewall # if ($num =~ /\Q$point\E.*\Q$point\E/o) { err("Numbers may have only one decimal $point."); } if ($num =~ /^$/) { $num = "0"; } # If scientific (e or E notation), verify format # and convert it into a long decimal value. # if ($num =~ /[eE]/) { if ($num !~ /^[\d\Q$point\E]+[Ee]-?\d+$/o) { err( "Scientific numbers may only have a leading -, digits\n" . "an optional decimal $point (optionally followed by digits)\n" . "before e (or E). The e (or E) may only be followed by an\n" . "optional - and 1 more more digits after the e. All\n" . "3 digit separators, leading 0's and whitespace characters\n" . "are ignored."); } if ($num !~ /^\Q$point\E?\d/o) { err("Scientific numbers must at least a digit before the e."); } $num = exp_number($num, $point, \$bias); # We did not have a number in scientific notation so we have no bias # } else { $bias = Math::BigInt->new("0"); } # verify that we have a valid number # if ($num !~ /^[\d\Q$point\E]+$/o || $num =~ /^\Q$point\E$/) { err("A number may only have a leading -, digits and an " . "optional decimal ``$point''.\n" . "All 3 digit separators and" . "whitespace characters and leading 0's are ignored."); } # split into integer and fractional parts # ($integer, $fract) = split /\Q$point\E/, $num; if ($integer =~ /^$/) { $integer = "0"; } # verify that the number and the bias match # # We have a non-zero bias when we convert from scientific notation and # there is not enough digits right or left of the decimal point/comma. # A $bias > 0 can only happen when we have a 0 $fract part. # A $bias < 0 can only happen when we have a 0 $integer part. # if ($bias > 0 && defined($fract) && $fract != 0) { err("FATAL: Internal error, bias: $bias > 0 and fract: $fract != 0"); } if ($bias < 0 && defined($integer) && $integer != 0) { err("FATAL: Internal error, bias: $bias < 0 and int: $integer != 0"); } # setup to output # if ($html) { print $cgi->p, "\n"; print $cgi->hr, "\n"; print $cgi->p, "\n"; if ($opt_c) { print $cgi->b("Decimal value:"), "\n"; } else { print $cgi->b("Name of number:"), "\n"; } print $cgi->p, "\n"; print "\n"; } # section off with a line # if ($html == 1) { print "\n"; $preblock = 1; } # catch the case where we only want to enter a power of 10 # if ($opt_p || $opt_l) { # only allow powers of 10 that are non-negative integers # if (defined($fract) || $neg) { err("The power must be a non-negative integer."); # print the name # } else { power_of_ten(\$integer, $ruleset, $bias); } # print the number comma/dot separated # } elsif ($opt_c) { if ($opt_o) { print_number($sep, $neg, \$integer, $point, \$fract, 0, $bias); } else { print_number($sep, $neg, \$integer, $point, \$fract, 76, $bias); } # otherwise print the first part of the response if allowed # } else { print_name($neg, \$integer, \$fract, $ruleset, $bias); } # If we are doing CGI/HTML stuff, print the trailer # if ($html == 1) { trailer(0); } # all done # exit(0); } # exp_number - convert a scientific notation number into an number # # Given a number in scientific notation, we will attempt to adjust # the position of the decimal point/comma so as to reduce the # scientific exponent. For example: # # 1.234e2 # # would become: # # 123.4 with a bias of 0 # # It is not always possible to fully adjust the scientific exponent # into a 0 bias. For example: # # 12345.6e-10 # # would become: # # .123456 with a bias of -5 # # This function will not adjust the decimal point/comma to beyond # the left or right hand side of the digit string. # # given: # $num contains a string with something like -3.5e70 or # .5e50 or 4E50 or 4.E-49 # $point the decimal point/comma # \$bias adjusted power of ten bias as a BigInt # # returns: # adjusted non-scientific notation string # sub exp_number($$$) { my ($num, $point, $bias) = @_; # get args my $expstr; # base 10 exponent (value after the E) as a string my $exp; # base 10 exponent (value after the E) as a BigInt my $lead; # lead digits (before the E) my $int; # integer part of lead my $frac; # fractional part of lead # we have something like -3.5e70 or .5e50 or 4E50 or 4.E-49 # break it apart into before and after the E # ($lead, $expstr) = split(/[Ee]/, $num); $exp = Math::BigInt->new($expstr); # If we have a 0 exponent, just return the lead with a zero bias # if ($exp == 0) { $$bias = Math::BigInt->new("0"); return $lead; } # We need to split the lead between before and after the # decimal point/comma # ($int, $frac) = split(/\Q$point\E/, $lead); $frac = "" if !defined($frac); # If we need to move the decimal point/comma to the right, then # we do so by moving digits from $fract onto the end of $int and # adding more 0's onto the end of $int as needed. # if ($exp > 0) { # If we have more exp than $frac digits, then just # tack the $frac onto the end of the $int part. This # will result in power of ten bias > 0. # if (length($frac) <= $exp) { # move all $frac digits to the left of decimal point/comma # $int .= $frac; $$bias = $exp - length($frac); $frac = ""; # we have fewer exp than $frac digits, so we will move # only part of the $frac to the $int side # } else { # we use $expstr because we know that it is a small value $int .= substr($frac, 0, $expstr); $frac = substr($frac, $expstr); $$bias = Math::BigInt->new("0"); } # If we need to move the decimal point/comma to the left, then # we do so by moving digits from the end of $int onto the front # if $frac and adding more 0's on the front of $frac as needed. # } elsif ($exp < 0) { # If we have more exp than $int digits, then we just # tack the $int part onto the front of the $int part # and set $int to 0. This will result in a power of # ten bias < 0. # if (length($int) <= -$exp) { # move all $int digits to the right of decimal point/comma # $$bias = $exp + length($int); $frac = $int . $frac; $int = "0"; # we have fewer exp than $int digits, so we will move # only part of the $int to the $frac side # } else { # we use $expstr because we know that it is a small value $frac = substr($int, $expstr) . $frac; $int = substr($int, 0, length($int)+$expstr); $$bias = Math::BigInt->new("0"); } } # we have the value as decimal in $int and $frac, form the # final decimal and return it # if ($frac =~ /^\d/) { return $int . $point . $frac; } else { return $int; } } # print_number - print the number with ,'s or .'s # # given: # $sep , or . set of 3 digit separators # $neg 1 => number is negative, 0 => non-negative # \$integer integer part of the number # $point decimal point/comma # \$fract fractional part of number (or undef) # $linelen max line length (0 => no limit) # $bias power of 10 bias during de-sci notation conversion # sub print_number($$$$$$$) { # get args my ($sep, $neg, $integer, $point, $fract, $linelen, $bias_arg) = @_; my $wholelen; # length of the integer part as modified by bias my $intlen; # length of the integer part without bias my $fractlen; # length of the fractional part my $leadlen; # length of digits, separators and - on 1st line my $col; # current output column, first col is 1 my $bias = Math::BigInt->new($bias_arg); # power of 10 bias my $bias_str; # $bias as a string my $i; # deal with the zero special case # if (!defined($$integer) || $$integer eq "") { $$integer = "0"; } # determine if the web limits will apply # $intlen = 0; if (defined($$integer)) { $intlen = length($$integer); } $fractlen = 0; if (defined($$fract)) { $fractlen = length($$fract); } if ($html) { my $fulllen; # approximate length of the input as BigInt # $fulllen = abs($bias) + $fractlen + int($intlen*4/3) $fulllen = $bias->copy(); $fulllen->babs(); $fulllen->badd($fractlen); $fulllen->badd(int($intlen*4/3)); # if $fulllen > $big_decimal if ($fulllen->bcmp($big_decimal) > 0) { big_err(); } } # We will round the max line length down to a multiple of 4 # if (!defined($linelen)) { $linelen = 0; } elsif ($linelen > 0) { $linelen = int($linelen/4) * 4; } else { $linelen = 0; } # no line length specified (or value passed < 4) means just print it # on a single line # if ($linelen == 0) { # Print the number, and fraction if it exists on a single line. # if (defined($$fract)) { # deal with a leading - if needed print "-" if $neg; # print thru the decimal point print $$integer, $point; # if biased, print 0's then fract if ($bias < 0) { # print 0's in big_bias chunks at a time # # NOTE: Some implementations, using a BigInt count # in an x (duplication) does not work. So we # avoid this by printing big_bias chunks at a time. # $bias->badd($big_bias); while ($bias < 0) { print "0" x $big_bias; $bias->badd($big_bias); } $bias->bsub($big_bias); if ($bias != 0) { ($bias_str = $bias) =~ s/[^\d]//g; print "0" x -$bias_str; } } # print the remainder of the fraction # print $$fract; } else { # deal with a leading - if needed print "-" if $neg; # print the integer digits print $$integer; # if biased, print 0's if ($bias > 0) { # print 0's in big_bias chunks at a time # # NOTE: Some implementations, using a BigInt count # in an x (duplication) does not work. So we # avoid this by printing big_bias chunks at a time. # $bias->bsub($big_bias); if ($bias > 0) { print "0" x $big_bias; $bias->bsub($big_bias); } $bias->badd($big_bias); if ($bias != 0) { print "0" x $bias; } } } # If we have a line length, we need to insert newlines after # the separators to keep within the max line length. # } else { # determine the length of the integer part of the number # $wholelen = Math::BigInt->new($intlen); if ($bias > 0) { $wholelen += $bias; } $leadlen = $wholelen->copy(); if ($wholelen->bcmp(3) > 0) { # if >3 my $tmp; # account for separators # # Some BigInt implementations issue uninitialized # warnings internal to the BigInt code with the # division below. We block these bogus warnings. # # $leadlen += ($wholelen-1)/3; # $tmp = $wholelen - 1; $^W = 0; $tmp->bdiv($three); $^W = $warn; $leadlen->badd($tmp); } if ($neg) { # account for - sign $leadlen = $leadlen + 1; } # print enough the leading whitespace so that the # decimal point/comma will line up at the end of a line # # Some BigInt implementations issue uninitialized # warnings internal to the BigInt code with the # modulus below. We block these bogus warnings. # $^W = 0; $col = ($linelen - (($leadlen+1) % $linelen)) % $linelen; $^W = $warn; print " " x $col; # process a leading -, if needed # if ($neg) { if (++$col >= $linelen) { # This could mean that we have a lone - in the 1st line # but there is nothing we can do about that if we want # the decimal point/comma to be at the end of a line # and the separators to line up in columns (particularly # along the right hand edge) print "-\n"; $col = 1; } else { print "-"; } } # output the leading digits before the first separator # if ($bias > 0) { # Some BigInt implementations issue uninitialized # warnings internal to the BigInt code with the # modulus below. We block these bogus warnings. # $^W = 0; # avoid turning $i in to a BitInt because of the # later use in substr() if ($bias % 3 == 0) { $i = $intlen % 3; } elsif ($bias % 3 == 1) { $i = ($intlen+1) % 3; } else { $i = ($intlen+2) % 3; } $^W = $warn; } else { $i = $intlen % 3; } if ($i == 0) { $i = 3; } $col += $i; if ($i > $intlen) { print substr($$integer, 0, $i), 0 x ($i-$intlen); } else { print substr($$integer, 0, $i); } # output , and 3 digits until whole number is exhausted # while ($i < $intlen) { # output the separator, we add a newline if the line # is at or beyond the limit # if (++$col >= $linelen) { print "$sep\n"; $col = 1; } else { print $sep; } # output 3 more digits # if ($i+3 > $intlen) { print substr($$integer, $i, 3), 0 x ($i+3-$intlen); } else { print substr($$integer, $i, 3); } $col += 3; $i += 3; } # if biased > 0, output sets of 0's until decimal point/comma # if ($wholelen->bcmp($intlen) > 0) { # if >$intlen while ($wholelen->bcmp($i) > 0) { # while $i < $wholelen # output the separator, we add a newline if the line # is at or beyond the limit # if (++$col >= $linelen) { print "$sep\n"; $col = 1; } else { print $sep; } # output 3 more digits # print "000"; $col += 3; $i += 3; } } # print the decimal point/comma followed by the fractional # part if needed # if (defined($$fract)) { my $offset; # offset within fract bring printed # print the decimal point/comma and move to a new line # print "$point\n"; $col = 1; $offset = 0; # if biased, print leading 0's then the fract digits # line with the first fract digits # if ($bias < 0) { # print whole lines of 0's while we have lots of bias # # while $bias < -$linelen $bias->badd($linelen); while ($bias < 0) { print "0" x $linelen, "\n"; $bias->badd($linelen); } $bias->bsub($linelen); # print the last line of bias 0's # # NOTE: Some implementations, using a BigInt count # in an x (duplication) does not work. So we # avoid this by printing using a scalar repeater. # if ($bias != 0) { $i = $bias->bstr(); print "0" x -$i; $offset += -$i; } # print the first line of fract to fill out the line # if ($offset <= $linelen) { print substr($$fract, 0, $linelen-$offset), "\n"; } else { print "\n"; } # print the rest of the faction in linelen chunks # for ($i = $linelen-$offset; $i < $fractlen; $i += $linelen) { print substr($$fract, $i, $linelen), "\n"; } # non-biased printing of fract digits # } else { # print the rest of the faction in linelen chunks # for ($i = 0; $i < $fractlen; $i += $linelen) { print substr($$fract, $i, $linelen), "\n"; } } } } # end of the number print "\n"; } # latin_root - print the Latin root of a number # # given: # $num number to construct # $millia addition number of millia to add to the latin_root # # Prints the Latin root name on which we can add llion or lliard to # form a name for 1000^($num+1), depending on American or European # name system. # # The effect of $millia is to multiply $num by 1000^$millia. # sub latin_root($$) { my ($num, $millia_arg) = @_; # get args my $numstr; # $num as a string my @set3; # set of 3 digits, $set3[0] is the most significant my $d3; # 3rd digit in a set of 3 my $d2; # 2nd digit in a set of 3 my $d1; # 1st digit in a set of 3 my $l3; # Latin name for 3rd digit in a set of 3 my $l2; # Latin name for 2nd digit in a set of 3 my $l1; # Latin name for 1st digit in a set of 3 my $len; # number of sets of 3 including the final (perhaps partial) 3 my $millia = Math::BigInt->new($millia_arg); my $millia_cnt; # number of millia's to print my $millia_cnt_str; # $millia_cnt as string my $i; # firewall # if ($millia < 0) { err("FATAL: Internal error, millia: $millia < 0 in latin_root()"); } # deal with small special cases for small values # if ($millia == 0 && $num < @l_special) { print $l_special[$num], $dash; return; } # determine the number of sets of 3 and the length # ($numstr = $num) =~ s/[^\d]//g; $i = length($numstr); $len = int(($i + 2) / 3); if ($i % 3 == 0) { @set3 = unpack("a3"x$len, $numstr); } elsif ($i % 3 == 1) { @set3 = unpack("a"."a3"x($len-1), $numstr); $set3[0] = "00" . $set3[0]; } else { @set3 = unpack("a2"."a3"x($len-1), $numstr); $set3[0] = "0" . $set3[0]; } # Determine how many millia's we will initially print # # We have to be careful about how we compute $millia+len-1 # so that it will not become a floating value. # $millia_cnt = $millia + $len; # process each set of 3 digits up to but not # including the last set of 3 # for ($i=0; $i < $len; ++$i) { # keep track of the number of millia's we might print # if ($millia_cnt > 0) { $millia_cnt = $millia_cnt - 1; } # do nothing if 000 # if ($set3[$i] == 0) { next; } # extract digits in the current set of 3 # $d1 = substr($set3[$i], 2, 1); $l1 = (($d1 > 0) ? $l_unit[$d1] . $dash : ""); $d2 = substr($set3[$i], 1, 1); $l2 = (($d2 > 0) ? $l_ten[$d2] . $dash : ""); $d3 = substr($set3[$i], 0, 1); $l3 = (($d3 > 0) ? $l_hundred[$d3] . $dash : ""); # print the 3 digits # # We will skip the printing of the 3 digits if # we have just 001 in all but the lowest set of 3. # This results in no output so that we wind up with # something such as: # # something-tillion # # instead of: # # un-something-tillion # if ($i > 0 || $d3 != 0 || $d2 != 0 || $d1 != 1) { print "$l3$l1$l2"; } # print millia's as needed # if ($millia > 0 || $i < $len-1) { if ($opt_m) { # print millia's with ^number (-m) notation # if ($millia_cnt > 1) { ($millia_cnt_str = $millia_cnt) =~ s/[^\d]//g; print "millia^", $millia_cnt_str, $dash; } else { print "millia", $dash; } } else { # print the millia's without ^number (-n) notation # # NOTE: Some implementations, using a BigInt count # in an x (duplication) does not work. So we # avoid this by printing big_bias chunks at a time. # $millia_cnt = $millia_cnt - $big_bias; while($millia_cnt > 0) { print "millia$dash" x $big_bias; $millia_cnt = $millia_cnt - $big_bias; } $millia_cnt = $millia_cnt + $big_bias; if ($millia_cnt != 0) { print "millia$dash" x $millia_cnt; } } } } # For the case of ending in 1x we need to end in an 'i' # instead of the usual 'ti'. This is because we say: # # trecen-dec-illion # # instead of: # # trecen-dec-tillion # if (defined($d2) && $d2 == 1) { print "i"; } else { print "ti"; } # all done # return; } # american_kilo - print the name of power of 1000 under American system # # given: # $power power of 1000 # # Prints the name of 1000^$power. # sub american_kilo($) { my $power = $_[0]; # get arg my $big; # $power as a BigInt my $zero; # 0 # firewall # if ($power < 0) { err("Negative powers of 1000 not supported: $power"); } # We treat 0 as nothing # if ($power == 0) { return; # We must deal with 1 special since it does not use a direct Latin root # } elsif ($power == 1) { print "thousand"; # Otherwise we use the Latin root process to construct the value. # } else { $big = Math::BigInt->new($power) - 1; $zero = Math::BigInt->new("0"); latin_root($big, $zero); print "llion"; } } # european_kilo - print the name of power of 1000 under European system # # given: # $power power of 1000 # # Prints the name of 1000^$power. # # The European system uses both "llion" and "lliard" suffixes for # each root value. The "llion" is for even powers and the "lliard" # is for off powers. # # Because both "llion" and "lliard" suffixes are used, we need to # divide in half, the value before using the Latin root system. # sub european_kilo($) { my $power = $_[0]; # get arg my $mod2; # $power mod 2 my $big; # $power as a BigInt my $zero; # 0 # firewall # if ($power < 0) { err("Negative powers of 1000 not supported: $power"); } # We treat 0 as nothing # if ($power == 0) { return; # We must deal with 1 special since it does not use a direct Latin root # } elsif ($power == 1) { print "thousand"; # Use latin_root to determine the root while taking care to # determine of we will end in "llion" (even big,biasmillia combo) # or end in "lliard" (odd big,biasmillia combo). # } else { # divide $power by 2 and note if it was even or odd # # Some BigInt implementations issue uninitialized # warnings internal to the BigInt code with the # bdiv below. We block these bogus warnings. # $big = Math::BigInt->new($power); $^W = 0; ($big, $mod2) = $big->bdiv($two); $^W = $warn; $zero = Math::BigInt->new("0"); # Even roots use "llion" # if ($mod2 == 0) { latin_root($big, $zero); print "llion"; # Odd roots use "lliard" # } else { latin_root($big, $zero); print "lliard"; } } } # american_latin_root - print a Latin root according to american ruleset # # given: # $kilo_power # power of 1000 to process # $biasmillia # int(bias/3) # sub american_latin_root($$) { my ($kilo_power_arg, $biasmillia) = @_; # get args my $kilo_power = Math::BigInt->new($kilo_power_arg); # print the name based on the American ruleset # print " "; $kilo_power = $kilo_power - 1; latin_root($kilo_power, $biasmillia); print "llion"; } # european_latin_root - print a Latin root according to american ruleset # # given: # $kilo_power # power of 1000 to process # $biasmillia # int(bias/3) # sub european_latin_root($$) { my ($kilo_power, $biasmillia) = @_; # get args my $mod2; # $kilo_power mod 2 # divide $kilo_power by 2 taking into account any $biasmillia # # We must determine if the kilo_power and biasmillia combination # is even or odd. # # Some BigInt implementations issue uninitialized # warnings internal to the BigInt code with the # division and mod below. We block these bogus warnings. # $^W = 0; if (($kilo_power % 2) == 0) { # kilo_power is even so kilo_power,biasmillia is even # $kilo_power->bdiv($two); $mod2 = 0; } else { # If we have biasmillia, then the kilo_power,biasmillia combination # is even. We divide by 2 by multiplying by 500 while reducing # biasmillia by one. This results in an even number. # if ($biasmillia > 0) { $kilo_power->bmul($five_hundred); $biasmillia = $biasmillia - 1; $mod2 = 0; # We do not have biasmillia and kilo_power is odd, so we must use # the "lliard" roots # } else { $kilo_power = $kilo_power - 1; $kilo_power->bdiv($two); $mod2 = 1; } } $^W = $warn; # Even roots use "llion" # if ($mod2 == 0) { print " "; latin_root($kilo_power, $biasmillia); print "llion"; # Odd roots use "lliard" # } else { print " "; latin_root($kilo_power, $biasmillia); print "lliard"; } } # power_of_ten - just print name of a the power of 10 # # given: # \$power the power of 10 to name print # $ruleset number ruleset: ('american', 'european', etc.) # (see %ruleset_canonical at the top) # $bias power of 10 bias during de-sci notation conversion # sub power_of_ten($$$) { my ($power, $ruleset, $bias_arg) = @_; # get args my $kilo_power; # power of 1000 to process my $big; # $power as a BigInt my $mod3; # $big mod 3 my $biasmod3; # bias mod 3 my $biasmillia; # int(bias/3) my $bias_big; # approx power of 10 ($bias+$big) my $latin_root_func; # Latin root printing function my $bias = Math::BigInt->new($bias_arg); # power of 10 bias my $i; # firewall # if ($bias < 0) { err("FATAL: Internal error, bias: $bias < 0 in power_of_ten()"); } $latin_root_func = $ruleset_latin_root{$ruleset}; if (! defined $latin_root_func) { err("FATAL: Undefined latin_root function for ruleset: $ruleset"); } # Convert $$power arg into BigInt format # $big = Math::BigInt->new($$power); # convert the power of 10 into a multiplier and a power of 1000 # # If we gave -l, then we will assume that we are dealing with # a power of 1000 instead of a power of 10. # if ($opt_l) { # Web firewall # if ($html && !$opt_m && $bias->bcmp($big_latin_power) > 0) { big_err(); } # increase the power based on bias mod 3 # # Some BigInt implementations issue uninitialized # warnings internal to the BigInt code with the # division and mod below. We block these bogus warnings. # $^W = 0; ($biasmillia, $biasmod3) = $bias->bdiv($three); $^W = $warn; if ($biasmod3 == 1) { $big->bmul($ten); } elsif ($biasmod3 == 2) { $big->bmul($hundred); } # under -l, we deal with powers of 1000 above 1000 # $kilo_power = Math::BigInt->new($big); # under -l, our multiplier name is always one # print "one"; } else { # firewall # if ($bias != 0) { if ($html) { err("Scientific notation is not supported for powers\n" . "of 10 at this time. Try using Latin powers or enter" . " the\nnumber without scientific notation."); } else { err("Scientific notation is not supported for powers of" . "10\n" . "of 10 at this time. Try using Latin powers or enter" . " the\nnumber without scientific notation."); } } # convert power of 10 into power of 1000 # # Some BigInt implementations issue uninitialized # warnings internal to the BigInt code with the # bdiv below. We block these bogus warnings. # $^W = 0; ($kilo_power, $mod3) = $big->bdiv(3); $^W = $warn; $biasmillia = Math::BigInt->new("0"); # print the multiplier name # if ($mod3 < 1) { print "one"; } elsif ($mod3 == 1) { print "ten"; } else { print "one hundred"; } } # A zero kilo_power means that we only have 1, 10 or 100 # and so there is nothing else to print. # if ($kilo_power < 1 && $biasmillia == 0) { # nothing else to print # We must treat a kilo_power of 1 as a special case # because 'thousand' does not have a Latin root base. # } elsif ($kilo_power == 1 && $biasmillia == 0) { print " thousand"; # print the name based on the American ruleset # } else { $latin_root_func->($kilo_power, $biasmillia); } print "\n"; } # print_name - print the name of a number # # given: # $neg 1 => number is negative, 0 => non-negative # \$integer integer part of the number # \$fract fractional part of number (or undef) # $ruleset number ruleset: ('american', 'european', etc.) # (see %ruleset_canonical at the top) # $bias power of 10 bias (as BigInt) during de-sci # notation conversion # sub print_name($$$$$) { my ($neg, $integer, $fract, $ruleset, $bias) = @_; # get args my $bias_mod3; # bias % 3 my $millia; # millia arg, power of 1000 for a given set f 3 my $intstr; # integer as a string my $intlen; # length of integer part in digits my $fractlen = 0; # length of the fractional part my $cnt3; # current set of 3 index (or partial of highest) my $set3; # set of 3 digits my $indx; # index into integer my $kilo_function; # reference to a function to print the kilo name my $point_name; # the same of the point separator my $i; # firewall # $kilo_function = $ruleset_kilo{$ruleset}; if (! defined($kilo_function)) { err("FATAL: undefined kilo_function for ruleset: $ruleset"); } $point_name = $ruleset_point_name{$ruleset}; if (! defined($point_name)) { err("FATAL: undefined point name for ruleset: $ruleset"); } # process a leading -, if needed # if ($neg) { print "negative "; } # must deal with the zero as a special case # if ($$integer eq "0") { print "zero"; } # convert integer to string # ($intstr = $$integer) =~ s/[^\d]//g; # For a bias > 0, we want that bias to be a multiple of 3 # so that we can add it to the 1st arg (power of 1000) of # either american_kilo() or european_kilo(). # # We any bias % 3 and 'move' to the integer by adding 1 or 2 0's # to the end of it. # if ($bias > 0) { # compute $bias % 3 and make $bias a multiple of 3 # # Some BigInt implementations issue uninitialized # warnings internal to the BigInt code with the # bdiv below. We block these bogus warnings. # $^W = 0; ($bias, $bias_mod3) = $bias->bdiv($three); $^W = $warn; # ``move`` the $bias % 3 value onto the end of integer # if ($bias_mod3 == 1) { $intstr .= "0"; } elsif ($bias_mod3 == 2) { $intstr .= "00"; } } # determine the number of sets of 3 # $intlen = length($intstr); $cnt3 = int(($intlen+2)/3); $millia = Math::BigInt->new($bias); # determine if the web limits will apply # if (defined($$fract)) { $fractlen = length($$fract); } if ($html) { my $fulllen; # approximate length of the input as BigInt $fulllen = Math::BigInt->new(abs($fractlen) + abs($intlen)); if ($bias < 0) { $fulllen->bsub($bias); } if ($fulllen->bcmp($big_digits) > 0) { # if $fulllen > $big_digits big_err(); } } # print the highest order set, which may be partial # $indx = 3-((3*$cnt3)-$intlen); $set3 = substr($intstr, 0, $indx); print_3($set3); print " "; --$cnt3; if ($bias > 0) { $kilo_function->($millia+$cnt3); } else { $kilo_function->($cnt3); } # process all of the remaining full sets of 3 (if any) # while (--$cnt3 >= 0) { $set3 = substr($intstr, $indx, 3); $indx += 3; next if $set3 == 0; if ($opt_o) { print ", "; } else { print ",\n"; } print_3($set3); if ($cnt3 > 0 || $bias > 0) { print " "; if ($bias > 0) { $kilo_function->($millia+$cnt3); } else { $kilo_function->($cnt3); } } } # print after the decimal point if needed # if (defined($$fract)) { my $len; # length of current line my $line; # current line being formed # mark the decimal point/comma # if (!$opt_o) { print "\n"; } print $point_name; if ($opt_o) { print " "; } else { print "\n"; $len = 0; } # if biased, print off leading zero's # while ($bias < 0) { my $z_digit = $digits[0]; # zero digit my $diglen = length($z_digit)+1; # length of zero name + space $bias = $bias + 1; if ($opt_o) { print " $z_digit"; } else { if ($len <= 0) { print $z_digit; $len = $diglen - 1; } elsif ($len + $diglen < 80) { print " $z_digit"; $len += $diglen; } else { print "\n$z_digit"; $len = $diglen - 1; } } } # list off the digits # for ($i=0; $i < length($$fract); ++$i) { my $dig = $digits[substr($$fract, $i, 1)]; # the digit to print my $diglen = length($dig)+1; # length of digit + ' ' if ($opt_o) { print " $dig"; } else { if ($len <= 0) { print $dig; $len = $diglen - 1; } elsif ($len + $diglen < 80) { print " $dig"; $len += $diglen; } else { print "\n$dig"; $len = $diglen - 1; } } } } print "\n"; } # print_3 - print 3 digits # # given: # $dig3 1 to 3 digits # # Will print the english name of a number form 0 thru 999. # sub print_3($) { my ($number) = @_; # get args my $num; # working value of number my $name_3; # 3 digit name # pre-compute name of 3 digits if we do not already have it # if (! defined($english_3[$number])) { # setup # err("print_3 called with arg not in [0,999] range: $number") if ($number < 0 || $number > 999); $name_3 = ""; # determine the hundreds name, if needed # if ($number > 99) { $name_3 = $digits[$number/100] . " hundred"; } # determine the name of tens and one if more than 19 # $num = $number % 100; if ($num > 19) { if ($number > 99) { $name_3 .= " "; } $name_3 .= $tens[$num/10]; if ($num % 10 > 0) { $name_3 .= " " . $digits[$num % 10]; } # determine the name of tens and one if more than 9 # } elsif ($num > 9) { if ($number > 99) { $name_3 .= " "; } $name_3 .= $teens[$num-10]; # otherwise determine the name the digit # } elsif ($num > 0) { if ($number > 99) { $name_3 .= " "; } $name_3 .= $digits[$num]; } # save the 3 digit name # $english_3[$number] = $name_3; } # print the 3 digit name # print $english_3[$number]; } # cgi_form - print the CGI/HTML form # # returns: # $num input value # sub cgi_form() { # radio label sets # my %input_label = ( "number" => "Just a number ", "exp" => " Power of 10 ", "latin" => " Latin power (1000^number) " ); my %output_label = ( "name" => " English name ", "digit" => " Decimal digits if input is just a number " ); my %system_label = ( "american" => " American ruleset ", "european" => " European ruleset " ); my %millia_label = ( "dup" => " milliamillia... ", "power" => " millia^7 (compact form) " ); my %dash_label = ( "nodash" => " without any -'s ", "dash" => " with -'s between parts of words " ); my %latin_formality = ( "formal" => " formal use duo ", "informal" => " informal use do and du " ); print $cgi->header, "\n"; print $cgi->start_html( -title => 'The English name of a number', -bgcolor => '#98B8D8'), "\n"; print $cgi->h1('The English name of a number'), "\n"; print $cgi->p, "\n"; print "See the ", "\n"; print $cgi->a({'HREF' => "http://www.isthe.com/chongo/tech/math/number/example.html"}, "example / help"); print " page for an explanation of the options below.\n"; print $cgi->br, "\n"; print "See also the ", "\n"; print $cgi->a({'HREF' => "http://www.isthe.com/chongo/tech/math/number/number.html"}, "English name of a number home page"), "\n"; print "as well as the\n"; print $cgi->br, "\n"; print $cgi->a({'HREF' => "http://www.isthe.com/chongo/tech/math/number/howhigh.html"}, "How high can you count?"), "\n"; print "page.\n"; print $cgi->p, "\n"; print $cgi->start_form, "\n"; print "Type of input:", "\n"; print " " x 4, "\n"; print $cgi->radio_group(-name => 'input', -values => ['number', 'exp', 'latin'], -labels => \%input_label, -default => 'number'), "\n"; print $cgi->br, "\n"; print "Type of output:", "\n"; print " " x 2, "\n"; print $cgi->radio_group(-name => 'output', -values => ['name', 'digit'], -labels => \%output_label, -default => 'name'), "\n"; print $cgi->br, "\n"; print "Ruleset:", "\n"; print " " x 14, "\n"; print $cgi->radio_group(-name => 'ruleset', -values => ['american', 'european'], -labels => \%system_label, -default => 'american'), "\n"; print $cgi->br, "\n"; print "Latin formality:", "\n"; print " " x 2, "\n"; print $cgi->radio_group(-name => 'latin_formality', -values => ['formal', 'informal'], -labels => \%latin_formality, -default => 'formal'), "\n"; print $cgi->br, "\n"; print "Millia style:", "\n"; print " " x 8, "\n"; print $cgi->radio_group(-name => 'millia', -values => ['dup', 'power'], -labels => \%millia_label, -default => 'dup'), "\n"; print $cgi->br, "\n"; print "Dash style:", "\n"; print " " x 9, "\n"; print $cgi->radio_group(-name => 'dash', -values => ['nodash', 'dash'], -labels => \%dash_label, -default => 'nodash'), "\n"; print $cgi->p, "\n"; print $cgi->b('Enter a number:'), "\n"; print $cgi->br, "\n"; print $cgi->textarea(-name => 'number', -rows => '10', -columns => '60'), "\n"; print $cgi->p, "\n"; print $cgi->submit(name=>'Name that number'), "\n"; print " NOTE: We limit POSTs on web to ~$big_input characters,\n"; print "see below.\n"; print $cgi->end_form, "\n"; # Prep for the reply # # We need to convert the CGI parameters into values that # would have been set if we were processing the input # on the command line. # # determine the input mode # if (defined($cgi->param('input'))) { if ($cgi->param('input') eq "exp") { $opt_p = 1; # assume -p (power of 10) } elsif ($cgi->param('input') eq "latin") { $opt_l = 1; # assume -l (1000 ^ number)) } } # determine the output mode # if (defined($cgi->param('output')) && $cgi->param('output') eq "digit") { $opt_c = 1; # assume -c (comma/dot decimal) } # determine the ruleset # if (defined($cgi->param('ruleset')) && $cgi->param('ruleset') eq "european") { $opt_r = "european"; # assume -r ruleset (European ruleset) } # determine the millia style # if (defined($cgi->param('millia')) && $cgi->param('millia') eq "power") { $opt_m = 1; # assume -m (compact millia method) } # determine the dash method in names # if (defined($cgi->param('dash')) && $cgi->param('dash') eq "dash") { $opt_d = 1; # assume -d (use -'s in names) } # determine formal vs informal # if (defined($cgi->param('latin_formality')) && $cgi->param('latin_formality') eq "informal") { $opt_i = 1; # assume -i (informal Latin) } # return the number # return $cgi->param('number'); } # trailer - print the trailer # # given: # $arg 1 => suppress message about obtaining the source # # If the arg passed is 1, then the message about obtaining the source # if suppressed. # sub trailer($) { my $arg = $_[0]; # close off input # if ($preblock && $html == 1) { print "\n
\n\n"; } # display how to get to the source # if (defined($arg) && $arg == 0) { print <
The source for this CGI script is available. Save it as either the filename
number.cgi or number. The CGI script number.cgi operates as it is doing now.
The Perl script number reads a number from standard input, has no size limits
and does not perform any CGI/HTML actions. Try ./number -h for more info.
END_OF_HTML } print <Brought to you by: Landon Curt Noll
chongo < was here > /\\oo/\\