File Coverage

blib/lib/vars/i.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	38	38	100.0
condition	3	3	100.0
subroutine	5	5	100.0
pod			n/a
total	107	107	100.0

package vars::i;
use 5.006001;

our $VERSION = '1.900000';  # Prerelease leading to v2.0.0

use strict qw(vars subs);
use warnings;

# Turn a scalar, arrayref, or hashref into a list
sub _unpack {
    if( ref $_[0] eq 'ARRAY' ){
        return @{$_[0]};
    }
    elsif( ref $_[0] eq 'HASH' ){
        return %{$_[0]};
    }
    else {
        return ($_[0]);
    }
} #_unpack

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

    my %definitions;

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

    #require Data::Dumper;   # For debugging
    #print Data::Dumper->Dump([\%definitions], ['definitions']);

    while( my ($var, $val) = each %definitions ){

        if( my( $ch, $sym ) = $var =~ /^([-\$\@\%\*\&])(.+)$/ ){
            if( $ch eq '-' ){   # An option
                require Carp;
                Carp::croak('vars::i does not yet support any options!');
            }
            elsif( $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} = $val;
            }
            elsif( $ch eq '@' ){
                *{$sym} = \@$sym;
                @{$sym} = _unpack $val;
            }
            elsif( $ch eq '%' ){
                *{$sym} = \%$sym;
                %{$sym} = _unpack $val;
            }
            elsif( $ch eq '*' ){
                *{$sym} = \*$sym;
                (*{$sym}) = $val;
            }
            else {   # $ch eq '&'; guaranteed by the regex above.
                my ($param) = $val;
                if(ref $param) {
                    # NOTE: for now, permit any ref, since we can't determine
                    # refs overload &{}.  If necessary, we can later use
                    # Scalar::Util 1.25+'s blessed(), and allow CODE refs
                    # or blessed refs.
                    *{$sym} = $param;
                }
                else {
                    require Carp;
                    Carp::croak("Can't assign non-reference " .
                        (defined($param) ? $param : '') .
                        " to $sym");
                }
            }
            # 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 or option name");
        }
    }
} #import()

1;
__END__