package TrigCalc;

use warnings;
use strict;

# use Data::Dump qw(dd pp);  # for debug

use parent 'Exporter';

our $VERSION = '0.1.0';

our @EXPORT    = qw();  # default exports: (none for now)
our @EXPORT_OK =        # optional exports
    qw(reduce)
    ;

use constant SECS_PER_DEGREE => 3600;
use constant SECS_PER_MINUTE =>   60;

# exported subroutines #############################################

sub reduce {

    # reduce from rightmost end of argument list.
    return secs_2_dms(dms_2_secs((reverse @_)[ 0 .. 2 ]));

    }

# non-exported (utility) subroutines ###############################

sub dms_2_secs {

    my ($secs,  # seconds
        $mins,  # minutes
        $degs,  # degrees
        ) = @_;

    $secs ||= 0;  # init as zero if undefined (or false: redundant)
    $mins ||= 0;
    $degs ||= 0;

    return $degs * SECS_PER_DEGREE + $mins * SECS_PER_MINUTE + $secs;

    }

sub secs_2_dms {

    use integer;

    my ($secs,  # seconds
        ) = @_;

    $secs ||= 0;  # init as zero if undefined (or false: redundant)

    my $degs = $secs / SECS_PER_DEGREE;   $secs %= SECS_PER_DEGREE;
    my $mins = $secs / SECS_PER_MINUTE;   $secs %= SECS_PER_MINUTE;

    return $degs, $mins, $secs;

    }

1;

##</code><code>##

use warnings;
use strict;

use Test::More 'no_plan';
use Test::NoWarnings;

use Data::Dump qw(pp);

note "testing under perl version $]";

BEGIN { use_ok 'TrigCalc', qw(reduce); }

my @TESTS = (
    'degenerate cases',
    [ [],                      [ 0, 0, 0 ], 'empty argument list'   ],
    [ [ undef ],               [ 0, 0, 0 ], 'undefined argument(s)' ],
    [ [ undef, undef ],        [ 0, 0, 0 ], 'undefined argument(s)' ],
    [ [ undef, undef, undef ], [ 0, 0, 0 ], 'undefined argument(s)' ],

    'irreducible cases',
    [ [ 123, 180, 59, 59 ],  [ 180, 59, 59 ], 'left ignored' ],
    [ [      180, 59, 59 ],  [ 180, 59, 59 ], ],
    [ [      180, 59, 58 ],  [ 180, 59, 58 ], ],
    [ [        1,  1,  1 ],  [   1,  1,  1 ], ],
    [ [        0,  0,  0 ],  [   0,  0,  0 ], ],
    [ [         -1,   -1,   -1 ],  [   -1,   -1,   -1 ], ],
    [ [       -180,  -59,  -58 ],  [ -180,  -59,  -58 ], ],
    [ [ -123, -180,  -59,  -59 ],  [ -180,  -59,  -59 ], 'left ignored' ],

    'reducible cases',
    [ [  179,    0,   60 ],      [  179,    1,    0 ], ],
    [ [  179,   61,   61 ],      [  180,    2,    1 ], ],
    [ [  179,   59,   60 ],      [  180,    0,    0 ], ],
    [ [ -179,   60,    0 ],      [ -178,    0,    0 ], 'reduction of negatives' ],
  # [ [    0,    0,  -60 ],      [   -1,   59,    2 ], 'negative borrow'        ], # <-- ????
    [ [    0,    0,  -60 ],      [    0,   -1,    0 ], 'negative borrow'        ],
    [ [   90,  360,  360 ],      [   96,    6,    0 ], 'multiple reduction'     ],
    [ [   90, -360, -360 ],      [   83,   54,    0 ], 'multiple reduction'     ],

    'only rightmost arguments are reduced, others ignored',
    [ [              200,  179,    0,   60 ], [  179,    1,    0 ], ],
    [ [        200,  200,  179,    0,   60 ], [  179,    1,    0 ], ],
    [ [  200,  200,  200,  179,    0,   60 ], [  179,    1,    0 ], ],
    [ [              200,   90, -360, -360 ], [   83,   54,    0 ], ],
    [ [        200,  200,   90, -360, -360 ], [   83,   54,    0 ], ],
    [ [  200,  200,  200,   90, -360, -360 ], [   83,   54,    0 ], ],

    );

# just to be sure...
is_deeply [ reduce ], [ 0, 0, 0 ], 'REALLY empty argument list';

VECTOR:
for my $ar_vector (@TESTS) {

    # comments can be mixed into test vector list.
    if (not ref $ar_vector) {
        note "--- $ar_vector ---";  # actually a comment
        next VECTOR;
        }

    # expand test vector.
    my ($ar_args, $ar_expected, $cmnt) = @$ar_vector;

    # prepare fancy-shmancy test comment.
    $cmnt = defined $cmnt ? ": $cmnt" : '';
    my $args_str     = pp @$ar_args;
    my $expected_str = pp @$ar_expected;
    my $full_comment = "$args_str -> $expected_str$cmnt";

    # do it to it.
    is_deeply [ reduce(@$ar_args) ], $ar_expected, $full_comment;

    }  # end for VECTOR

# a way to test non-exported functions.

note "\n=== testing TrigCalc::dms_2_secs() ===\n\n";

# aliasing not really necessary, but more sexy.
*dms2s = *TrigCalc::dms_2_secs;

VECTOR:
for my $ar_vector (
    # only LEFT-most input args are converted.
    # expected   ------ input args ------
    #  seconds   secs mins degs   ignored
    [        0,                           ],  # empty args list
    [        1,    1                      ],
    [       62,    2,   1                 ],
    [     3723,    3,   2,   1            ],
    [     7384,    4,   3,   2,   4       ],
    [    11045,    5,   4,   3,   5, 6    ],
    [    14706,    6,   5,   4,   7, 8, 9 ],
    ) {

    if (not ref $ar_vector) {
        note $ar_vector;
        next VECTOR;
        }

    my ($expected, @args) = @$ar_vector;

    is dms2s(@args), $expected, "(@args) == $expected seconds";

    }  # end for VECTOR

done_testing;

exit;

# support subroutines ##############################################

# none for now

##</code><code>##

c:\@Work\Perl\monks\thechartist>perl TrigCalc.t
ok 1 - use TrigCalc;
# testing under perl version 5.008009
ok 2 - REALLY empty argument list
# --- degenerate cases ---
ok 3 - () -> (0, 0, 0): empty argument list
ok 4 - undef -> (0, 0, 0): undefined argument(s)
ok 5 - (undef, undef) -> (0, 0, 0): undefined argument(s)
ok 6 - (undef, undef, undef) -> (0, 0, 0): undefined argument(s)
# --- irreducible cases ---
ok 7 - (123, 180, 59, 59) -> (180, 59, 59): left ignored
ok 8 - (180, 59, 59) -> (180, 59, 59)
ok 9 - (180, 59, 58) -> (180, 59, 58)
ok 10 - (1, 1, 1) -> (1, 1, 1)
ok 11 - (0, 0, 0) -> (0, 0, 0)
ok 12 - (-1, -1, -1) -> (-1, -1, -1)
ok 13 - (-180, -59, -58) -> (-180, -59, -58)
ok 14 - (-123, -180, -59, -59) -> (-180, -59, -59): left ignored
# --- reducible cases ---
ok 15 - (179, 0, 60) -> (179, 1, 0)
ok 16 - (179, 61, 61) -> (180, 2, 1)
ok 17 - (179, 59, 60) -> (180, 0, 0)
ok 18 - (-179, 60, 0) -> (-178, 0, 0): reduction of negatives
ok 19 - (0, 0, -60) -> (0, -1, 0): negative borrow
ok 20 - (90, 360, 360) -> (96, 6, 0): multiple reduction
ok 21 - (90, -360, -360) -> (83, 54, 0): multiple reduction
# --- only rightmost arguments are reduced, others ignored ---
ok 22 - (200, 179, 0, 60) -> (179, 1, 0)
ok 23 - (200, 200, 179, 0, 60) -> (179, 1, 0)
ok 24 - (200, 200, 200, 179, 0, 60) -> (179, 1, 0)
ok 25 - (200, 90, -360, -360) -> (83, 54, 0)
ok 26 - (200, 200, 90, -360, -360) -> (83, 54, 0)
ok 27 - (200, 200, 200, 90, -360, -360) -> (83, 54, 0)
#
# === testing TrigCalc::dms_2_secs() ===
#
ok 28 - () == 0 seconds
ok 29 - (1) == 1 seconds
ok 30 - (2 1) == 62 seconds
ok 31 - (3 2 1) == 3723 seconds
ok 32 - (4 3 2 4) == 7384 seconds
ok 33 - (5 4 3 5 6) == 11045 seconds
ok 34 - (6 5 4 7 8 9) == 14706 seconds
1..34
ok 35 - no warnings
1..35

##</code><code>##

sub reduce {

    # reduce from rightmost end of argument list.
    # left-pad input arguments with 0s to avoid inaccessible items.

    my ($degs,  # degrees
        $mins,  # minutes
        $secs,  # seconds
        ) = map $_ || 0, (0, 0, 0, @_)[ -3 .. -1 ];  # handles undefs

    use integer;

    $secs = $degs * SECS_PER_DEGREE + $mins * SECS_PER_MINUTE + $secs;

    $degs = $secs / SECS_PER_DEGREE;   $secs %= SECS_PER_DEGREE;
    $mins = $secs / SECS_PER_MINUTE;   $secs %= SECS_PER_MINUTE;

    return $degs, $mins, $secs;

    }