Number-Format-1.75/000750 000765 000024 00000000000 12543063433 014207 5ustar00billstaff000000 000000 Number-Format-1.75/CHANGES000755 000765 000024 00000023244 12543063242 015215 0ustar00billstaff000000 000000 Changes for version 1.75 (June 25, 2015) ------------------------ - Export only necessary from POSIX (RT#99970, thanks Alexandr Ciornii) - Upgrade Makefile.PL (thanks Alexandr Ciornii) - Fix testing issue with missing locales (RT 97607, 97766, thanks to KHW) (thanks David Solimano) - Fix testing issue with bad Russian data on some platforms (RT 92666) (thanks David Solimano) - Add t/bigfloat.t (thanks Paul Miller / Alexandr Ciornii) Changes for version 1.74 (April 19, 2011) ------------------------ - Only Perl 5.10.0 and newer supported - Allow multi-character (e.g. " " for thousands_sep) (thanks Nick Patch; RT 65489) - Strip out illegal negative values returned by localeconv(), observed on Windows - see @IGNORE_NEGATIVE (thanks Adam Kennedy; RT 56802) - Manage warnings when undef is passed to methods (RT 48038) - Fix round() for Math::BigFloat objects (RT 62059) Changes for version 1.73 (September 25, 2009) ------------------------ - Fix locale.t for RUR/RUB distinction (thanks Kevin Phair; RT 46660/45833) - Skip locale.t for BSD (thanks Zak B. Elep; RT 48481/46367) - In _get_self add UNIVERSAL::isa check on ref (thanks Jordan Macdonald) Changes for version 1.72 (May 5, 2009) ------------------------ - Use Makefile.PL based on suggestion in RT 38020 - Add 'use strict' & 'use warnings' - Add MAX_INT constant for detecting overflows - Add helper sub _get_multipliers for getting kilo/mega/giga mult values - Add test in round() for overflow from large of a precision value (RT 40126) - Add .5 + 1e-14 to rounded value instead of .5000001 (RT 20298) - Fix undef $pic_prefix (RT 43029) - Add support for giga and base option in unformat_number (RT 40455) - Fix Russian locale issues, esp. in unformat_number (RT 40859) - Remove variables from error messages (XSS risk) and standardize errors - Remove requirement that decimal_point & thousands_sep be 1 char (for ru_RU) - Add Russian and unformat_number tests in locale.t - Add compare_numbers to test with an allowable error of 1e-10 in round.t Changes for version 1.71 (May 3, 2009) ------------------------ - Changes to tests t/format_price.t, t/locale.t, and t/round.t to fix cpan tester errors - No change to Format.pm itself Changes for version 1.70 (Feb 13, 2009) ------------------------ - Add support for IEC60027 (Ki, Mi, Gi prefixes) with mode option - Use hard coded hex values for base multiplier when base is 1024 - Use mon_ settings in format_number when called from format_price Changes for version 1.63 (Feb 10, 2009) ------------------------ - Minor tweak to format_bytes test for German locales Changes for version 1.62 (Feb 9, 2009) ------------------------ - Change format_bytes to fully specify all formatting options, not rely on locale at all as it was causing too many CPAN tester errors. Changes for version 1.61 (Dec 29, 2008) ------------------------ - Fix bugs in locale operations for format_price (thanks Moritz Onken) - Fix documentation in format_bytes (rt # 42036) - Enable warning when format_bytes called with numeric precision not hash Changes for version 1.60 (Jul 2, 2008) ------------------------ - Rewrite new() and format_price() to use mon_* POSIX Locale values - Add all missing POSIX Locale variables (Thanks to Kevin Ryde for help identifying the problem) Changes for version 1.52 (Sep 21, 2006) ------------------------ - Patch to t/format_price.t supplied by jonasbn addressing failling tests in 1.51, tests 2-6, the regex formatting the currency code did not take 0 occurrences of white space into account Patch: rt #21382 Resolves: rt #18964 (The same issue/patch was also reported by Cosimo Streppone, Randy W. Sims, J. R. Taisto) Changes for version 1.51 (Apr 26, 2006) ------------------------ - Patch to t/format_price.t supplied by Cosimo Streppone to allow it to work with non-US locales Changes for version 1.5 (Feb 14, 2005) ------------------------ - Require Perl 5.8 - was 5.003 before - Require POSIX.pm - was optional before - If C is set to the empty string, format_number will not insert any separators. - Replace "use vars" with "our" - Support scientific notation - skip formatting - Change format_bytes to support options (precision, unit, and base) instead of precision number Changes for version 1.45 (Aug 8, 2002) ------------------------ - No code change; only change is to test suite. - Replace all tab characters with spaces Changes for version 1.44 (Dec 11, 2001) ------------------------ - Add support for GIGA_SUFFIX. Can't do TERA because of integer overflow. - Detect decimal part correctly in Perl 5.6 and up Changes for version 1.43 (Dec 10, 2001) ------------------------ - Fix bug in format_price that caused an extra space to be inserted in some situations, and no space in others, between the currency string and the number. - Add support for gigabytes (formerly only kilo and mega) to format_bytes. (Thanks to Oeyvind Flaam ) Changes for version 1.42 (May 17, 2000) ------------------------ - Fixed bug in format_picture that was causing subsequent calls to return the previous result and the current one concatenated together. This is actually due to a bug in Perl, but a workaround was implemented. To avoid this problem in your own code, don't use code like this: "my VARIABLE = EXPRESSION if CONDITION" because if the CONDITION is false, the previous value of VARIABLE will still be there, even if it had gone out of scope! This bug was pointed out by Buddy Burden on 21 Mar 1999, Frank Tobin on 11 Jun 1999, Mark William Rostron on 12 Dec 1999, and Ben Tilly on 16 May 2000. Fix suggested by Buddy Burden, Mark William Rostron, and Ben Tilly. - Fixed bug in round() that was causing e.g. round(1.005, 2) to return 1 instead of 1.01. This is due to the vagaries of floating point arithmetic. I changed .5 to .5000001 in the rounding formula and added a check for this in the test suite. That seems to fix it but please let me know if you experience any weird results. This bug was reported by Kentaro Takatomi on 25 May 1999. - Fixed several points in the code where 'use of uninitialized value' warnings were generated. Reported by Frank Tobin on 11 Jun 1999. - In format_picture, replaced the use of $_ with a locally scoped variable ($char). This should reduce interference between this routine and any use of $_ by the calling program. Bug report and suggested fix by Mark William Rostron on 29 Dec 1999. Changes for version 1.41 (Nov 30, 1998) ------------------------ - Fix 'undefined value' warnings in format_picture - Fix bug in format_picture to show decimal point if and only if it is present in the picture string (bug reported by Michael Scoltock ) - Fix bug in format_price that would suppress currency symbol if no decimal digits (bug reported by Michael Scoltock ) Changes for version 1.40 (Nov 27, 1998) ------------------------ - Add new function format_bytes() to display '1K' for '1024', etc. (suggested by Curt Tilmes ) - Fix bugs in round() and format_picture() when dealing with negative numbers. NOTE: format_picture() now includes at least one extra space in its output for positive numbers. This may present a minor incompatibility issue in some obscure cases. - Minor documentation updates. Changes for version 1.30 (Oct 31, 1998) ------------------------ - Fix several major bugs, including the POSIX-not-required issue, as well as better support for negative values. - Add setting for default size of decimal area so you don't have to specify the number of digits if it's other than 2. - Add setting and function to display negative numbers in different formats. - Add setting to force trailing 0's in the decimal portion to fill out the number of digits required. - Fix problem where 0's inside format_picture()'s output were being replaced with spaces. - Add 0 before decimal point if number is between -1 and 1. - Fix errors with supposedly-optional POSIX - From: Yair Lenga Suggested adding controls to pad out result of format_number with zeroes as well as the ability to present negative numbers with parentheses. Provided a patch which was useful in constructing a solution. - Add test for defined() from patch by IMAZU Hideyo - From: "Joseph Norton" Bugs in format_number(): processed negative numbers incorrectly, and lacked the zero before the decimal point if number is between 0 and 1. Changes for version 1.20 (Aug 31, 1998) ------------------------ - Make POSIX no longer required (users on MicroSoft systems sometimes don't have it); uses US defaults if no POSIX.pm found. - Add new optional third argument to format_number() to add trailing zeroes. Changes for version 1.12 ------------------------ - Remove 'use of undefined value' warnings when used with perl -w Changes for version 1.10 (Nov 21, 1997) ------------------------ - Add Locale support to set the default values for $THOUSANDS_SEP, $DECIMAL_SEP, and $CURRENCY based on the user's locale. - Add object oriented interface. - NOTE: Some aspects of the API have changed. Please reread the documentation carefully if you used 1.0 previously!!! Initial version 1.00 -------------------- - Limited release beta version. Number-Format-1.75/Format.pm000755 000765 000024 00000132624 12543062470 016015 0ustar00billstaff000000 000000 package Number::Format; # Minimum version is 5.10.0. May work on earlier versions, but not # supported on any version older than 5.10. Hack this line at your own risk: require 5.010; use strict; use warnings; =head1 NAME Number::Format - Perl extension for formatting numbers =head1 SYNOPSIS use Number::Format; my $x = new Number::Format %args; $formatted = $x->round($number, $precision); $formatted = $x->format_number($number, $precision, $trailing_zeroes); $formatted = $x->format_negative($number, $picture); $formatted = $x->format_picture($number, $picture); $formatted = $x->format_price($number, $precision, $symbol); $formatted = $x->format_bytes($number, $precision); $number = $x->unformat_number($formatted); use Number::Format qw(:subs); $formatted = round($number, $precision); $formatted = format_number($number, $precision, $trailing_zeroes); $formatted = format_negative($number, $picture); $formatted = format_picture($number, $picture); $formatted = format_price($number, $precision, $symbol); $formatted = format_bytes($number, $precision); $number = unformat_number($formatted); =head1 REQUIRES Perl, version 5.8 or higher. POSIX.pm to determine locale settings. Carp.pm is used for some error reporting. =head1 DESCRIPTION These functions provide an easy means of formatting numbers in a manner suitable for displaying to the user. There are two ways to use this package. One is to declare an object of type Number::Format, which you can think of as a formatting engine. The various functions defined here are provided as object methods. The constructor C can be used to set the parameters of the formatting engine. Valid parameters are: THOUSANDS_SEP - character inserted between groups of 3 digits DECIMAL_POINT - character separating integer and fractional parts MON_THOUSANDS_SEP - like THOUSANDS_SEP, but used for format_price MON_DECIMAL_POINT - like DECIMAL_POINT, but used for format_price INT_CURR_SYMBOL - character(s) denoting currency (see format_price()) DECIMAL_DIGITS - number of digits to the right of dec point (def 2) DECIMAL_FILL - boolean; whether to add zeroes to fill out decimal NEG_FORMAT - format to display negative numbers (def ``-x'') KILO_SUFFIX - suffix to add when format_bytes formats kilobytes (trad) MEGA_SUFFIX - " " " " " " megabytes (trad) GIGA_SUFFIX - " " " " " " gigabytes (trad) KIBI_SUFFIX - suffix to add when format_bytes formats kibibytes (iec) MEBI_SUFFIX - " " " " " " mebibytes (iec) GIBI_SUFFIX - " " " " " " gibibytes (iec) They may be specified in upper or lower case, with or without a leading hyphen ( - ). If C is set to the empty string, format_number will not insert any separators. The defaults for C, C, C, C, and C come from the POSIX locale information (see L). If your POSIX locale does not provide C and/or C fields, then the C and/or C values are used for those parameters. Formerly, POSIX was optional but this caused problems in some cases, so it is now required. If this causes you hardship, please contact the author of this package at (remove "SPAM" to get correct email address) for help. If any of the above parameters are not specified when you invoke C, then the values are taken from package global variables of the same name (e.g. C<$DECIMAL_POINT> is the default for the C parameter). If you use the C<:vars> keyword on your C line (see non-object-oriented example below) you will import those variables into your namesapce and can assign values as if they were your own local variables. The default values for all the parameters are: THOUSANDS_SEP = ',' DECIMAL_POINT = '.' MON_THOUSANDS_SEP = ',' MON_DECIMAL_POINT = '.' INT_CURR_SYMBOL = 'USD' DECIMAL_DIGITS = 2 DECIMAL_FILL = 0 NEG_FORMAT = '-x' KILO_SUFFIX = 'K' MEGA_SUFFIX = 'M' GIGA_SUFFIX = 'G' KIBI_SUFFIX = 'KiB' MEBI_SUFFIX = 'MiB' GIBI_SUFFIX = 'GiB' Note however that when you first call one of the functions in this module I using the object-oriented interface, further setting of those global variables will have no effect on non-OO calls. It is recommended that you use the object-oriented interface instead for fewer headaches and a cleaner design. The C and C values are not set by the Locale system, but are definable by the user. They affect the output of C. Setting C is like giving that value as the C<$precision> argument to that function. Setting C to a true value causes C to append zeroes to the right of the decimal digits until the length is the specified number of digits. C is only used by C and is a string containing the letter 'x', where that letter will be replaced by a positive representation of the number being passed to that function. C and C utilize this feature by calling C if the number was less than 0. C, C, and C are used by C when the value is over 1024, 1024*1024, or 1024*1024*1024, respectively. The default values are "K", "M", and "G". These apply in the default "traditional" mode only. Note: TERA or higher are not implemented because of integer overflows on 32-bit systems. C, C, and C are used by C when the value is over 1024, 1024*1024, or 1024*1024*1024, respectively. The default values are "KiB", "MiB", and "GiB". These apply in the "iso60027"" mode only. Note: TEBI or higher are not implemented because of integer overflows on 32-bit systems. The only restrictions on C and C are that they must not be digits and must not be identical. There are no restrictions on C. For example, a German user might include this in their code: use Number::Format; my $de = new Number::Format(-thousands_sep => '.', -decimal_point => ',', -int_curr_symbol => 'DEM'); my $formatted = $de->format_number($number); Or, if you prefer not to use the object oriented interface, you can do this instead: use Number::Format qw(:subs :vars); $THOUSANDS_SEP = '.'; $DECIMAL_POINT = ','; $INT_CURR_SYMBOL = 'DEM'; my $formatted = format_number($number); =head1 EXPORTS Nothing is exported by default. To export the functions or the global variables defined herein, specify the function name(s) on the import list of the C statement. To export all functions defined herein, use the special tag C<:subs>. To export the variables, use the special tag C<:vars>; to export both subs and vars you can use the tag C<:all>. =cut ###--------------------------------------------------------------------- use strict; use Exporter; use Carp; use POSIX qw(localeconv); use base qw(Exporter); our @EXPORT_SUBS = qw( format_number format_negative format_picture format_price format_bytes round unformat_number ); our @EXPORT_LC_NUMERIC = qw( $DECIMAL_POINT $THOUSANDS_SEP $GROUPING ); our @EXPORT_LC_MONETARY = qw( $INT_CURR_SYMBOL $CURRENCY_SYMBOL $MON_DECIMAL_POINT $MON_THOUSANDS_SEP $MON_GROUPING $POSITIVE_SIGN $NEGATIVE_SIGN $INT_FRAC_DIGITS $FRAC_DIGITS $P_CS_PRECEDES $P_SEP_BY_SPACE $N_CS_PRECEDES $N_SEP_BY_SPACE $P_SIGN_POSN $N_SIGN_POSN ); our @EXPORT_OTHER = qw( $DECIMAL_DIGITS $DECIMAL_FILL $NEG_FORMAT $KILO_SUFFIX $MEGA_SUFFIX $GIGA_SUFFIX $KIBI_SUFFIX $MEBI_SUFFIX $GIBI_SUFFIX ); our @EXPORT_VARS = ( @EXPORT_LC_NUMERIC, @EXPORT_LC_MONETARY, @EXPORT_OTHER ); our @EXPORT_ALL = ( @EXPORT_SUBS, @EXPORT_VARS ); our @EXPORT_OK = ( @EXPORT_ALL ); our %EXPORT_TAGS = ( subs => \@EXPORT_SUBS, vars => \@EXPORT_VARS, lc_numeric_vars => \@EXPORT_LC_NUMERIC, lc_monetary_vars => \@EXPORT_LC_MONETARY, other_vars => \@EXPORT_OTHER, all => \@EXPORT_ALL ); our $VERSION = '1.75'; # Refer to http://www.opengroup.org/onlinepubs/007908775/xbd/locale.html # for more details about the POSIX variables # Locale variables provided by POSIX for numbers (LC_NUMERIC) our $DECIMAL_POINT = '.'; # decimal point symbol for numbers our $THOUSANDS_SEP = ','; # thousands separator for numbers our $GROUPING = undef;# grouping rules for thousands (UNSUPPORTED) # Locale variables provided by POSIX for currency (LC_MONETARY) our $INT_CURR_SYMBOL = 'USD';# intl currency symbol our $CURRENCY_SYMBOL = '$'; # domestic currency symbol our $MON_DECIMAL_POINT = '.'; # decimal point symbol for monetary values our $MON_THOUSANDS_SEP = ','; # thousands separator for monetary values our $MON_GROUPING = undef;# like 'grouping' for monetary (UNSUPPORTED) our $POSITIVE_SIGN = ''; # string to add for non-negative monetary our $NEGATIVE_SIGN = '-'; # string to add for negative monetary our $INT_FRAC_DIGITS = 2; # digits to right of decimal for intl currency our $FRAC_DIGITS = 2; # digits to right of decimal for currency our $P_CS_PRECEDES = 1; # curr sym precedes(1) or follows(0) positive our $P_SEP_BY_SPACE = 1; # add space to positive; 0, 1, or 2 our $N_CS_PRECEDES = 1; # curr sym precedes(1) or follows(0) negative our $N_SEP_BY_SPACE = 1; # add space to negative; 0, 1, or 2 our $P_SIGN_POSN = 1; # sign rules for positive: 0-4 our $N_SIGN_POSN = 1; # sign rules for negative: 0-4 # The following are specific to Number::Format our $DECIMAL_DIGITS = 2; our $DECIMAL_FILL = 0; our $NEG_FORMAT = '-x'; our $KILO_SUFFIX = 'K'; our $MEGA_SUFFIX = 'M'; our $GIGA_SUFFIX = 'G'; our $KIBI_SUFFIX = 'KiB'; our $MEBI_SUFFIX = 'MiB'; our $GIBI_SUFFIX = 'GiB'; our $DEFAULT_LOCALE = { ( # LC_NUMERIC decimal_point => $DECIMAL_POINT, thousands_sep => $THOUSANDS_SEP, grouping => $GROUPING, # LC_MONETARY int_curr_symbol => $INT_CURR_SYMBOL, currency_symbol => $CURRENCY_SYMBOL, mon_decimal_point => $MON_DECIMAL_POINT, mon_thousands_sep => $MON_THOUSANDS_SEP, mon_grouping => $MON_GROUPING, positive_sign => $POSITIVE_SIGN, negative_sign => $NEGATIVE_SIGN, int_frac_digits => $INT_FRAC_DIGITS, frac_digits => $FRAC_DIGITS, p_cs_precedes => $P_CS_PRECEDES, p_sep_by_space => $P_SEP_BY_SPACE, n_cs_precedes => $N_CS_PRECEDES, n_sep_by_space => $N_SEP_BY_SPACE, p_sign_posn => $P_SIGN_POSN, n_sign_posn => $N_SIGN_POSN, # The following are specific to Number::Format decimal_digits => $DECIMAL_DIGITS, decimal_fill => $DECIMAL_FILL, neg_format => $NEG_FORMAT, kilo_suffix => $KILO_SUFFIX, mega_suffix => $MEGA_SUFFIX, giga_suffix => $GIGA_SUFFIX, kibi_suffix => $KIBI_SUFFIX, mebi_suffix => $MEBI_SUFFIX, gibi_suffix => $GIBI_SUFFIX, ) }; # # On Windows, the POSIX localeconv() call returns illegal negative # numbers for some values, seemingly attempting to indicate null. The # following list indicates the values for which this has been # observed, and for which the values should be stripped out of # localeconv(). # our @IGNORE_NEGATIVE = qw( frac_digits int_frac_digits n_cs_precedes n_sep_by_space n_sign_posn p_xs_precedes p_sep_by_space p_sign_posn ); # # Largest integer a 32-bit Perl can handle is based on the mantissa # size of a double float, which is up to 53 bits. While we may be # able to support larger values on 64-bit systems, some Perl integer # operations on 64-bit integer systems still use the 53-bit-mantissa # double floats. To be safe, we cap at 2**53; use Math::BigFloat # instead for larger numbers. # use constant MAX_INT => 2**53; ###--------------------------------------------------------------------- # INTERNAL FUNCTIONS # These functions (with names beginning with '_' are for internal use # only. There is no guarantee that they will remain the same from one # version to the next! ##---------------------------------------------------------------------- # _get_self creates an instance of Number::Format with the default # values for the configuration parameters, if the first element of # @_ is not already an object. my $DefaultObject; sub _get_self { # Not calling $_[0]->isa because that may result in unblessed # reference error unless (ref $_[0] && UNIVERSAL::isa($_[0], "Number::Format")) { $DefaultObject ||= new Number::Format(); unshift (@_, $DefaultObject); } @_; } ##---------------------------------------------------------------------- # _check_seps is used to validate that the thousands_sep, # decimal_point, mon_thousands_sep and mon_decimal_point variables # have acceptable values. For internal use only. sub _check_seps { my ($self) = @_; croak "Not an object" unless ref $self; foreach my $prefix ("", "mon_") { croak "${prefix}thousands_sep is undefined" unless defined $self->{"${prefix}thousands_sep"}; croak "${prefix}thousands_sep may not be numeric" if $self->{"${prefix}thousands_sep"} =~ /\d/; croak "${prefix}decimal_point may not be numeric" if $self->{"${prefix}decimal_point"} =~ /\d/; croak("${prefix}thousands_sep and ". "${prefix}decimal_point may not be equal") if $self->{"${prefix}decimal_point"} eq $self->{"${prefix}thousands_sep"}; } } ##---------------------------------------------------------------------- # _get_multipliers returns the multipliers to be used for kilo, mega, # and giga (un-)formatting. Used in format_bytes and unformat_number. # For internal use only. sub _get_multipliers { my($base) = @_; if (!defined($base) || $base == 1024) { return ( kilo => 0x00000400, mega => 0x00100000, giga => 0x40000000 ); } elsif ($base == 1000) { return ( kilo => 1_000, mega => 1_000_000, giga => 1_000_000_000 ); } else { croak "base overflow" if $base **3 > MAX_INT; croak "base must be a positive integer" unless $base > 0 && $base == int($base); return ( kilo => $base, mega => $base ** 2, giga => $base ** 3 ); } } ##---------------------------------------------------------------------- # _complain_undef displays a warning message on STDERR and is called # when a subroutine has been invoked with an undef value. A warning # message is printed if the calling environment has "uninitialized" # warnings enabled. sub _complain_undef { my @stack; my($sub, $bitmask) = (caller(1))[3,9]; my $offset = $warnings::Offsets{"uninitialized"}; carp "Use of uninitialized value in call to $sub" if vec($bitmask, $offset, 1); } ###--------------------------------------------------------------------- =head1 METHODS =over 4 =cut ##---------------------------------------------------------------------- =item new( %args ) Creates a new Number::Format object. Valid keys for %args are any of the parameters described above. Keys may be in all uppercase or all lowercase, and may optionally be preceded by a hyphen (-) character. Example: my $de = new Number::Format(-thousands_sep => '.', -decimal_point => ',', -int_curr_symbol => 'DEM'); =cut sub new { my $type = shift; my %args = @_; # Fetch defaults from current locale, or failing that, using globals my $me = {}; # my $locale = setlocale(LC_ALL, ""); my $locale_values = localeconv(); # Strip out illegal negative values from the current locale foreach ( @IGNORE_NEGATIVE ) { if (defined($locale_values->{$_}) && $locale_values->{$_} eq '-1') { delete $locale_values->{$_}; } } while(my($arg, $default) = each %$DEFAULT_LOCALE) { $me->{$arg} = (exists $locale_values->{$arg} ? $locale_values->{$arg} : $default); foreach ($arg, uc $arg, "-$arg", uc "-$arg") { next unless defined $args{$_}; $me->{$arg} = $args{$_}; delete $args{$_}; last; } } # # Some broken locales define the decimal_point but not the # thousands_sep. If decimal_point is set to "," the default # thousands_sep will be a conflict. In that case, set # thousands_sep to empty string. Suggested by Moritz Onken. # foreach my $prefix ("", "mon_") { $me->{"${prefix}thousands_sep"} = "" if ($me->{"${prefix}decimal_point"} eq $me->{"${prefix}thousands_sep"}); } croak "Invalid argument(s)" if %args; bless $me, $type; $me; } ##---------------------------------------------------------------------- =item round($number, $precision) Rounds the number to the specified precision. If C<$precision> is omitted, the value of the C parameter is used (default value 2). Both input and output are numeric (the function uses math operators rather than string manipulation to do its job), The value of C<$precision> may be any integer, positive or negative. Examples: round(3.14159) yields 3.14 round(3.14159, 4) yields 3.1416 round(42.00, 4) yields 42 round(1234, -2) yields 1200 Since this is a mathematical rather than string oriented function, there will be no trailing zeroes to the right of the decimal point, and the C and C variables are ignored. To format your number using the C and C variables, use C instead. =cut sub round { my ($self, $number, $precision) = _get_self @_; unless (defined($number)) { _complain_undef(); $number = 0; } $precision = $self->{decimal_digits} unless defined $precision; $precision = 2 unless defined $precision; croak("precision must be integer") unless int($precision) == $precision; if (ref($number) && $number->isa("Math::BigFloat")) { my $rounded = $number->copy(); $rounded->precision(-$precision); return $rounded; } my $sign = $number <=> 0; my $multiplier = (10 ** $precision); my $result = abs($number); my $product = $result * $multiplier; croak "round() overflow. Try smaller precision or use Math::BigFloat" if $product > MAX_INT; # We need to add 1e-14 to avoid some rounding errors due to the # way floating point numbers work - see string-eq test in t/round.t $result = int($product + .5 + 1e-14) / $multiplier; $result = -$result if $sign < 0; return $result; } ##---------------------------------------------------------------------- =item format_number($number, $precision, $trailing_zeroes) Formats a number by adding C between each set of 3 digits to the left of the decimal point, substituting C for the decimal point, and rounding to the specified precision using C. Note that C<$precision> is a I precision specifier; trailing zeroes will only appear in the output if C<$trailing_zeroes> is provided, or the parameter C is set, with a value that is true (not zero, undef, or the empty string). If C<$precision> is omitted, the value of the C parameter (default value of 2) is used. If the value is too large or great to work with as a regular number, but instead must be shown in scientific notation, returns that number in scientific notation without further formatting. Examples: format_number(12345.6789) yields '12,345.68' format_number(123456.789, 2) yields '123,456.79' format_number(1234567.89, 2) yields '1,234,567.89' format_number(1234567.8, 2) yields '1,234,567.8' format_number(1234567.8, 2, 1) yields '1,234,567.80' format_number(1.23456789, 6) yields '1.234568' format_number("0.000020000E+00", 7);' yields '2e-05' Of course the output would have your values of C and C instead of ',' and '.' respectively. =cut sub format_number { my ($self, $number, $precision, $trailing_zeroes, $mon) = _get_self @_; unless (defined($number)) { _complain_undef(); $number = 0; } $self->_check_seps(); # first make sure the SEP variables are valid my($thousands_sep, $decimal_point) = $mon ? @$self{qw(mon_thousands_sep mon_decimal_point)} : @$self{qw(thousands_sep decimal_point)}; # Set defaults and standardize number $precision = $self->{decimal_digits} unless defined $precision; $trailing_zeroes = $self->{decimal_fill} unless defined $trailing_zeroes; # Handle negative numbers my $sign = $number <=> 0; $number = abs($number) if $sign < 0; $number = $self->round($number, $precision); # round off $number # detect scientific notation my $exponent = 0; if ($number =~ /^(-?[\d.]+)e([+-]\d+)$/) { # Don't attempt to format numbers that require scientific notation. return $number; } # Split integer and decimal parts of the number and add commas my $integer = int($number); my $decimal; # Note: In perl 5.6 and up, string representation of a number # automagically includes the locale decimal point. This way we # will detect the decimal part correctly as long as the decimal # point is 1 character. $decimal = substr($number, length($integer)+1) if (length($integer) < length($number)); $decimal = '' unless defined $decimal; # Add trailing 0's if $trailing_zeroes is set. $decimal .= '0'x( $precision - length($decimal) ) if $trailing_zeroes && $precision > length($decimal); # Add the commas (or whatever is in thousands_sep). If # thousands_sep is the empty string, do nothing. if ($thousands_sep) { # Add leading 0's so length($integer) is divisible by 3 $integer = '0'x(3 - (length($integer) % 3)).$integer; # Split $integer into groups of 3 characters and insert commas $integer = join($thousands_sep, grep {$_ ne ''} split(/(...)/, $integer)); # Strip off leading zeroes and optional thousands separator $integer =~ s/^0+(?:\Q$thousands_sep\E)?//; } $integer = '0' if $integer eq ''; # Combine integer and decimal parts and return the result. my $result = ((defined $decimal && length $decimal) ? join($decimal_point, $integer, $decimal) : $integer); return ($sign < 0) ? $self->format_negative($result) : $result; } ##---------------------------------------------------------------------- =item format_negative($number, $picture) Formats a negative number. Picture should be a string that contains the letter C where the number should be inserted. For example, for standard negative numbers you might use ``C<-x>'', while for accounting purposes you might use ``C<(x)>''. If the specified number begins with a ``-'' character, that will be removed before formatting, but formatting will occur whether or not the number is negative. =cut sub format_negative { my($self, $number, $format) = _get_self @_; unless (defined($number)) { _complain_undef(); $number = 0; } $format = $self->{neg_format} unless defined $format; croak "Letter x must be present in picture in format_negative()" unless $format =~ /x/; $number =~ s/^-//; $format =~ s/x/$number/; return $format; } ##---------------------------------------------------------------------- =item format_picture($number, $picture) Returns a string based on C<$picture> with the C<#> characters replaced by digits from C<$number>. If the length of the integer part of $number is too large to fit, the C<#> characters are replaced with asterisks (C<*>) instead. Examples: format_picture(100.023, 'USD ##,###.##') yields 'USD 100.02' format_picture(1000.23, 'USD ##,###.##') yields 'USD 1,000.23' format_picture(10002.3, 'USD ##,###.##') yields 'USD 10,002.30' format_picture(100023, 'USD ##,###.##') yields 'USD **,***.**' format_picture(1.00023, 'USD #.###,###') yields 'USD 1.002,300' The comma (,) and period (.) you see in the picture examples should match the values of C and C, respectively, for proper operation. However, the C characters in C<$picture> need not occur every three digits; the I use of that variable by this function is to remove leading commas (see the first example above). There may not be more than one instance of C in C<$picture>. The value of C is used to determine how negative numbers are displayed. The result of this is that the output of this function my have unexpected spaces before and/or after the number. This is necessary so that positive and negative numbers are formatted into a space the same size. If you are only using positive numbers and want to avoid this problem, set NEG_FORMAT to "x". =cut sub format_picture { my ($self, $number, $picture) = _get_self @_; unless (defined($number)) { _complain_undef(); $number = 0; } croak "Picture not defined" unless defined($picture); $self->_check_seps(); # Handle negative numbers my($neg_prefix) = $self->{neg_format} =~ /^([^x]+)/; my($pic_prefix) = $picture =~ /^([^\#]+)/; my $neg_pic = $self->{neg_format}; (my $pos_pic = $self->{neg_format}) =~ s/[^x\s]/ /g; (my $pos_prefix = $neg_prefix) =~ s/[^x\s]/ /g; $neg_pic =~ s/x/$picture/; $pos_pic =~ s/x/$picture/; my $sign = $number <=> 0; $number = abs($number) if $sign < 0; $picture = $sign < 0 ? $neg_pic : $pos_pic; my $sign_prefix = $sign < 0 ? $neg_prefix : $pos_prefix; # Split up the picture and die if there is more than one $DECIMAL_POINT my($pic_int, $pic_dec, @cruft) = split(/\Q$self->{decimal_point}\E/, $picture); $pic_int = '' unless defined $pic_int; $pic_dec = '' unless defined $pic_dec; croak "Only one decimal separator permitted in picture" if @cruft; # Obtain precision from the length of the decimal part... my $precision = $pic_dec; # start with copying it $precision =~ s/[^\#]//g; # eliminate all non-# characters $precision = length $precision; # take the length of the result # Format the number $number = $self->round($number, $precision); # Obtain the length of the integer portion just like we did for $precision my $intsize = $pic_int; # start with copying it $intsize =~ s/[^\#]//g; # eliminate all non-# characters $intsize = length $intsize; # take the length of the result # Split up $number same as we did for $picture earlier my($num_int, $num_dec) = split(/\./, $number, 2); $num_int = '' unless defined $num_int; $num_dec = '' unless defined $num_dec; # Check if the integer part will fit in the picture if (length $num_int > $intsize) { $picture =~ s/\#/\*/g; # convert # to * and return it $pic_prefix = "" unless defined $pic_prefix; $picture =~ s/^(\Q$sign_prefix\E)(\Q$pic_prefix\E)(\s*)/$2$3$1/; return $picture; } # Split each portion of number and picture into arrays of characters my @num_int = split(//, $num_int); my @num_dec = split(//, $num_dec); my @pic_int = split(//, $pic_int); my @pic_dec = split(//, $pic_dec); # Now we copy those characters into @result. my @result; @result = ($self->{decimal_point}) if $picture =~ /\Q$self->{decimal_point}\E/; # For each characture in the decimal part of the picture, replace '#' # signs with digits from the number. my $char; foreach $char (@pic_dec) { $char = (shift(@num_dec) || 0) if ($char eq '#'); push (@result, $char); } # For each character in the integer part of the picture (moving right # to left this time), replace '#' signs with digits from the number, # or spaces if we've run out of numbers. while ($char = pop @pic_int) { $char = pop(@num_int) if ($char eq '#'); $char = ' ' if (!defined($char) || $char eq $self->{thousands_sep} && $#num_int < 0); unshift (@result, $char); } # Combine @result into a string and return it. my $result = join('', @result); $sign_prefix = '' unless defined $sign_prefix; $pic_prefix = '' unless defined $pic_prefix; $result =~ s/^(\Q$sign_prefix\E)(\Q$pic_prefix\E)(\s*)/$2$3$1/; $result; } ##---------------------------------------------------------------------- =item format_price($number, $precision, $symbol) Returns a string containing C<$number> formatted similarly to C, except that the decimal portion may have trailing zeroes added to make it be exactly C<$precision> characters long, and the currency string will be prefixed. The C<$symbol> attribute may be one of "INT_CURR_SYMBOL" or "CURRENCY_SYMBOL" (case insensitive) to use the value of that attribute of the object, or a string containing the symbol to be used. The default is "INT_CURR_SYMBOL" if this argument is undefined or not given; if set to the empty string, or if set to undef and the C attribute of the object is the empty string, no currency will be added. If C<$precision> is not provided, the default of 2 will be used. Examples: format_price(12.95) yields 'USD 12.95' format_price(12) yields 'USD 12.00' format_price(12, 3) yields '12.000' The third example assumes that C is the empty string. =cut sub format_price { my ($self, $number, $precision, $curr_symbol) = _get_self @_; unless (defined($number)) { _complain_undef(); $number = 0; } # Determine what the monetary symbol should be $curr_symbol = $self->{int_curr_symbol} if (!defined($curr_symbol) || lc($curr_symbol) eq "int_curr_symbol"); $curr_symbol = $self->{currency_symbol} if (!defined($curr_symbol) || lc($curr_symbol) eq "currency_symbol"); $curr_symbol = "" unless defined($curr_symbol); # Determine which value to use for frac digits my $frac_digits = ($curr_symbol eq $self->{int_curr_symbol} ? $self->{int_frac_digits} : $self->{frac_digits}); # Determine precision for decimal portion $precision = $frac_digits unless defined $precision; $precision = $self->{decimal_digits} unless defined $precision; # fallback $precision = 2 unless defined $precision; # default # Determine sign and absolute value my $sign = $number <=> 0; $number = abs($number) if $sign < 0; # format it first $number = $self->format_number($number, $precision, undef, 1); # Now we make sure the decimal part has enough zeroes my ($integer, $decimal) = split(/\Q$self->{mon_decimal_point}\E/, $number, 2); $decimal = '0'x$precision unless $decimal; $decimal .= '0'x($precision - length $decimal); # Extract positive or negative values my($sep_by_space, $cs_precedes, $sign_posn, $sign_symbol); if ($sign < 0) { $sep_by_space = $self->{n_sep_by_space}; $cs_precedes = $self->{n_cs_precedes}; $sign_posn = $self->{n_sign_posn}; $sign_symbol = $self->{negative_sign}; } else { $sep_by_space = $self->{p_sep_by_space}; $cs_precedes = $self->{p_cs_precedes}; $sign_posn = $self->{p_sign_posn}; $sign_symbol = $self->{positive_sign}; } # Combine it all back together. my $result = ($precision ? join($self->{mon_decimal_point}, $integer, $decimal) : $integer); # Determine where spaces go, if any my($sign_sep, $curr_sep); if ($sep_by_space == 0) { $sign_sep = $curr_sep = ""; } elsif ($sep_by_space == 1) { $sign_sep = ""; $curr_sep = " "; } elsif ($sep_by_space == 2) { $sign_sep = " "; $curr_sep = ""; } else { croak "Invalid sep_by_space value"; } # Add sign, if any if ($sign_posn >= 0 && $sign_posn <= 2) { # Combine with currency symbol and return if ($curr_symbol ne "") { if ($cs_precedes) { $result = $curr_symbol.$curr_sep.$result; } else { $result = $result.$curr_sep.$curr_symbol; } } if ($sign_posn == 0) { return "($result)"; } elsif ($sign_posn == 1) { return $sign_symbol.$sign_sep.$result; } else # $sign_posn == 2 { return $result.$sign_sep.$sign_symbol; } } elsif ($sign_posn == 3 || $sign_posn == 4) { if ($sign_posn == 3) { $curr_symbol = $sign_symbol.$sign_sep.$curr_symbol; } else # $sign_posn == 4 { $curr_symbol = $curr_symbol.$sign_sep.$sign_symbol; } # Combine with currency symbol and return if ($cs_precedes) { return $curr_symbol.$curr_sep.$result; } else { return $result.$curr_sep.$curr_symbol; } } else { croak "Invalid *_sign_posn value"; } } ##---------------------------------------------------------------------- =item format_bytes($number, %options) =item format_bytes($number, $precision) # deprecated Returns a string containing C<$number> formatted similarly to C, except that large numbers may be abbreviated by adding a suffix to indicate 1024, 1,048,576, or 1,073,741,824 bytes. Suffix may be the traditional K, M, or G (default); or the IEC standard 60027 "KiB," "MiB," or "GiB" depending on the "mode" option. Negative values will result in an error. The second parameter can be either a hash that sets options, or a number. Using a number here is deprecated and will generate a warning; early versions of Number::Format only allowed a numeric value. A future release of Number::Format will change this warning to an error. New code should use a hash instead to set options. If it is a number this sets the value of the "precision" option. Valid options are: =over 4 =item precision Set the precision for displaying numbers. If not provided, a default of 2 will be used. Examples: format_bytes(12.95) yields '12.95' format_bytes(12.95, precision => 0) yields '13' format_bytes(2048) yields '2K' format_bytes(2048, mode => "iec") yields '2KiB' format_bytes(9999999) yields '9.54M' format_bytes(9999999, precision => 1) yields '9.5M' =item unit Sets the default units used for the results. The default is to determine this automatically in order to minimize the length of the string. In other words, numbers greater than or equal to 1024 (or other number given by the 'base' option, q.v.) will be divided by 1024 and C<$KILO_SUFFIX> or C<$KIBI_SUFFIX> added; if greater than or equal to 1048576 (1024*1024), it will be divided by 1048576 and C<$MEGA_SUFFIX> or C<$MEBI_SUFFIX> appended to the end; etc. However if a value is given for C it will use that value instead. The first letter (case-insensitive) of the value given indicates the threshhold for conversion; acceptable values are G (for giga/gibi), M (for mega/mebi), K (for kilo/kibi), or A (for automatic, the default). For example: format_bytes(1048576, unit => 'K') yields '1,024K' instead of '1M' Note that the valid values to this option do not vary even when the suffix configuration variables have been changed. =item base Sets the number at which the C<$KILO_SUFFIX> is added. Default is 1024. Set to any value; the only other useful value is probably 1000, as hard disk manufacturers use that number to make their disks sound bigger than they really are. If the mode (see below) is set to "iec" or "iec60027" then setting the base option results in an error. =item mode Traditionally, bytes have been given in SI (metric) units such as "kilo" and "mega" even though they represent powers of 2 (1024, etc.) rather than powers of 10 (1000, etc.) This "binary prefix" causes much confusion in consumer products where "GB" may mean either 1,048,576 or 1,000,000, for example. The International Electrotechnical Commission has created standard IEC 60027 to introduce prefixes Ki, Mi, Gi, etc. ("kibibytes," "mebibytes," "gibibytes," etc.) to remove this confusion. Specify a mode option with either "traditional" or "iec60027" (or abbreviate as "trad" or "iec") to indicate which type of binary prefix you want format_bytes to use. For backward compatibility, "traditional" is the default. See http://en.wikipedia.org/wiki/Binary_prefix for more information. =back =cut sub format_bytes { my ($self, $number, @options) = _get_self @_; unless (defined($number)) { _complain_undef(); $number = 0; } croak "Negative number not allowed in format_bytes" if $number < 0; # If a single scalar is given instead of key/value pairs for # @options, treat that as the value of the precision option. my %options; if (@options == 1) { # To be changed to 'croak' in a future release: carp "format_bytes: number instead of options is deprecated"; %options = ( precision => $options[0] ); } else { %options = @options; } # Set default for precision. Test using defined because it may be 0. $options{precision} = $self->{decimal_digits} unless defined $options{precision}; $options{precision} = 2 unless defined $options{precision}; # default $options{mode} ||= "traditional"; my($ksuff, $msuff, $gsuff); if ($options{mode} =~ /^iec(60027)?$/i) { ($ksuff, $msuff, $gsuff) = @$self{qw(kibi_suffix mebi_suffix gibi_suffix)}; croak "base option not allowed in iec60027 mode" if exists $options{base}; } elsif ($options{mode} =~ /^trad(itional)?$/i) { ($ksuff, $msuff, $gsuff) = @$self{qw(kilo_suffix mega_suffix giga_suffix)}; } else { croak "Invalid mode"; } # Set default for "base" option. Calculate threshold values for # kilo, mega, and giga values. On 32-bit systems tera would cause # overflows so it is not supported. Useful values of "base" are # 1024 or 1000, but any number can be used. Larger numbers may # cause overflows for giga or even mega, however. my %mult = _get_multipliers($options{base}); # Process "unit" option. Set default, then take first character # and convert to upper case. $options{unit} = "auto" unless defined $options{unit}; my $unit = uc(substr($options{unit},0,1)); # Process "auto" first (default). Based on size of number, # automatically determine which unit to use. if ($unit eq 'A') { if ($number >= $mult{giga}) { $unit = 'G'; } elsif ($number >= $mult{mega}) { $unit = 'M'; } elsif ($number >= $mult{kilo}) { $unit = 'K'; } else { $unit = 'N'; } } # Based on unit, whether specified or determined above, divide the # number and determine what suffix to use. my $suffix = ""; if ($unit eq 'G') { $number /= $mult{giga}; $suffix = $gsuff; } elsif ($unit eq 'M') { $number /= $mult{mega}; $suffix = $msuff; } elsif ($unit eq 'K') { $number /= $mult{kilo}; $suffix = $ksuff; } elsif ($unit ne 'N') { croak "Invalid unit option"; } # Format the number and add the suffix. return $self->format_number($number, $options{precision}) . $suffix; } ##---------------------------------------------------------------------- =item unformat_number($formatted) Converts a string as returned by C, C, or C, and returns the corresponding value as a numeric scalar. Returns C if the number does not contain any digits. Examples: unformat_number('USD 12.95') yields 12.95 unformat_number('USD 12.00') yields 12 unformat_number('foobar') yields undef unformat_number('1234-567@.8') yields 1234567.8 The value of C is used to determine where to separate the integer and decimal portions of the input. All other non-digit characters, including but not limited to C and C, are removed. If the number matches the pattern of C I there is a ``-'' character before any of the digits, then a negative number is returned. If the number ends with the C, C, C, C, C, or C characters, then the number returned will be multiplied by the appropriate multiple of 1024 (or if the base option is given, by the multiple of that value) as appropriate. Examples: unformat_number("4K", base => 1024) yields 4096 unformat_number("4K", base => 1000) yields 4000 unformat_number("4KiB", base => 1024) yields 4096 unformat_number("4G") yields 4294967296 =cut sub unformat_number { my ($self, $formatted, %options) = _get_self @_; unless (defined($formatted)) { _complain_undef(); $formatted = ""; } $self->_check_seps(); return undef unless $formatted =~ /\d/; # require at least one digit # Regular expression for detecting decimal point my $pt = qr/\Q$self->{decimal_point}\E/; # ru_RU locale has comma for decimal_point, but period for # mon_decimal_point! But as long as thousands_sep is different # from either, we can allow either decimal point. if ($self->{mon_decimal_point} && $self->{decimal_point} ne $self->{mon_decimal_point} && $self->{decimal_point} ne $self->{mon_thousands_sep} && $self->{mon_decimal_point} ne $self->{thousands_sep}) { $pt = qr/(?:\Q$self->{decimal_point}\E| \Q$self->{mon_decimal_point}\E)/x; } # Detect if it ends with one of the kilo / mega / giga suffixes. my $kp = ($formatted =~ s/\s*($self->{kilo_suffix}|$self->{kibi_suffix})\s*$//); my $mp = ($formatted =~ s/\s*($self->{mega_suffix}|$self->{mebi_suffix})\s*$//); my $gp = ($formatted =~ s/\s*($self->{giga_suffix}|$self->{gibi_suffix})\s*$//); my %mult = _get_multipliers($options{base}); # Split number into integer and decimal parts my ($integer, $decimal, @cruft) = split($pt, $formatted); croak "Only one decimal separator permitted" if @cruft; # It's negative if the first non-digit character is a - my $sign = $formatted =~ /^\D*-/ ? -1 : 1; my($before_re, $after_re) = split /x/, $self->{neg_format}, 2; $sign = -1 if $formatted =~ /\Q$before_re\E(.+)\Q$after_re\E/; # Strip out all non-digits from integer and decimal parts $integer = '' unless defined $integer; $decimal = '' unless defined $decimal; $integer =~ s/\D//g; $decimal =~ s/\D//g; # Join back up, using period, and add 0 to make Perl think it's a number my $number = join('.', $integer, $decimal) + 0; $number = -$number if $sign < 0; # Scale the number if it ended in kilo or mega suffix. $number *= $mult{kilo} if $kp; $number *= $mult{mega} if $mp; $number *= $mult{giga} if $gp; return $number; } ###--------------------------------------------------------------------- =back =head1 CAVEATS Some systems, notably OpenBSD, may have incomplete locale support. Using this module together with L in OpenBSD may therefore not produce the intended results. =head1 BUGS No known bugs at this time. Report bugs using the CPAN request tracker at L or by email to the author. =head1 AUTHOR William R. Ward, SwPrAwM@cpan.org (remove "SPAM" before sending email, leaving only my initials) =head1 SEE ALSO perl(1). =cut 1; Number-Format-1.75/Makefile.PL000644 000765 000024 00000004005 12543056343 016167 0ustar00billstaff000000 000000 use 5.008; use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile1( NAME => 'Number::Format', VERSION_FROM => 'Format.pm', # finds $VERSION PREREQ_PM => { 'Carp' => 0, 'POSIX' => 0 }, TEST_REQUIRES => { 'Test::More' => 0, }, LICENSE => 'perl', META_MERGE => { resources => { repository => 'https://github.com/billward/number-format-perl.git', bugtracker => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Format', }, }, AUTHOR => 'William R. Ward ', ABSTRACT => 'Perl extension for formatting numbers', ); sub WriteMakefile1 { #Compatibility code for old versions of EU::MM. Written by Alexandr Ciornii, version 0.23. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{AUTHOR} and ref($params{AUTHOR}) eq 'ARRAY' and $eumm_version < 6.5705) { $params{META_ADD}->{author}=$params{AUTHOR}; $params{AUTHOR}=join(', ',@{$params{AUTHOR}}); } if ($params{TEST_REQUIRES} and $eumm_version < 6.64) { $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} }; delete $params{TEST_REQUIRES}; } if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; WriteMakefile(%params); } Number-Format-1.75/MANIFEST000644 000765 000024 00000000437 12543063433 015351 0ustar00billstaff000000 000000 CHANGES Format.pm MANIFEST META.yml Makefile.PL README TODO t/format_bytes.t t/format_negative.t t/format_number.t t/format_picture.t t/format_price.t t/locale.t t/object.t t/round.t t/unformat_number.t META.json Module JSON meta-data (added by MakeMaker) Number-Format-1.75/META.json000660 000765 000024 00000002222 12543063433 015631 0ustar00billstaff000000 000000 { "abstract" : "Perl extension for formatting numbers", "author" : [ "William R. Ward " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.120630", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Number-Format", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0", "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "POSIX" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Format" }, "repository" : { "url" : "https://github.com/billward/number-format-perl.git" } }, "version" : "1.75" } Number-Format-1.75/META.yml000660 000765 000024 00000001227 12543063433 015465 0ustar00billstaff000000 000000 --- abstract: 'Perl extension for formatting numbers' author: - 'William R. Ward ' build_requires: ExtUtils::MakeMaker: 0 Test::More: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.120630' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Number-Format no_index: directory: - t - inc requires: Carp: 0 POSIX: 0 resources: bugtracker: https://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Format repository: https://github.com/billward/number-format-perl.git version: 1.75 Number-Format-1.75/README000644 000765 000024 00000007364 11177367261 015116 0ustar00billstaff000000 000000 Number::Format - Convert numbers to strings with pretty formatting WHAT IS IT Number::Format is a library for formatting numbers. Functions are provided for converting numbers to strings in a variety of ways, and to convert strings that contain numbers back into numeric form. The output formats may include thousands separators - characters inserted between each group of three characters counting right to left from the decimal point. The characters used for the decimal point and the thousands separator come from the locale information or can be specified by the user. Also of note is the format_picture command which converts a number into a string using a "picture" string that you provide. This is similar to the PRINT USING statement that some versions of BASIC have. In addition, functions exist to generate strings for numbers containing currency (e.g. "USD 9.99", "DEM 20.00", etc.) or for rounding large values of bytes to the nearest giga/mega/kilo (e.g. "1.5M", "640K", etc.). ALSO AVAILABLE The following are also available as part of the number-format Sourceforge project: - Template Toolkit users: Use Template::Plugin::Number::Format (contributed by Darren Chamberlain) from your templates. - JavaScript users: we also have a JavaScript translation of the Number::Format done by Cees Hek. Find that in our CVS repository here: http://number-format.cvs.sourceforge.net/number-format/javascript HOW TO GET Download it from your favorite CPAN mirror, or from the Sourceforge project: http://sourceforge.net/projects/number-format/ If you are interested in being a developer for this project, or for more information, please contact William R. Ward, SwPrAwM@cpan.org (remove "SPAM" before sending email, leaving only my initials). BUILDING/INSTALLING Perl version 5.8 or higher is required, though it may work on older versions if you edit the 'require 5.008' line. This package is set up to configure and build like a typical Perl extension. To build: perl Makefile.PL make make test make install NOTE: This installs the files in your core Perl module area, typically /usr/local/lib/perl on Unix/Linux and C:\PERL\LIB on Windows, so you may need super-user (root/administrator) access to install. If you wish to install in a private area, such as your home directory, specify that as "perl Makefile.PL PREFIX=/path/to/private/area" and it will be installed there instead. PROBLEMS/BUG REPORTS Please submit your issues via the CPAN RT bug tracker or the Sourceforge bug system: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Format http://sourceforge.net/tracker/?group_id=175334 Please check for existing bug reports on your issue in both places before filing a new bug. MAILING LIST We have an electronic mailing list for announcements of new releases of this module. If you wish to join this list, visit this URL: http://lists.sourceforge.net/mailman/listinfo/number-format-announce We also have a mailing list for developers which you may join if you are interested in contributing to the project: https://lists.sourceforge.net/lists/listinfo/number-format-developers We do not yet have any list for users of the module; if you would like one, let us know and we will look into it. There are also forums available on the SourceForge site: http://sourceforge.net/forum/?group_id=175334 CREDITS AND LICENSES This package is copyright 1997-2008 by William R. Ward et al., and may be distributed under the same terms as cover Perl itself (your choice of Artistic or GPL). See http://dev.perl.org/licenses/ for more information. CHANGES See the file "CHANGES" for a description of the changes with each version of Number::Format. You can also browse the CVS history on SourceForge for full details. Number-Format-1.75/t/000750 000765 000024 00000000000 12543063433 014452 5ustar00billstaff000000 000000 Number-Format-1.75/TODO000644 000765 000024 00000000447 11033012010 014663 0ustar00billstaff000000 000000 The contents of this file have been moved to the SourceForge tracker: http://sourceforge.net/tracker/?group_id=175334&atid=872819 Please use SourceForge to track any bugs or new features from now on. The CPAN RT tracker can also be used: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Format Number-Format-1.75/t/format_bytes.t000755 000765 000024 00000003311 12543056343 017345 0ustar00billstaff000000 000000 # -*- CPerl -*- use Test::More qw(no_plan); use strict; use warnings; use POSIX; setlocale(&LC_ALL, 'C'); BEGIN { use_ok('Number::Format', ':subs') } is(format_bytes(123.51), '123.51', 'no change'); is(format_bytes(1234567.509), '1.18M', 'mega'); is(format_bytes(1234.51, precision => 3), '1.206K', 'kilo'); is(format_bytes(123456789.1), '117.74M', 'bigger mega'); is(format_bytes(1234567890.1), '1.15G', 'giga'); is(format_bytes(12.95), '12.95', 'test 12.95'); is(format_bytes(12.95, precision => 0), '13', 'test 13 (precision 0)'); is(format_bytes(2048), '2K', 'test 2K'); is(format_bytes(9999999), '9.54M', 'test 9.54M'); is(format_bytes(9999999, precision => 1), '9.5M', 'test 9.5M, (precision 1)'); # Test for unit option is(format_bytes(1048576, unit => 'K'), '1,024K', 'test 1,024K, unit K'); # Tests for iec60027 mode is(format_bytes(123.51, mode => "iec"), '123.51', 'no change iec'); is(format_bytes(1234567.509, mode => "iec"), '1.18MiB', 'mebi'); is(format_bytes(1234.51, mode => "iec", precision => 3), '1.206KiB', 'kibi'); is(format_bytes(123456789.1, mode => "iec"), '117.74MiB', 'bigger mebi'); is(format_bytes(1234567890.1, mode => "iec"), '1.15GiB', 'gibi'); is(format_bytes(1048576, mode => "iec", unit => 'K'), '1,024KiB', 'iec unit'); { my @warnings; local $SIG{__WARN__} = sub { @warnings = @_ }; is(format_bytes(undef), "0"); my $file = __FILE__; like("@warnings", qr{Use of uninitialized value in call to Number::Format::format_bytes at \Q$file\E line \d+[.]?\n}); } Number-Format-1.75/t/format_negative.t000755 000765 000024 00000001711 12543056343 020023 0ustar00billstaff000000 000000 # -*- CPerl -*- use Test::More qw(no_plan); use strict; use warnings; use POSIX; setlocale(&LC_ALL, 'C'); BEGIN { use_ok('Number::Format') } my $x = Number::Format->new; $x->{neg_format}='-x'; is($x->format_negative(123456.51), '-123456.51', 'negative'); is($x->format_number(-.509), '-0.51', 'neg round'); $x->{decimal_digits}=5; is($x->format_negative(.5555), '-0.5555', 'neg no fill'); $x->{decimal_fill}=1; is($x->format_number(-.5555), '-0.55550', 'neg fill'); $x->{neg_format}='(x)'; is($x->format_number(-1), '(1.00000)', 'neg paren'); is($x->format_number(-.5), '(0.50000)', 'neg paren zero'); { my @warnings; local $SIG{__WARN__} = sub { @warnings = @_ }; is($x->format_negative(undef), "(0)"); my $file = __FILE__; like("@warnings", qr{Use of uninitialized value in call to Number::Format::format_negative at \Q$file\E line \d+[.]?\n}); } Number-Format-1.75/t/format_number.t000755 000765 000024 00000003335 12543056343 017515 0ustar00billstaff000000 000000 # -*- CPerl -*- use Test::More qw(no_plan); use strict; use warnings; use POSIX; setlocale(&LC_ALL, 'C'); BEGIN { use_ok('Number::Format', ':subs') } is(format_number(123456.51), '123,456.51', 'thousands'); is(format_number(1234567.509, 2), '1,234,567.51', 'rounding'); is(format_number(12345678.5, 2), '12,345,678.5', 'one digit'); is(format_number(123456789.51, 2), '123,456,789.51', 'hundreds of millions'); is(format_number(1.23456789, 6), '1.234568', 'six digit rounding'); is(format_number('1.2300', 7, 1), '1.2300000', 'extra zeroes'); is(format_number(.23, 7, 1), '0.2300000', 'leading zero'); is(format_number(-100, 7, 1), '-100.0000000', 'negative with zeros'); # # https://rt.cpan.org/Ticket/Display.html?id=40126 # The test should fail because 20 digits is too big to correctly store # in a scalar variable without using Math::BigFloat. # eval { format_number(97, 20) }; like($@, qr/^\Qround() overflow. Try smaller precision or use Math::BigFloat/, "round overflow"); # # https://rt.cpan.org/Ticket/Display.html?id=48038 # Test with warnings enabled - expect a warning when called with undef # { my @warnings; local $SIG{__WARN__} = sub { @warnings = @_ }; is(format_number(undef), "0"); my $file = __FILE__; like("@warnings", qr{Use of uninitialized value in call to Number::Format::format_number at \Q$file\E line \d+[.]?\n}); } # # https://rt.cpan.org/Ticket/Display.html?id=48038 # Test again with warnings disabled to see if we do NOT get the warning # { no warnings "uninitialized"; my @warnings; local $SIG{__WARN__} = sub { @warnings = @_ }; is(format_number(undef), "0"); my $file = __FILE__; is("@warnings", ""); } Number-Format-1.75/t/format_picture.t000755 000765 000024 00000002634 12543056343 017701 0ustar00billstaff000000 000000 # -*- CPerl -*- use Test::More qw(no_plan); use strict; use warnings; use POSIX; setlocale(&LC_ALL, 'C'); BEGIN { use_ok('Number::Format') } my $pic = 'US$##,###,###.##'; my $x = Number::Format->new; $x->{neg_format} = '-x'; is($x->format_picture(123456.512, $pic), 'US$ 123,456.51', 'thou'); is($x->format_picture(-1234567.509, $pic), 'US$ -1,234,567.51', 'neg'); is($x->format_picture(12345678.5, $pic), 'US$ 12,345,678.50', 'zero'); is($x->format_picture(123456789.51, $pic), 'US$ **,***,***.**', 'pos over'); is($x->format_picture(-123456789.51, $pic), 'US$-**,***,***.**', 'neg over'); is($x->format_picture(1023012.34, $pic), 'US$ 1,023,012.34', 'million'); is($x->format_picture(120450.789012, $pic), 'US$ 120,450.79', 'pos rnd'); is($x->format_picture(-120450.789012, $pic),'US$ -120,450.79', 'neg rnd'); $x->{neg_format} = '(x)'; is($x->format_picture(120450.789012, $pic), 'US$ 120,450.79 ', 'pos paren'); is($x->format_picture(-120450.789012, $pic),'US$ (120,450.79)', 'neg paren'); $pic = '#'; is($x->format_picture(1, $pic), ' 1 ', 'one digit 1'); is($x->format_picture(2, $pic), ' 2 ', 'one digit 2'); { my @warnings; local $SIG{__WARN__} = sub { @warnings = @_ }; is($x->format_picture(undef, $pic), " 0 "); my $file = __FILE__; like("@warnings", qr{Use of uninitialized value in call to Number::Format::format_picture at \Q$file\E line \d+[.]?\n}); } Number-Format-1.75/t/format_price.t000755 000765 000024 00000015527 12543056343 017335 0ustar00billstaff000000 000000 # -*- CPerl -*- use Test::More qw(no_plan); use strict; use warnings; use POSIX; setlocale(&LC_ALL, 'C'); BEGIN { use_ok('Number::Format') } my $usd = Number::Format->new( -int_curr_symbol => 'USD', -currency_symbol => '$', -decimal_point => '.', -frac_digits => 2, -int_frac_digits => 2, -n_cs_precedes => 1, -n_sep_by_space => 1, -n_sign_posn => 1, -negative_sign => '-', -p_cs_precedes => 1, -p_sep_by_space => 1, -p_sign_posn => 1, -positive_sign => '', -thousands_sep => ',', -mon_thousands_sep => ',', -decimal_fill => 1, -decimal_digits => 2, -mon_decimal_point => '.', ); is($usd->format_price(123456.51), 'USD 123,456.51', 'thou'); is($usd->format_price(1234567.509), 'USD 1,234,567.51', 'mill'); is($usd->format_price(1234.51, 3), 'USD 1,234.510', 'three dec'); is($usd->format_price(123456789.1), 'USD 123,456,789.10', 'zero in dec'); is($usd->format_price(100, '0'), 'USD 100', 'no dec'); $usd->{p_cs_precedes} = 1; $usd->{p_sep_by_space} = 0; $usd->{n_cs_precedes} = 1; $usd->{n_sep_by_space} = 0; $usd->{p_sign_posn} = 1; $usd->{n_sign_posn} = 1; is($usd->format_price(19.95, undef, 'currency_symbol'), '$19.95', 'domestic'); $usd->{int_frac_digits} = 4; $usd->{frac_digits} = 3; is($usd->format_price(19.95, undef, 'currency_symbol'), '$19.950', 'frac_digits'); is($usd->format_price(19.95), 'USD19.9500', 'int frac digits'); $usd->{n_sign_posn} = 0; is($usd->format_price(-9.95), '(USD9.9500)', 'n_sign_posn=0'); $usd->{n_sign_posn} = 1; is($usd->format_price(-9.95), '-USD9.9500', 'n_sign_posn=1'); $usd->{n_sign_posn} = 2; is($usd->format_price(-9.95), 'USD9.9500-', 'n_sign_posn=2'); $usd->{n_sign_posn} = 3; is($usd->format_price(-9.95), '-USD9.9500', 'n_sign_posn=3'); $usd->{n_sign_posn} = 4; is($usd->format_price(-9.95), 'USD-9.9500', 'n_sign_posn=4'); $usd->{n_cs_precedes} = 1; $usd->{n_sign_posn} = 3; $usd->{n_sep_by_space} = 0; is($usd->format_price(-9.95), '-USD9.9500', 'cs_precedes=1,sep_by_space=0'); $usd->{n_sep_by_space} = 1; is($usd->format_price(-9.95), '-USD 9.9500', 'cs_precedes=1,sep_by_space=1'); $usd->{n_sep_by_space} = 2; is($usd->format_price(-9.95), '- USD9.9500', 'cs_precedes=1,sep_by_space=2'); $usd->{n_cs_precedes} = 0; $usd->{n_sign_posn} = 3; $usd->{n_sep_by_space} = 0; is($usd->format_price(-9.95), '9.9500-USD', 'cs_precedes=0,sep_by_space=0'); $usd->{n_sep_by_space} = 1; is($usd->format_price(-9.95), '9.9500 -USD', 'cs_precedes=0,sep_by_space=1'); $usd->{n_sep_by_space} = 2; is($usd->format_price(-9.95), '9.9500- USD', 'cs_precedes=0,sep_by_space=2'); my %results = ('sep=0 posn=0 prec=0' => '(9.9500USD)', 'sep=0 posn=0 prec=1' => '(USD9.9500)', 'sep=0 posn=1 prec=0' => '-9.9500USD', 'sep=0 posn=1 prec=1' => '-USD9.9500', 'sep=0 posn=2 prec=0' => '9.9500USD-', 'sep=0 posn=2 prec=1' => 'USD9.9500-', 'sep=0 posn=3 prec=0' => '9.9500-USD', 'sep=0 posn=3 prec=1' => '-USD9.9500', 'sep=0 posn=4 prec=0' => '9.9500USD-', 'sep=0 posn=4 prec=1' => 'USD-9.9500', 'sep=1 posn=0 prec=0' => '(9.9500 USD)', 'sep=1 posn=0 prec=1' => '(USD 9.9500)', 'sep=1 posn=1 prec=0' => '-9.9500 USD', 'sep=1 posn=1 prec=1' => '-USD 9.9500', 'sep=1 posn=2 prec=0' => '9.9500 USD-', 'sep=1 posn=2 prec=1' => 'USD 9.9500-', 'sep=1 posn=3 prec=0' => '9.9500 -USD', 'sep=1 posn=3 prec=1' => '-USD 9.9500', 'sep=1 posn=4 prec=0' => '9.9500 USD-', 'sep=1 posn=4 prec=1' => 'USD- 9.9500', 'sep=2 posn=0 prec=0' => '(9.9500USD)', 'sep=2 posn=0 prec=1' => '(USD9.9500)', 'sep=2 posn=1 prec=0' => '- 9.9500USD', 'sep=2 posn=1 prec=1' => '- USD9.9500', 'sep=2 posn=2 prec=0' => '9.9500USD -', 'sep=2 posn=2 prec=1' => 'USD9.9500 -', 'sep=2 posn=3 prec=0' => '9.9500- USD', 'sep=2 posn=3 prec=1' => '- USD9.9500', 'sep=2 posn=4 prec=0' => '9.9500USD -', 'sep=2 posn=4 prec=1' => 'USD -9.9500' ); foreach my $sep (0..2) { foreach my $posn (0..4) { foreach my $prec (0..1) { my $key = "sep=$sep posn=$posn prec=$prec"; my $want = $results{$key}; $usd->{n_cs_precedes} = $prec; $usd->{n_sign_posn} = $posn; $usd->{n_sep_by_space} = $sep; is($usd->format_price(-9.95), $want, "$key -> $want"); } } } my %prices = ( 1234 => "EUR 1.234,00", 56 => "EUR 56,00", 75.2345 => "EUR 75,23", 12578.5 => "EUR 12.578,50" ); my $nf = Number::Format->new( -int_curr_symbol => 'EUR', -currency_symbol => '$', -decimal_point => ',', -frac_digits => 2, -int_frac_digits => 2, -n_cs_precedes => 1, -n_sep_by_space => 1, -n_sign_posn => 1, -negative_sign => '-', -p_cs_precedes => 1, -p_sep_by_space => 1, -p_sign_posn => 1, -positive_sign => '', -thousands_sep => '.', -mon_thousands_sep => '.', -decimal_fill => 1, -decimal_digits => 2, -mon_decimal_point => ',', ); for my $price ( sort keys %prices ) { my $want = $prices{$price}; is($nf->format_price($price, 2), $want, "$price -> $want"); } { my @warnings; local $SIG{__WARN__} = sub { @warnings = @_ }; is($nf->format_price(undef), "EUR 0,00"); my $file = __FILE__; like("@warnings", qr{Use of uninitialized value in call to Number::Format::format_price at \Q$file\E line \d+[.]?\n}); } Number-Format-1.75/t/locale.t000755 000765 000024 00000005376 12543056343 016123 0ustar00billstaff000000 000000 # -*- CPerl -*- use Test::More; use strict; use warnings; BEGIN { # Do not test when under OpenBSD; see # http://www.in-ulm.de/~mascheck/locale/ and # http://undeadly.org/cgi?action=article&sid=20030206041352 plan skip_all => 'OpenBSD C library lacks locale support' if $^O =~ /^(openbsd|dragonfly)$/; plan 'no_plan'; } BEGIN { use_ok('Number::Format') } BEGIN { use_ok('POSIX') } SKIP: { setlocale(&LC_ALL, 'de_DE') or setlocale(&LC_ALL, 'de_DE.utf8') or setlocale(&LC_ALL, 'de_DE.ISO8859-1') or skip("Unable to set de_DE locale", 1); my $german = Number::Format->new(); # On some sysetms (notably Mac OS X) the locale data is wrong for de_DE. # Force it to match what we would see on Linux so the test passes. $german->{n_cs_precedes} = $german->{p_cs_precedes} = '0'; $german->{n_sep_by_space} = $german->{p_sep_by_space} = '1'; $german->{thousands_sep} = '.'; $german->{decimal_point} = ','; my $curr = $german->{int_curr_symbol}; # may be EUR or DEM my $num = "123.456,79"; is($german->format_price(123456.789), "$num $curr", "euros"); is($german->unformat_number($num), 123456.79, "unformat German"); } SKIP: { setlocale(&LC_ALL, 'ru_RU') or setlocale(&LC_ALL, 'ru_RU.utf8') or setlocale(&LC_ALL, 'ru_RU.ISO8859-5') or skip("Unable to set ru_RU locale", 1); my $russian = Number::Format->new(); # On some sysetms (notably Cygwin) the locale data is wrong for ru_RU. # Force it to match what we would see on Linux so the test passes. $russian->{n_sep_by_space} = $russian->{p_sep_by_space} = '1'; my $sep = $russian->{mon_thousands_sep}; my $dec = $russian->{mon_decimal_point}; my $num = "123${sep}456${dec}79"; like($russian->format_price(123456.789), qr/^$num RU[RB] $/, "rubles"); is($russian->unformat_number("$num RUB "), 123456.79, "unformat rubles"); is($russian->unformat_number($num), 123456.79, "unformat Russian 1"); $num = "123${sep}456$russian->{decimal_point}79"; is($russian->unformat_number($num), 123456.79, "unformat Russian 2"); } my $num = "123,456.79"; SKIP: { setlocale(&LC_ALL, 'en_US') or setlocale(&LC_ALL, 'en_US.utf8') or setlocale(&LC_ALL, 'en_US.ISO8859-1') or skip("Unable to set en_US locale", 1); my $english = Number::Format->new(); is($english->format_price(123456.789), "USD $num", "USD"); is($english->unformat_number($num), 123456.79, "unformat English"); } setlocale(&LC_ALL, "C") or skip("Unable to set en_US locale", 1); my $c = Number::Format->new(); is($c->format_price(123456.789, 2, "currency_symbol"), "\$ $num", "Dollar sign"); is($c->unformat_number($num), 123456.79, "unformat C"); Number-Format-1.75/t/object.t000644 000765 000024 00000001372 12543056343 016117 0ustar00billstaff000000 000000 # -*- CPerl -*- use Test::More qw(no_plan); use strict; use warnings; use POSIX; setlocale(&LC_ALL, 'C'); BEGIN { use_ok('Number::Format') } my $deutsch = Number::Format->new(-thousands_sep => '.', -decimal_point => ','); isa_ok($deutsch, 'Number::Format', 'object'); is($deutsch->format_number(1234567.509, 2), '1.234.567,51', 'round'); is($deutsch->format_number(12345678.5, 2), '12.345.678,5', 'tousends'); is($deutsch->format_number(1.23456789, 6), '1,234568', 'big frac'); my $double_char = Number::Format->new( -thousands_sep => ' ', -decimal_point => ',', ); is( $double_char->format_number(12345678.5), "12 345 678,5", 'multi-char thousands separator' ); Number-Format-1.75/t/round.t000755 000765 000024 00000003462 12543056343 016005 0ustar00billstaff000000 000000 # -*- CPerl -*- use Test::More qw(no_plan); use strict; use warnings; use POSIX; setlocale(&LC_ALL, 'C'); BEGIN { use_ok('Number::Format', ':subs') } use constant PI => 4*atan2(1,1); ok(compare_numbers(round(0), 0), 'identity 0'); ok(compare_numbers(round(1), 1), 'identity 1'); ok(compare_numbers(round(-1), -1), 'identity -1'); ok(compare_numbers(round(PI,2), 3.14), 'pi prec=2'); ok(compare_numbers(round(PI,3), 3.142), 'pi prec=3'); ok(compare_numbers(round(PI,4), 3.1416), 'pi prec=4'); ok(compare_numbers(round(PI,5), 3.14159), 'pi prec=5'); ok(compare_numbers(round(PI,6), 3.141593), 'pi prec=6'); ok(compare_numbers(round(PI,7), 3.1415927), 'pi prec=7'); ok(compare_numbers(round(123456.512), 123456.51), 'precision=0' ); ok(compare_numbers(round(-1234567.509, 2), -1234567.51), 'negative thous' ); ok(compare_numbers(round(-12345678.5, 2), -12345678.5), 'negative tenths' ); ok(compare_numbers(round(-123456.78951, 4), -123456.7895), 'precision=4' ); ok(compare_numbers(round(123456.78951, -2), 123500), 'precision=-2' ); # Without the 1e-10 "epsilon" value in round(), the floating point # number math will result in 1 rather than 1.01 for this test. is(round(1.005, 2), 1.01, 'string-eq' ); # Compare numbers within an epsilon value to avoid false negative # results due to floating point math sub compare_numbers { my($p, $q) = @_; return abs($p - $q) < 1e-10; } { my @warnings; local $SIG{__WARN__} = sub { @warnings = @_ }; is(round(undef), "0"); my $file = __FILE__; like("@warnings", qr{Use of uninitialized value in call to Number::Format::round at \Q$file\E line \d+[.]?\n}); } Number-Format-1.75/t/unformat_number.t000755 000765 000024 00000003527 12543056343 020063 0ustar00billstaff000000 000000 # -*- CPerl -*- use Test::More qw(no_plan); use strict; use warnings; use POSIX; setlocale(&LC_ALL, 'C'); BEGIN { use_ok('Number::Format', ':subs') } cmp_ok(unformat_number('123,456.51'), '==', 123456.51, 'num'); cmp_ok(unformat_number('US$ 12,345,678.51'), '==', 12345678.51, 'curr'); ok(! defined unformat_number('US$###,###,###.##'), 'overflow picture'); cmp_ok(unformat_number('-123,456,789.51'), '==', -123456789.51,'neg'); cmp_ok(unformat_number('1.5K'), '==', 1536, 'kilo'); cmp_ok(unformat_number('1.3M'), '==', 1363148.8, 'mega'); my $x = Number::Format->new; $x->{neg_format} = '(x)'; cmp_ok($x->unformat_number('(123,456,789.51)'), '==', -123456789.51,'neg paren'); cmp_ok(unformat_number('(123,456,789.51)'), '==', 123456789.51,'neg default'); cmp_ok(unformat_number("4K", base => 1024), '==', 4096, '4x1024'); cmp_ok(unformat_number("4K", base => 1000), '==', 4000, '4x1000'); cmp_ok(unformat_number("4KiB", base => 1024), '==', 4096, '4x1024 KiB'); cmp_ok(unformat_number("4KiB", base => 1000), '==', 4000, '4x1000 KiB'); cmp_ok(unformat_number("4G"), '==', 4294967296, '4G'); cmp_ok(unformat_number("4G", base => 1), '==', 4, 'base 1'); eval { unformat_number("4G", base => 1000000) }; like($@, qr/^\Qbase overflow/, "base overflow"); eval { unformat_number("4G", base => 0) }; like($@, qr/^\Qbase must be a positive integer/, "base 0"); eval { unformat_number("4G", base => .5) }; like($@, qr/^\Qbase must be a positive integer/, "base .5"); eval { unformat_number("4G", base => -1) }; like($@, qr/^\Qbase must be a positive integer/, "base neg"); { my @warnings; local $SIG{__WARN__} = sub { @warnings = @_ }; is(unformat_number(undef), undef); my $file = __FILE__; like("@warnings", qr{Use of uninitialized value in call to Number::Format::unformat_number at \Q$file\E line \d+[.]?\n}); }