File Coverage

blib/lib/DBR/Config/Trans/Dollars.pm

Criterion	Covered	Total	%
statement	33	51	64.7
branch	7	18	38.8
condition	2	9	22.2
subroutine	14	21	66.6
pod	0	3	0.0
total	56	102	54.9

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;