File Coverage

blib/lib/pluskeys.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	2	4	50.0
condition			n/a
subroutine	11	11	100.0
pod			n/a
total	48	50	96.0

package pluskeys;

use strict;
use warnings;

use Carp;

our($VERSION) = q($Revision: 2.4 $) =~ / \b ( \d+ (?: \. \d+ )+ ) \b /x;

my $My_Package = __PACKAGE__;

sub import {
    shift; # discard "pluskeys" invocant

#################################################################
# Create named constants in caller's package so they
# can be used to access munged member names with +NAME
# which both catches typos and adds package-name munging so
# that more than one class in a hierarchy can have a key
# with the same name.
#
# Must be called from a BEGIN block to do any good. That's
# why it is a use statement, since that has a BEGIN blocked
# wrapped around it.
#################################################################

    for my $member (@_) {
        # Has to start with a letter or an underscore, and be one
        # or more identifier characters long and nothing else.
        $member =~ / ^ (?= [\p{Letter}_] ) \w+ $ /x
            || croak "Bad pluskey: '$member' is not a valid identifier";

        my $his_package = caller;

        eval <<"MAKE_A_MEMBER_CONSTANT" || croak "member init of $member failed: $@";
            package $his_package;
            use constant $member => ${My_Package}::_mk_safe_member('$member');
            1;
MAKE_A_MEMBER_CONSTANT
    }
}

sub _mk_safe_member($) {
    my($member_name) = @_;
    my $his_package = caller;
    return $his_package . "::" . $member_name;
}

1;

__END__