view release on metacpan or  search on metacpan

lib/Math/Currency.pm  view on Meta::CPAN

use utf8;
use base qw(Exporter Math::BigFloat);
use Math::BigFloat 1.60;
use POSIX qw(locale_h);
use Encode::Locale;
use Encode ();

use overload '""' => \&bstr;

our $LC_MONETARY = {
    en_US => {
        INT_CURR_SYMBOL   => 'USD ',
        CURRENCY_SYMBOL   => '$',
        MON_DECIMAL_POINT => '.',
        MON_THOUSANDS_SEP => ',',
        MON_GROUPING      => '3',
        POSITIVE_SIGN     => '',
        NEGATIVE_SIGN     => '-',
        INT_FRAC_DIGITS   => '2',
        FRAC_DIGITS       => '2',
        P_CS_PRECEDES     => '1',
        P_SEP_BY_SPACE    => '0',
        N_CS_PRECEDES     => '1',
        N_SEP_BY_SPACE    => '0',
        P_SIGN_POSN       => '1',
        N_SIGN_POSN       => '1',
    },
};
$LC_MONETARY->{USD} = $LC_MONETARY->{en_US};

our $FORMAT = $LC_MONETARY->{en_US} unless localize();

our @EXPORT_OK = qw(
    $LC_MONETARY
    $FORMAT
    Money
);

# Set class constants
our $round_mode = 'even';    # Banker's rounding obviously
our $accuracy   = undef;
our $precision = $FORMAT->{FRAC_DIGITS} > 0 ? -$FORMAT->{FRAC_DIGITS} : 0;
our $div_scale = 40;
our $use_int   = 0;
our $always_init = 0;        # should the localize() happen every time?


sub new {
    my $proto  = shift;
    my $class  = ref($proto) || $proto;
    my $parent = $proto if ref($proto);

    my $value = shift || 0;

    if (eval("'1.01' ne 1.01")) { # this might be a comma locale
	$value =~ tr/,/./;
    }
    $value =~ tr/-()0-9.//cd;    #strip any formatting characters
    $value = "-$value" if $value =~ s/(^\()|(\)$)//g;    # handle parens

    if ( (caller)[0] =~ /Math\::BigInt/ )    # only when called from objectify()
    {
        return Math::BigFloat->new($value);
    }

    my $self;
    my $currency = shift;
    my $format;

    if ( not defined $currency and $class->isa('Math::Currency') ) {
        # must be one of our subclasses
        $currency = $1 if ($class =~ /Math::Currency::(\w+)/);
    }

    if ( defined $currency )    #override default currency type
    {
        unless ( defined $LC_MONETARY->{$currency} ) {
            eval "require Math::Currency::$currency";
            unknown_currency($currency) if $@;
        }
        $format = $LC_MONETARY->{$currency};
    }

    if ($format) {
        $self =
          Math::BigFloat->new( $value, undef, -( $format->{FRAC_DIGITS} + 2 ) );
        bless $self, $class;
        $self->format($format);
    }
    elsif ( $parent
        and defined $parent->{format} ) # if we are cloning an existing instance
    {
        $self =
          Math::BigFloat->new( $value, undef,
            -( $parent->format->{FRAC_DIGITS} + 2 ) );
        bless $self, $class;
        $self->format( $parent->format );
    }
    else {
        $self =
          Math::BigFloat->new( $value, undef, -( $FORMAT->{FRAC_DIGITS} + 2 ) );
        bless $self, $class;
    }
    return $self;
}    ##new


sub Money {
    return __PACKAGE__->new(@_);
}

sub bstr {
    my $self     = shift;
    my $myformat = $self->format();
    my $value    = $self->as_float();
    my $neg      = ( $value =~ tr/-//d );
    my $dp       = index( $value, "." );
    my $sign     = $neg
      ? $myformat->{NEGATIVE_SIGN}
      : $myformat->{POSITIVE_SIGN};
    my $curr = $use_int