File Coverage

blib/lib/Config/Constants.pm

Criterion	Covered	Total	%
statement	59	63	93.6
branch	19	22	86.3
condition			n/a
subroutine	9	12	75.0
pod			n/a
total	87	97	89.6

package Config::Constants;

use strict;
use warnings;

our $VERSION = '0.03';

my %CONFIG_LOADER_CLASSES = (
    perl => 'Config::Constants::Perl',
    xml  => 'Config::Constants::XML'
);

# our config object
my $CONFIG;

# these two hashes are used
# for checking to make sure
# no invalid constants are used
my %UNCHECKED_CONSTANTS;
my %CHECKED_CONSTANTS;

sub import {
    shift;
    return unless @_;
    my @args = @_;
    if ($args[0] =~ /xml|perl/) {
        my ($type, $file) = @args;
        my $config_loader_class = $CONFIG_LOADER_CLASSES{$type};
        # try to load the config loader ...
        eval "use $config_loader_class";
        die "Failed to load config loader class ($config_loader_class) : $@" if $@;
        # try to load the config ...
        $CONFIG = eval { $config_loader_class->new($file) };
        die "Failed to load config (type => $type, file => $file) : $@" if $@;
        _load_all_modules();
    }
    else {
        my $calling_pkg = caller();
        if (exists $UNCHECKED_CONSTANTS{$calling_pkg}) {
            # this means that the conf was loaded first, so we
            # need to check the constants which were created
            # against the ones which are allowed for this
            # module, and if we find we have created extra
            # ones we throw an exception
            foreach my $arg (@args) {
                delete $UNCHECKED_CONSTANTS{$calling_pkg}->{$arg}
                    if exists $UNCHECKED_CONSTANTS{$calling_pkg}->{$arg}
            }
            die "Unchecked constants found in config for '$calling_pkg' -> (" .
                join(", " => keys(%{$UNCHECKED_CONSTANTS{$calling_pkg}})) .
                ")" if keys %{$UNCHECKED_CONSTANTS{$calling_pkg}};
        }
        else {
            # this means the conf has not been loaded yet,
            # so we need to build a list of acceptable
            # constants to check against.
            $CHECKED_CONSTANTS{$calling_pkg} = {  map { $_ => undef } @args };
        }
        no strict 'refs';
        foreach my $arg (@args) {
            # skip it if it has already been defined
            # NOTE: this means that the config was
            # loaded before the module itself was
            # loaded, so we don't want to overwrite
            next if defined &{"${calling_pkg}::$arg"};
            # However, if it hasn't been defined, then
            # we want to do so. This will create a
            # stub sub which will die if it is not
            # configured.
            # NOTE: the sub does not have the () prototype
            # here so that we can prevent constant folding
            # from happening. When the proper sub gets
            # installed, it will have that prototype (and
            # thus be folded in)
            *{"${calling_pkg}::$arg"} = sub { die "undefined Config::Constant in ${calling_pkg}::$arg" };
        }
    }
}

## For DEBUGGING
#INIT {
#    use Data::Dumper;
#    print "UNCHECKED: " . Dumper \%UNCHECKED_CONSTANTS;
#    print "CHECKED: "   . Dumper \%CHECKED_CONSTANTS;
#}

## Private Utility Functions

sub _load_all_modules {
    foreach my $module ($CONFIG->modules()) {
        _load_module($module);
    }
}

sub _load_module {
    my $module = shift;
    no strict 'refs';
    foreach my $constant ($CONFIG->constants($module)) {
        my ($name, $value) = each %{$constant};
        if (defined &{"${module}::$name"}) {
            # since this already exists, we
            # assume that it is a valid constant
            # and that our module was already
            # loaded
            no warnings;
            *{"${module}::$name"} = sub () { $value };
            delete $CHECKED_CONSTANTS{$module}->{$name};
        }
        else {
            # since this does not exist, then our
            # module may not have been loaded yet.
            # but in order to determine this,
            # we have to see if the constants have
            # been registered yet ...
            if (exists $CHECKED_CONSTANTS{$module}) {
                # this means our module was loaded first, and
                # the constants were registered. Now, if
                # we do not see this particular constant
                # in here, then we need to throw an exception
                die "Unknown constant for '$module' -> ($name)"
                    unless exists $CHECKED_CONSTANTS{$module}->{$name};
            }
            else {
                # being in this block means that is is unlikely
                # the conf has been loaded yet, so we will
                # just create our constants, and make a note
                # of each of them so that they can be
                # checked later on.
                $UNCHECKED_CONSTANTS{$module} = { $name => undef };
                *{"${module}::$name"} = sub () { $value };
            }
        }
    }
}


1;

__END__