File Coverage

blib/lib/Finance/Currency/ParValueSeparate.pm

Criterion	Covered	Total	%
statement	111	127	87.4
branch	37	46	80.4
condition			n/a
subroutine	15	19	78.9
pod	12	15	80.0
total	175	207	84.5

package Finance::Currency::ParValueSeparate;
use Carp;
use strict;
our $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /: (\d+)\.(\d+)/;
use Data::Dumper;

sub new {
	my $class = shift;
	my %opt = @_;
	my $concrete = $class;
	my $amount = [];

	# called base class
	if ( $class eq 'Finance::Currency::ParValueSeparate' ){

		# which subclass we wanner using?
		if ( defined $opt{'currency'} ){
			$concrete = "Finance::Currency::ParValueSeparate::".$opt{'currency'};
		}else{
			$concrete = "Finance::Currency::ParValueSeparate::" . shift @_;
			$amount = ( ref $_[0] eq 'ARRAY' ) ? $_[0] : [ @_ ];
		}

		# try to require the subclass
		eval "require $concrete;";
		die "subclass: $concrete could not required!" if $@;

	# called subclass
	}else{
		$amount = ( ref $_[0] eq 'ARRAY' ) ? $_[0] : [ @_ ];
	}

	my $self = bless {}, $concrete;
	$self->amount( $amount );
	$self->with_dollar( $self->dollar );
	$self->with_cent( $self->cent );

	return $self;
}

sub _amount_format {
	my $self = shift;
	my $amount = shift;
	return sprintf( '%.2f', $amount );
}

sub amount {
	my $self = shift;
	my $amount_ref = ( ref $_[0] eq 'ARRAY' ) ? $_[0] : [ @_ ];
	$self->{_AMOUNT} = [ map { $self->_amount_format( $_ ) } @$amount_ref ]
		if scalar @$amount_ref;
	return wantarray ? @{$self->{_AMOUNT}} : $self->{_AMOUNT};
}

sub with_dollar {
	my $self = shift;
	my $with_dollar = ( ref $_[0] eq 'ARRAY' ) ? $_[0] : [ @_ ];
	if ( @_ ){
		my $valid_dollar;
		map { $valid_dollar->{$_}++; } $self->dollar;
		$self->{_with_dollar} = [ grep { $valid_dollar->{$_} } @$with_dollar ];

		map { delete $valid_dollar->{$_} } @$with_dollar;
		$self->{_without_dollar} = [ keys %$valid_dollar ];
	}
	return wantarray ? @{$self->{_with_dollar}} : $self->{_with_dollar};
}
sub without_dollar {
	my $self = shift;
	my $without_dollar = ( ref $_[0] eq 'ARRAY' ) ? $_[0] : [ @_ ];
	if ( @_ ){
		my $valid_dollar;
		map { $valid_dollar->{$_}++; } $self->dollar;
		$self->{_without_dollar} = [ grep { $valid_dollar->{$_} } @$without_dollar ];

		map { delete $valid_dollar->{$_} } @$without_dollar;
		$self->{_with_dollar} = [ keys %$valid_dollar ];
	}
	return wantarray ? @{$self->{_without_dollar}} : $self->{_without_dollar};
}

sub with_cent {
	my $self = shift;
	my $with_cent = ( ref $_[0] eq 'ARRAY' ) ? $_[0] : [ @_ ];
	if ( @_ ){
		my $valid_cent;
		map { $valid_cent->{$_}++; } $self->cent;
		$self->{_with_cent} = [ grep { $valid_cent->{$_} } @$with_cent ];

		map { delete $valid_cent->{$_} } @$with_cent;
		$self->{_without_cent} = [ keys %$valid_cent ];
	}
	return wantarray ? @{$self->{_with_cent}} : $self->{_with_cent};
}
sub without_cent {
	my $self = shift;
	my $without_cent = ( ref $_[0] eq 'ARRAY' ) ? $_[0] : [ @_ ];
	if ( @_ ){
		my $valid_cent;
		map { $valid_cent->{$_}++; } $self->cent;
		$self->{_without_cent} = [ grep { $valid_cent->{$_} } @$without_cent ];

		map { delete $valid_cent->{$_} } @$without_cent;
		$self->{_with_cent} = [ keys %$valid_cent ];
	}
	return wantarray ? @{$self->{_without_cent}} : $self->{_without_cent};
}

sub only_dollar {
	my $self = shift;
	my $flag = shift;
	if ( defined $flag ){
		$self->{_only_dollar} = ( $flag ) ? 1 : 0;
	}
	return $self->{_only_dollar};
}

sub parse {
	my $self = shift;
	$self->amount(@_);
	delete $self->{_DOLLAR};
	delete $self->{_CENT};

	map {
		my $dollar = int $_;
		my ( $cent ) = ( $_ =~ /\.(.*)$/ );

		foreach my $parvalue ( sort { $b<=>$a } $self->with_dollar ){
			my $number = ( $dollar - $dollar % $parvalue ) / $parvalue;
			$dollar -= $number * $parvalue;
			$self->{_DOLLAR}{$parvalue} += $number;
		}

		next if $self->only_dollar;

		foreach my $parvalue ( sort { $b<=>$a } $self->with_cent ){
			my $number = ( $cent - $cent % $parvalue ) / $parvalue;
			$cent -= $number * $parvalue;
			$self->{_CENT}{$parvalue} += $number;
		}

	} $self->amount;
}

sub dollar_parvalues {
	my $self = shift;
	return sort { $b <=> $a } keys %{$self->{_DOLLAR}};
}
sub number_of_dollar {
	my $self = shift;
	my $parvalue = shift;
	return $self->{_DOLLAR}{$parvalue};
}

sub cent_parvalues {
	my $self = shift;
	return sort { $b <=> $a } keys %{$self->{_CENT}};
}
sub number_of_cent {
	my $self = shift;
	my $parvalue = shift;
	return $self->{_CENT}{$parvalue};
}


# subclass override them
sub currency_name {
	croak 'base class has no currency_name, use subclass';
}
sub dollar {
	croak 'base class has no dollar denomination informations, use subclass';
}
sub cent {
	croak 'base class has no cent denomination informations, use subclass';
}

1;
__END__