File Coverage

blib/lib/constant/our.pm

Criterion	Covered	Total	%
statement	58	61	95.0
branch	23	28	82.1
condition	7	15	46.6
subroutine	7	7	100.0
pod			n/a
total	95	111	85.5

package constant::our;

use warnings;
use strict;

=head1 NAME

constant::our - Perl pragma to declare constants like our vars

=head1 VERSION

Version 0.07
=cut

our $VERSION = '0.07';

use constant;
use Exporter;

our @EXPORT_OK;
our %values;
our %package_use;    # TODO tests
our %package_set;
our %package_set_implicitly;

my $reserved_text = "Reserved for " . __PACKAGE__;
our %reserved_constant = (
                           import                       => $reserved_text,
                           _constant_our_set            => $reserved_text,
                           _constant_our_check_reserved => $reserved_text,
);

################################################################################
sub import
{
    my ( $class, @args ) = @_;
    unless (@args)
    {
        return;
    }
    my ($caller_package) = caller;
    my $set_hash;

    if ( ref $args[0] )
    {
        $set_hash = shift @args;
        unless ( ref $set_hash eq 'HASH' && @args == 0 )
        {
            die __PACKAGE__ . " must call with one hash ref";
        }
        @_ = ( $class, keys %$set_hash );
        push @{ $package_set{$caller_package} }, keys %$set_hash;
    }
    else
    {
        push @{ $package_use{$caller_package} }, @args;
        foreach (@args)
        {
            if ( !exists $values{$_} )
            {
                push @{ $package_set_implicitly{$caller_package} }, $_;
                if ( exists $ENV{"CONSTANT_OUR_$_"} )
                {
                    $set_hash->{$_} = $ENV{"CONSTANT_OUR_$_"};
                }
                else
                {
                    $set_hash->{$_} = undef;
                }
            }
        }
    }
    if ( $set_hash && %$set_hash )
    {
        __PACKAGE__->_constant_our_set($set_hash);
    }
    goto &Exporter::import;
}
################################################################################
sub _constant_our_set
{
    my $class = shift;
    my %set;
    if ( ref $_[0] )
    {
        %set = %{ $_[0] };
    }
    else
    {
        %set = @_;
    }

    _constant_our_check_reserved( keys %set );
    foreach ( keys %set )
    {
        if ( exists $values{$_} )
        {
            my ( $package, $filename, $line ) = caller(1);
            my $error_place = "$package [$filename:$line]";
            if ( defined $values{$_} && defined $set{$_} && $values{$_} eq $set{$_} )
            {
                delete $set{$_};
            }
            elsif ( !defined $values{$_} && !defined $set{$_} )
            {
                delete $set{$_};
            }
            else
            {
                my $c1 = defined $values{$_} ? $values{$_} : "undef";
                my $c2 = defined $set{$_}    ? $set{$_}    : "undef";
                die "Declare a constant [$_] in 2 unmatched value: [$c1] and [$c2] at $error_place";
            }
            warn "Declare a constant [$_] again at $error_place. It's very BAD practice";
        }
        else
        {
            $values{$_} = $set{$_};
            push @EXPORT_OK, $_;
        }
    }

    if (%set)
    {
        __PACKAGE__->constant::import( \%set );
    }
}
################################################################################
sub _constant_our_check_reserved
{
    foreach (@_)
    {
        if ( exists $reserved_constant{$_} )
        {
            die "You can't use reserved constant[$_]: $reserved_constant{$_}";
        }
    }
}
################################################################################
1;    # End of constant::our

__END__