package Exception;

use warnings;
use strict;

# Enable Perl 6 knock offs.
use 5.010;

use Carp;
use Exporter 'import';
our @EXPORT_OK = qw(create_exception delete_exception);

# Global stores for all exceptions.
# NOTE: In this module each exception is just a Exception class,
# and not it's own class; instead the data about each exception is created with
# create_exception() and destroyed with delete_exception() while being stored in
# %exception_{desc,param}.
state %exception_desc;
state %exception_param;
# It is a hash of hashes.  Each key in the first hash is the name or type of
# exception, while the key in the second hash is 'description' for the type's
# description, or 'params' for the list of parameters that  exception takes.

# Constructs new Exception objects in order to throw exceptions
# coupled with die.  For example:
# die Exception->throw('SomeException');
sub throw {
    my($class, $exception_type, @params) = @_;
        croak <<EOC unless exception_exists($exception_type);
You tried to throw an exception [$exception_type] that does not exist, or has
not been declared.  You must define every exception before you try to throw that
exception.
EOC

    # Build object now for use below.
    my $self = bless {_exception_type => $exception_type,
              _description => $exception_desc{$exception_type} }, $class;

    # shift off the name of the parameter.
    while (defined(my $param = shift @params)) {
        if (grep $param eq $_, @{$exception_param{$exception_type}}) {
            # Store parameter inside this exception object.
            $self->{$param} = (shift @params // croak <<EOC);
You tried to throw an exception that had an uneven number of parameters and
their values.  The list of parameters you provide must be an even number of
parameters followed by their values as in a hash. (ex: 'exception' a => '1', b
=> '2', c => '3')
EOC
            # Also, substitute this paramter for its value in this exception's
            # description.
            #BUGALERT# be sure to test that this actually works.
            $self->{_description} =~ s/$param/$self->{$param}/g;
        } else {
            croak <<EOC;
You tried to throw an exception with a paramter that the exception does not
accept.  Your parameters [@params].  Accepted parameters
[@{$exception_param{$exception_type}}].
EOC
        }
    }

    return $self;
}

# A subroutine to be optionally exported by Exception that adds
# entries to %exception thereby creating new exceptions.  Each class that throws
# exceptions must call this subroutine first to create those exceptions.
sub create_exception {
    my ($exception_type, $description, @params) = @_;
    if (exception_exists($exception_type)) {
        warn <<EOW;
You have redefined an exception.  This might be an error, because they should
really only be defined just once.
EOW
    }

    # Add this new exception to %exception_{desc,param}.
    $exception_desc{$exception_type} = $description,
    $exception_param{$exception_type} = [@params];
}

# Checks to see if a given exception exists or not.
sub exception_exists {
    my $exception_type = shift;
    if (exists $exception_desc{$exception_type} and
        exists $exception_param{$exception_type} ) {
        return "$exception_type exists!"; #return true
    } else {
        return 0; #return false
    }
}

1;


##</code><code>##

#!perl
# exception.t tests all of Exception.

use strict;
use warnings;
use diagnostics;
use 5.010;

use Test::More;# tests => '19';

BEGIN { use_ok('Exception', 'create_exception'); }

# Test uneven params.
# create exception w/params
create_exception('ParameterException', 'description', 'param', 'param2');
evalok(sub {eval {die Exception->throw('TestException', param =>)};},
    <<EOD, 'check throw()ing uneven params');
You tried to throw an exception that had an uneven number of parameters and
their values.  The list of parameters you provide must be an even number of
parameters followed by their values as in a hash. (ex: 'exception' a => '1', b
=> '2', c => '3')
EOD

done_testing();

# runs code, and validates the $@ error message.
# Why make people install Test::Exception if this little bit of code is all
# that's needed?
sub evalok {
    my ($code, $expected_message, $test_name) = @_;
    $code->();
    my $croak = $@;
    $croak =~ s/\sat.*\n$//; #remove cruft.
    is($croak, $expected_message, $test_name);
}


##</code><code>##

exception.t .. 
ok 1 - use Exception;
not ok 2 - check throw()ing uneven params

#   Failed test 'check throw()ing uneven params'
#   at delme.t line 34.
#          got: 'You tried to throw an exception [TestException] that does not exist, or has
# not been declared.  You must define every exception before you try to throw that
# exception.
# '
#     expected: 'You tried to throw an exception that had an uneven number of parameters and
# their values.  The list of parameters you provide must be an even number of
# parameters followed by their values as in a hash. (ex: 'exception' a => '1', b
# => '2', c => '3')
# '
1..2
# Looks like you failed 1 test of 2.
Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/2 subtests 

Test Summary Report
-------------------
exception.t (Wstat: 256 Tests: 2 Failed: 1)
  Failed test:  2
  Non-zero exit status: 1
Files=1, Tests=2,  0 wallclock secs ( 0.02 usr  0.00 sys +  0.07 cusr  0.00 csys =  0.09 CPU)
Result: FAIL