view release on metacpan or  search on metacpan

lib/DR/Money.pm  view on Meta::CPAN

    '='         => sub { $_[0]->new($_[1]) },
    'int'       => \&_int,
    '+'         => \&_add,
    '*'         => \&_mul,
    '-'         => \&_sub,
    '/'         => \&_div,

    '++'        => \&_inc,
    '--'        => \&_dec,
    '+='        => \&_addself,
    '-='        => \&_subself,
    '*='        => \&_mulself,
    '/='        => \&_divself,
;


=head1 NAME

DR::Money - module to manipulate by money in perl scripts

=head1 SYNOPSIS

    my $m = Money(2.3);
    print $m;           # prints 2.30
    $m += 2.3;          # 4.60
    $m += Money(4.2);   # 8.80

The module supports negative moneys.

=head1 Functions

=head2 Money

Functional constructor.

    my $money = Money(0.1);
    printf '%s', $money;        # prints 0.10

=cut

sub Money($) { __PACKAGE__->new($_[0]) }


=head1 Methods

=head2 new

Class or instance's method. Construct new instance.

=cut

sub new {
    my ($class, $value) = @_;

    my $self;

    if (ref $class) {
        $self = bless [ '+', 0, 0, '0.00' ] => ref $class;
        $self->_assign( $class );
    } else {
        $self = bless [ '+', 0, 0, '0.00' ] => $class;
    }

    $self->_assign($value) if @_ > 1;
    return $self;
}


=head2 value

Returns value (string).

    my $money = Money(0.1);
    $v = $money->value;         # 0.10
    $v = "$money";              # the same

=cut

sub value { $_[0][3] }



=head1 Private (overload methods)

=head2 _assign($value)

Private method. Assigns new value to instance. Returns instance.

    my $money = Money(0.1);

    $money->_assign( 0.2 );
    $money = 0.2;               # the same

=cut

sub _assign {
    my ($self, $value) = @_;
    croak 'usage $money->_assign($value)' unless @_ > 1;

    if (!$value) {
        @$self = ('+', 0, 0, '0.00');
        return $self;
    }

    if (ref $value and $value->isa(__PACKAGE__)) {
        @$self = @{ $value }[0, 1, 2, 3];
        return $self;
    }

    $value =~ s/\s+//g;

    my ($sign, $r, $k, $s);

    if ($value =~ /^(-)?0*(\d+)[,\.]?$/) {
        $sign = $1 || '+';
        $r = int $2;
        $k = 0;
        $s = sprintf '%s%d.00', ($sign eq '-' ? '-' : ''), $r;
    } elsif ($value =~ /^(-)?0*(\d*)[,\.](\d+)$/) {
        $sign = $1 || '+';
        $r = int($2 || 0);