File Coverage

blib/lib/vars/i.pm

Criterion	Covered	Total	%
statement	55	55	100.0
branch	30	30	100.0
condition	6	6	100.0
subroutine	4	4	100.0
pod			n/a
total	95	95	100.0

package vars::i;
use 5.006;

our $VERSION = '1.10'; # TRIAL

use strict qw(vars subs);
use warnings;

sub import {
    return if @_ < 2;
    my( $pack, $var, @value ) = @_;
    my $callpack = caller;

    my %definitions;

    if( not @value ){
        if( ref $var ){     # E.g., use vars [ foo=>, bar=>... ];
            %definitions = @$var;
        } else {
            return;     # No value given --- no-op; not an error.
        }
    } elsif(@value == 1 && ref $value[0]) {     # E.g., use vars foo=>{}
        %definitions = ( $var => $value[0] );
    } else {
        %definitions = ( $var => [@value] );
    }

    for my $k( keys %definitions ){
        $var = $k;
        if( ref $definitions{$k} eq 'ARRAY' ){
            @value = @{ $definitions{$k} };
        }
        elsif( ref $definitions{$k} eq 'HASH' ){
            @value = %{ $definitions{$k} };
        }
        else {
            @value = $definitions{$k};
        }


        if( my( $ch, $sym ) = $var =~ /^([\$\@\%\*\&])(.+)$/ ){
            if( $sym !~ /^(\w+(::|'))+\w+$/ && $sym =~ /\W|(^\d+$)/ ){
                #    ^^ Skip fully-qualified names  ^^ Check special names

                # A variable name we can't or won't handle
                require Carp;

                if( $sym =~ /^\w+[[{].*[]}]$/ ){
                    Carp::croak("Can't declare individual elements of hash or array");
                }
                elsif( $sym =~ /^(\d+|\W|\^[\[\]A-Z\^_\?]|\{\^[a-zA-Z0-9]+\})$/ ){
                    Carp::croak("Refusing to initialize special variable $ch$sym");
                }
                else {
                    Carp::croak("I can't recognize $ch$sym as a variable name");
                }
            }

            $sym = "${callpack}::$sym" unless $sym =~ /::/;

            if( $ch eq '$' ){
                *{$sym} = \$$sym;
                (${$sym}) = @value;
            }
            elsif( $ch eq '@' ){
                *{$sym} = \@$sym;
                (@{$sym}) = @value;
            }
            elsif( $ch eq '%' ){
                *{$sym} = \%$sym;
                (%{$sym}) = @value;
            }
            elsif( $ch eq '*' ){
                *{$sym} = \*$sym;
                (*{$sym}) = shift @value;
            }
            else {   # $ch eq '&'; guaranteed by the regex above.
                *{$sym} = shift @value;
            }
            # There is no else, because the regex above guarantees
            # that $ch has one of the values we tested.

        } else {    # Name didn't match the regex above
            require Carp;
            Carp::croak("'$var' is not a valid variable name");
        }
    }
};

1;
__END__