format.pm

Astercon2 开源软交换 2.2.0

package Locale::Currency::Format;

require 5.006_00;

use strict;

use Exporter;

$Locale::Currency::Format::VERSION = "1.22";

@Locale::Currency::Format::ISA     = qw(Exporter);
@Locale::Currency::Format::EXPORT  = qw(
  currency_format
  currency_symbol
  FMT_NOZEROS
  FMT_STANDARD
  FMT_COMMON
  FMT_SYMBOL
  FMT_HTML
  FMT_NAME
  SYM_UTF
  SYM_HTML
);

@Locale::Currency::Format::EXPORT_OK = qw($error);

%Locale::Currency::EXPORT_TAGS = (
  DEFAULT => [@Locale::Currency::Format::EXPORT]
);

# Macros for format options
sub FMT_NOZEROS()  { 0x0001 }
sub FMT_STANDARD() { 0x0002 }
sub FMT_SYMBOL()   { 0x0004 }
sub FMT_COMMON()   { 0x0008 }
sub FMT_HTML()     { 0x0010 }
sub FMT_NAME()     { 0x0020 }

# Macros for symbol options
sub SYM_UTF()      { 0x0001 }
sub SYM_HTML()     { 0x0002 }

my $THOUSANDS_SEP = ',';
my $DECIMAL_POINT = '.';

my $list = { };

$Locale::Currency::Format::error = "";

sub currency_format
{
  my ($code, $amnt, $style, $entry) = @_;

  if (!defined $amnt) {
    $Locale::Currency::Format::error = "Undefined currency amount";
    return undef; 
  }

  if (!defined $code) {
    $Locale::Currency::Format::error = "Undefined currency code";
    return undef; 
  }

  $code  = uc $code;
  $entry = $list->{$code};

  if (!$entry) {
    $Locale::Currency::Format::error = "Invalid currency code";
    return undef;
  }

  $THOUSANDS_SEP = defined $entry->[2] ? $entry->[2] : '';
  $DECIMAL_POINT = defined $entry->[3] ? $entry->[3] : '';
  $amnt  = format_number($amnt, $entry->[1] || 0, $style ? !($style & 0x1) : 1);
  $style = $style ? $style & 0x00FE : FMT_STANDARD; 

  # Looks like a switch hehe
  while ($style) {
    $style == FMT_SYMBOL and $entry->[5]
      and return $entry->[8] ? $entry->[5].$entry->[4].$amnt 
                             : $amnt.$entry->[4].$entry->[5];
    $style == FMT_COMMON and $entry->[7]
      and return $entry->[8] ? $entry->[7].$entry->[4].$amnt
                             : $amnt.$entry->[4].$entry->[7];
    $style == FMT_HTML and $entry->[6]
      and return $entry->[8] ? $entry->[6].$entry->[4].$amnt
                             : $amnt.$entry->[4].$entry->[6];
    $style == FMT_NAME
      and return "$amnt $entry->[0]";

    last;
  }

  return "$amnt $code"; 
}

sub currency_symbol
{
  my ($code, $type, $entry) = @_;

  if (!defined $code) {
    $Locale::Currency::Format::error = "Undefined currency code";
    return undef;
  }

  $code  = uc $code;
  $entry = $list->{$code};
  
  if (!$entry) {
    $Locale::Currency::Format::error = "Invalid currency code";
    return undef;
  }

  if ($type and $type == SYM_UTF) {
    $Locale::Currency::Format::error = "Non-existant currency UTF symbol"
      unless $entry->[5];
    return $entry->[5];
  }
  elsif ($type and $type == SYM_HTML) {
    $Locale::Currency::Format::error = "Non-existant currency HTML symbol"
      unless $entry->[6];
    return $entry->[6];
  }
  elsif ($type) {
    $Locale::Currency::Format::error = "Invalid symbol type";
    return undef;
  }

  $Locale::Currency::Format::error = "Non-existant currency symbol"
    unless $entry->[5];

  return $entry->[5];
}


# These functions are copied directly out of Number::Format due to a bug that 
# lets locale settings take higher precedence to user's specific manipulation.
# In addition, this will exclude the unnecessary POSIX module used by 
# Number::Format.

sub round
{
    my ($number, $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;
}

sub format_number
{
    my ($number, $precision, $trailing_zeroes) = @_;

    # Set defaults and standardize number
    $precision = 2 unless defined $precision;
    $trailing_zeroes = 1 unless defined $trailing_zeroes;

    # Handle negative numbers
    my $sign = $number <=> 0;
    $number = abs($number) if $sign < 0;
    $number = round($number, $precision); # round off $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 leading 0's so length($integer) is divisible by 3
    $integer = '0'x(3 - (length($integer) % 3)).$integer
      unless length($integer) % 3 == 0;

    # Split $integer into groups of 3 characters and insert commas
    $integer = join($THOUSANDS_SEP, grep {$_ ne ''} split(/(...)/, $integer));

    # Strip off leading zeroes and/or comma
    $integer =~ s/^0+//;
    $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) ? format_negative($result) : $result;
}

sub format_negative
{
    my($number, $format) = @_;
    $format = '-x' unless defined $format;
    $number =~ s/^-//;
    $format =~ s/x/$number/;
    return $format;
}



#===========================================================================
# ISO 4217 and common world currency symbols 
#===========================================================================
# code => 0      1       2       3       4       5       6       7       8
#        name  dplaces  ksep   dsep   symsep  symutf  symesc  symcom  prefix  
$list = {
AED => ["UAE Dirham",2,",","."," ",undef,undef,"Dhs.",1],
AFA => ["Afghani",0,undef,undef,"",undef,undef,undef,undef],
ALL => ["Lek",2,undef,undef,"",undef,undef,undef,undef],
AMD => ["Armenian Dram",2,",",".","",undef,undef,"AMD",0],
ANG => ["Antillian Guilder",2,".",","," ","\x{0192}","&#x0192;","NAf.",1],
AON => ["New Kwanza",0,undef,undef,"",undef,undef,undef,undef],
ARS => ["Argentine Peso",2,".",",","","\x{20B1}","&#x20B1;","\$",1],
ATS => ["Schilling",2,".",","," ",undef,undef,"鯯",1],
AUD => ["Australian Dollar",2," ",".","","\x{0024}","&#x0024;","\$",1],
AWG => ["Aruban Guilder",2,",","."," ","\x{0192}","&#x0192;","AWG",1],
AZM => ["Azerbaijanian Manat",2,undef,undef,"",undef,undef,undef,undef],
BAM => ["Convertible Marks",2,",",".","",undef,undef,"AZM",0],
BBD => ["Barbados Dollar",2,undef,undef,"","\x{0024}","&#x0024;",undef,undef],
BDT => ["Taka",2,",","."," ",undef,undef,"Bt.",1],
BEF => ["Belgian Franc",0,".",""," ","\x{20A3}","&#x20A3;","BEF",1],
BGL => ["Lev",2," ",","," ",undef,undef,"lv",0],
BHD => ["Bahraini Dinar",3,",","."," ",undef,undef,"BD",1],
BIF => ["Burundi Franc",0,undef,undef,"",undef,undef,undef,undef],
BMD => ["Bermudian Dollar",2,",",".","","\x{0024}","&#x0024;","\$",1],
BND => ["Brunei Dollar",2,",",".","","\x{0024}","&#x0024;","\$",1],
BOB => ["Bolivian Boliviano",2,",",".","",undef,undef,"Bs",1],
BRL => ["Brazilian Real",2,".",","," ",undef,undef,"R\$",1],
BSD => ["Bahamian Dollar",2,",",".","","\x{0024}","&#x0024;","\$",1],
BTN => ["Bhutan Ngultrum",2,undef,undef,"",undef,undef,undef,undef],
BWP => ["Pula",2,",",".","",undef,undef,"P",1],
BYR => ["Belarussian Ruble",0,undef,undef,"",undef,undef,undef,undef],
BZD => ["Belize Dollar",2,",",".","","\x{0024}","&#x0024;","\$",1],
CAD => ["Canadian Dollar",2,",",".","","\x{0024}","&#x0024;","\$",1],
CDF => ["Franc Congolais",2,undef,undef,"",undef,undef,undef,undef],
CHF => ["Swiss Franc",2,"'","."," ",undef,undef,"SFr.",1],
CLP => ["Chilean Peso",0,".","","","\x{20B1}","&#x20B1;","\$",1],
CNY => ["Yuan Renminbi",2,",",".","","\x{5713}","&#x5713;","Y",1],
COP => ["Colombian Peso",2,".",",","","\x{20B1}","&#x20B1;","\$",1],
CRC => ["Costa Rican Colon",2,".",","," ","\x{20A1}","&#x20A1;","