# Adjusted.pm 18sep14waw
package Adjusted;
use warnings FATAL => 'all';
use strict;
use List::Util qw(sum);
my %pos = qw(A 1 B 2 C 3 D 4 E 5 F 6 G 7 H 8 I 9 { 0);
my %neg = qw(J 1 K 2 L 3 M 4 N 5 O 6 P 7 Q 8 R 9 } 0);
my %all = (%pos, %neg);
my $suffices = join '', keys %all;
sub value {
my ($val, # value (string) to be adjusted and returned as number
) = @_;
# convert suffix of valid value to digit.
$val =~ s{ \A \d{8} ([\Q$suffices\E]) \z }{$all{$1}}xms
or die "bad value: '$val'";
my $suffix = $1; # save capture group (just in case...)
# negate value if suffix in negative group, return as numeric.
return (exists $neg{$suffix} ? -1 : 1) * $val;
}
sub values_summed { # throws exception if no arguments
# return rounded, summed, adjusted values as numeric scalar.
return 0 + sprintf '%.2f', sum(map value($_), @_) / 100;
}
1; # end Adjusted.pm
####
# Adjusted.t 18sep14waw
use strict;
use warnings;
use Test::More
# tests => ?? + 1 # Test::NoWarnings adds 1 test
'no_plan'
;
use Test::NoWarnings;
use Test::Exception;
use constant VALS => ( # from OP perlmonks node 1100962
'00000000{', # +0
'00000000{', # +0
'00000000{', # +0
'00000369I', # +3699
'00000020{', # +200
'00000000{', # +0
'00000100}', # -1000
'00000289R', # -2899
);
use constant SUM => 3699 + 200 - 1000 - 2899; # sum == 0
BEGIN { use_ok 'Adjusted'; }
TEST_VECTOR:
for my $ar_vector (
"just one vector for now",
[ SUM, 'OPed data, sum', VALS ],
) {
if (not ref $ar_vector) {
note $ar_vector;
next TEST_VECTOR;
}
my ($sum, $msg, @vals) = @$ar_vector;
ok Adjusted::values_summed(@vals) == $sum, $msg;
} # end for TEST_VECTOR
note "\nTAKE NOTE -- test various exceptions \n\n";
EXCEPTION:
for my $ar_vector (
[ qr'bad value', 'too few digits', '0000369I' ],
[ qr'bad value', 'too many digits', '000000369I' ],
[ qr'bad value', 'unknown suffix', '00000369Z' ],
"should empty values list really be an exception?",
[ qr'uninitialized value in division', 'empty values list', () ],
) {
if (not ref $ar_vector) {
note $ar_vector;
next EXCEPTION;
}
my ($rx, $msg, @vals) = @$ar_vector;
throws_ok { Adjusted::values_summed(@vals) } $rx, $msg;
} # end for EXCEPTION
####
c:\@Work\Perl\monks\perldiverx>perl Adjusted.t
ok 1 - use Adjusted;
# just one vector for now
ok 2 - OPed data, sum
#
# TAKE NOTE -- test various exceptions
#
ok 3 - too few digits
ok 4 - too many digits
ok 5 - unknown suffix
# should empty values list really be an exception?
ok 6 - empty values list
ok 7 - no warnings
1..7