format.pm

Astercon2 开源软交换 2.2.0

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

=item format_price($number, $precision)

Returns a string containing C<$number> formatted similarly to
C<format_number()>, 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.

If the C<INT_CURR_SYMBOL> 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<INT_CURR_SYMBOL> is the empty string.

=cut

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

    my $sign = $number <=> 0;
    $number = abs($number) if $sign < 0;

    $number = $self->format_number($number, $precision); # format it first
    # 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);

    # Combine it all back together and return it.
    $self->{int_curr_symbol} =~ s/\s*$/ /;
    my $result = ($self->{int_curr_symbol} .
                  ($precision ?
                   join($self->{mon_decimal_point}, $integer, $decimal) :
                   $integer));

    return ($sign < 0) ? $self->format_negative($result) : $result;
}

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

=item format_bytes($number, $options)

=item format_bytes($number, $precision)  # deprecated

Returns a string containing C<$number> formatted similarly to
C<format_number()>, except that large numbers may be abbreviated by
adding C<$KILO_SUFFIX>, C<$MEGA_SUFFIX>, or C<$GIGA_SUFFIX>.  Negative
values will result in an error.

The second parameter can be either a reference to a hash that sets
options, or a number.  Using a number here is deprecated; older
versions of Number::Format only allowed a numeric value.  New code
should use a hash reference instead.  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(2048)    yields   '2K'
  format_bytes(9999999) yields   '9.54M'

=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 will be
divided by 1024 and C<$KILO_SUFFIX> added; if greater than or equal to
1048576 (1024*1024), it will be divided by 1048576 and "M" appended to
the end; etc.

However if a value is given for C<unit> it will use that value
instead.  Acceptable values for C<unit> are: 'giga', 'mega', 'kilo',
'none', or 'auto'.  These may be abbreviated to their first letters
'g', 'm', 'k', 'n', or 'a'; they may be given in upper- or lowercase
letters.  For example:

  format_bytes(1048576, { units => 'K'}) yields     '1,024K'
                                         instead of '1M'

Using 'none' as the unit blocks all unit conversion, and the function
simply returns the result of format_number($number, $precision).  The
default behavior can be obtained by specifying 'auto'.

Note that the valid values to this option do not vary even when the
C<$GIGA_SUFFIX>, C<$MEGA_SUFFIX>, and C<$KILO_SUFFIX> 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.

=back

=cut

sub format_bytes
{
    my ($self, $number, @options) = _get_self @_;

    croak "Negative number ($number) not allowed in format_bytes\n"
        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 uncommented 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

    # 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.
    $options{base} = 1024
        unless defined $options{base};
    my $kilo_th = $options{base};
    my $mega_th = $options{base} ** 2;
    my $giga_th = $options{base} ** 3;

    # 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 >= $giga_th)
        {
            $unit = 'G';
        }
        elsif ($number >= $mega_th)
        {
            $unit = 'M';
        }
        elsif ($number >= $kilo_th)
        {
            $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 /= $giga_th;
        $suffix = $self->{giga_suffix};
    }
    elsif ($unit eq 'M')
    {
        $number /= $mega_th;
        $suffix = $self->{mega_suffix};
    }
    elsif ($unit eq 'K')
    {
        $number /= $kilo_th;
        $suffix = $self->{kilo_suffix};
    }
    elsif ($unit ne 'N')
    {
        croak "format_bytes: Invalid unit option \"$options{unit}\"";
    }

    # 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<format_number()>,
C<format_price()>, or C<format_picture()>, and returns the
corresponding value as a numeric scalar.  Returns C<undef> 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<DECIMAL_POINT> 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<INT_CURR_SYMBOL> and
C<THOUSANDS_SEP>, are removed.

If the number matches the pattern of C<NEG_FORMAT> I<or> there is a
``-'' character before any of the digits, then a negative number is
returned.

If the number ends with the C<KILO_SUFFIX> or C<MEGA_SUFFIX>
characters, then the number returned will be multiplied by 1024 or
1024*1024 as appropriate.

=cut

sub unformat_number
{
    my ($self, $formatted) = _get_self @_;
    $self->_check_seps();
    return undef unless $formatted =~ /\d/; # require at least one digit

    # Detect if it ends with the kilo or mega suffix.
    my $kp = ($formatted =~ s/$self->{kilo_suffix}\s*$//);
    my $mp = ($formatted =~ s/$self->{mega_suffix}\s*$//);

    # Split number into integer and decimal parts
    my ($integer, $decimal, @cruft) =
        split(/\Q$self->{decimal_point}\E/, $formatted);
    croak("Number::Format::unformat_number($formatted): ".
          "Only one decimal separator($self->{decimal_point}) permitted.\n")
        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 *= 1024    if $kp;
    $number *= 1048576 if $mp;

    return $number;
}

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

=back

=head1 BUGS

No known bugs at this time.  Report bugs using the CPAN request
tracker at L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Format>
or by email to the author.

=head1 AUTHOR

William R. Ward, [e-mail] (remove "SPAM" before sending email,
leaving only my initials)

=head1 SEE ALSO

perl(1).

=cut

1;