# 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
[download]

# 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
[download]

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
[download]