package DBR::Config::Trans::Dollars; use strict; use base 'DBR::Config::Trans'; sub new { die "Should not get here" } sub forward{ my $self = shift; my $cents = shift; return bless( [$cents] , 'DBR::_DOLLARS'); } sub backward{ my $self = shift; my $value = shift; return undef unless defined($value) && length($value); if( ref($value) eq 'DBR::_DOLLARS' ){ # looks like it's a dollar object, yay! return $value->cents; } $value =~ tr/0-9.-//cd; # the items listed are ALLOWED values unless(length($value)){ $self->_error('invalid value specified'); return (); } return sprintf("%.0f", ($value * 100) ); } package DBR::_DOLLARS; use strict; use Carp; use overload #values '""' => sub { $_[0]->format }, '0+' => sub { $_[0]->dollars }, # comparisons '==' => sub { $_[0]->dollars == $_[1] }, '!=' => sub { $_[0]->dollars != $_[1] }, #operators '+' => sub { new($_[0]->cents + _getcents($_[1])) }, '-' => sub { my ($a,$b) = ($_[0]->cents, _getcents($_[1])); new ($_[2] ? $b - $a : $a - $b); }, '*' => sub { new($_[0]->cents * $_[1]) }, '/' => sub { my ($a,$b) = ($_[0]->cents, $_[1] ); new ($_[2] ? $b / $a : $a / $b); }, 'fallback' => 1; *TO_JSON = \&dollars; sub cents { return '' unless defined($_[0][0]); return $_[0][0] }; sub dollars { return '' unless defined($_[0][0]); return sprintf("%.02f",$_[0][0]/100) }; sub format { return '' unless defined($_[0][0]); my $dollars = shift->dollars; $dollars =~ s/\G(\d{1,3})(?=(?:\d\d\d)+(?:\.|$))/$1,/g; return '$' . $dollars; } #utilities sub new{ bless([ $_[1] || $_[0] ],'DBR::_DOLLARS') } # will work OO or functional sub _getcents{ my $val = $_[1] || $_[0]; # can be OO or functional return $val->cents if ref($val) eq __PACKAGE__; return sprintf("%.0f", ($val * 100) ) } 1;