File Coverage

blib/lib/Money/ChangeMaker.pm

Criterion	Covered	Total	%
statement	78	92	84.7
branch	27	42	64.2
condition	9	18	50.0
subroutine	10	12	83.3
pod	6	6	100.0
total	130	170	76.4

# Money::ChangeMaker -- Making change.

package Money::ChangeMaker;

require 5;
use strict;
use vars qw($VERSION);
use Money::ChangeMaker::Denomination;
use Money::ChangeMaker::Presets;

$VERSION = "0.3";

# These are private class members

# This is a reference to the set of predefined monetary sets.
# See perldocs in Presets.pm for more information.
my($_presets) = Money::ChangeMaker::Presets::_gen_presets_hash();

##   Here there be methods

# The constructor method.  It's very simple.
sub new {
  my($proto) = shift;
  my($options) = shift;
  my($class) = ref($proto) || $proto;
  my($self) = {};
  bless($self, $class);
  $self->{_DENOMINATIONS} = $_presets->{USA};
  unless ( defined($options) && (ref($options) eq "HASH") ) {
    $options = {};
  }
	if (exists($options->{'denominations'})) {
		$self->denominations($options->{'denominations'});
	}
  return($self);
}

# Sets the monetary denominations for making change, if a parameter is passed.
# Returns the new value.  A denominations value is a reference to an array of
# Money::ChangeMaker::Denomination objects.
sub denominations {
  my($self) = shift;
  my($option) = shift;
  if(defined($option)) {
		if (_check_denom($option)) {
			$self->{_DENOMINATIONS} = [(sort {$b->value <=> $a->value} @{$option})];
		}
  }
  return $self->{_DENOMINATIONS};
}

# The whole point of this module.  The entire algorithm is, um...  6 lines.
# :)  Sometimes I wonder.
# Take 2 values -- first the "price" of a thing, and second the amount
# of money that was paid.
# In list context, returns a list of Denomination objects, representing
# the units of currency that would make up the most efficient set of
# change given the transation.  Larger denominations are at the front of
# the list, and denomination objects will be repeated to indicate multiples.
# In scalar context, returns the results of passing the above described
# output through
sub make_change {
	my($self) = shift;
	my($price) = shift;
	my($tendered) = shift;
	unless (defined($price) && defined($tendered)) {
		return _warn("Price and amount tendered must both be defined");
	}
	if ($price < 1 || $tendered < 1) {
		return _warn(
			"Price and amount tendered must both be numbers, greater than 0."
		);
	}
	if ($tendered < $price) {
		return _warn("Insufficient funds tendered to cover price.");
	}
	my @ret;
	for my $denom (@{$self->{_DENOMINATIONS}}) {
		while ($tendered - $price >= $denom->value) {
			push(@ret, $denom);
			$tendered -= $denom->value;
		}
	}
	if (wantarray) {
		return @ret;
	}
	else {
		return as_string(@ret);
	}
}

# This makes sure that a scalar is a proper reference to a list of
# proper Denomination objects.
sub _check_denom {
	my($test) = shift;
	unless (ref($test) eq 'ARRAY') {
		return _warn("The denominations must be a reference to a list.");
	}
	for my $i (0..$#{$test}) {
		unless (defined($test->[$i])) {
			return _warn("Element " . $i + 1 . " is undef in denomination array.");
		}
		unless ($test->[$i]->isa("Money::ChangeMaker::Denomination")) {
			return _warn(
				"Element " . $i + 1 .
				" is not of the proper type in denomination array."
			);
		}
	}
	return 1;
}

# A simple method to print a warning.
# I may want to consider a different mechanism for handling non-fatals, so
# this may change.
sub _warn {
	warn(shift());
	return undef;
}

# Gets a reference to a list from the set of preset money sets by name.
sub get_preset {
	# Get rid of the first arg if this was called as an object or class method
	shift if UNIVERSAL::isa($_[0], __PACKAGE__);
	my($preset) = shift;
	return $_presets->{$preset};
}

# Gets a list of available names of preset money sets.
sub get_preset_names {
	# Get rid of the first arg if this was called as an object or class method
	shift if UNIVERSAL::isa($_[0], __PACKAGE__);
	return (keys %{$_presets});
}

# Given, as input, the list output of the make_change method, will return a
# string with a basic english representation of the data.  See the
# make_change method for more information on its output.
sub as_string {
	# Get rid of the first arg if this was called as an object or class method
	shift if UNIVERSAL::isa($_[0], __PACKAGE__);
	my $thisDenom;
	my $num;
	my $ret;
	for my $denom (@_) {
		unless (UNIVERSAL::isa($denom, "Money::ChangeMaker::Denomination")) {
			return _warn("All arguments must be of proper Denomination class");
		}
		if (
			defined($thisDenom) && defined($denom) &&
			$denom->name eq $thisDenom->name
		) {
			$num++;
		}
		else {
			if (defined($thisDenom)) {
				if ($ret) {
					$ret .= ", ";
				}
				$ret .= "$num ";
				if ($num > 1) {
					$ret .= $thisDenom->plural;
				}
				else {
					$ret .= $thisDenom->name;
				}
			}
			$thisDenom = $denom;
			$num = 1;
		}
	}
	if ($ret) {
		$ret .= ", ";
	}
	$ret .= "$num ";
	if ($num > 1) {
		$ret .= $thisDenom->plural;
	}
	else {
		$ret .= $thisDenom->name;
	}
	$ret =~ s/(.*), (\d)/$1 and $2/;
	return $ret;
}

1;

__END__