format.pm

Astercon2 开源软交换 2.2.0

    $me->{decimal_point}     ||= $me->{mon_decimal_point};

    # Override if given as arguments
    foreach $arg (qw(thousands_sep decimal_point mon_thousands_sep
                     mon_decimal_point int_curr_symbol decimal_digits
                     decimal_fill neg_format kilo_suffix mega_suffix
                     giga_suffix))
    {
        foreach ($arg, uc $arg, "-$arg", uc "-$arg")
        {
            next unless defined $args{$_};
            $me->{$arg} = $args{$_};
            delete $args{$_};
            last;
        }
    }
    croak "Invalid args: ".join(',', keys %args)."\n" 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<DECIMAL_DIGITS> 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<DECIMAL_POINT> and C<THOUSANDS_SEP> variables are ignored.
To format your number using the C<DECIMAL_POINT> and C<THOUSANDS_SEP>
variables, use C<format_number()> instead.

=cut

sub round
{
    my ($self, $number, $precision) = _get_self @_;
    $precision = $self->{decimal_digits} unless defined $precision;
    $precision = 2 unless defined $precision;
    $number    = 0 unless defined $number;

    my $sign = $number <=> 0;
    my $multiplier = (10 ** $precision);
    my $result = abs($number);
    $result = int(($result * $multiplier) + .5000001) / $multiplier;
    $result = -$result if $sign < 0;
    return $result;
}

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

=item format_number($number, $precision, $trailing_zeroes)

Formats a number by adding C<THOUSANDS_SEP> between each set of 3
digits to the left of the decimal point, substituting C<DECIMAL_POINT>
for the decimal point, and rounding to the specified precision using
C<round()>.  Note that C<$precision> is a I<maximum> precision
specifier; trailing zeroes will only appear in the output if
C<$trailing_zeroes> is provided, or the parameter C<DECIMAL_FILL> 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<DECIMAL_DIGITS>
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<THOUSANDS_SEP> and
C<DECIMAL_POINT> instead of ',' and '.' respectively.

=cut

sub format_number
{
    my ($self, $number, $precision, $trailing_zeroes) = _get_self @_;
    $self->_check_seps();       # first make sure the SEP variables are valid

    # 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 ($self->{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($self->{thousands_sep},
                        grep {$_ ne ''} split(/(...)/, $integer));

        # Strip off leading zeroes and/or comma
        $integer =~ s/^0+\Q$self->{thousands_sep}\E?//;
    }
    $integer = '0' if $integer eq '';

    # Combine integer and decimal parts and return the result.
    my $result = ((defined $decimal && length $decimal) ?
                  join($self->{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<x> 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 @_;
    $format = $self->{neg_format} unless defined $format;
    croak "Letter x must be present in picture in format_negative()\n"
        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<THOUSANDS_SEP> and C<DECIMAL_POINT>,
respectively, for proper operation.  However, the C<THOUSANDS_SEP>
characters in C<$picture> need not occur every three digits; the
I<only> 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<DECIMAL_POINT> in C<$picture>.

The value of C<NEG_FORMAT> 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 @_;
    $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("Number::Format::format_picture($number, $picture): ".
          "Only one decimal separator($self->{decimal_point}) ".
          "permitted in picture.\n")
        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
        $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;
}