File Coverage

blib/lib/Acme/CXW/vars/i.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	28	28	100.0
condition	3	3	100.0
subroutine	3	3	100.0
pod			n/a
total	85	85	100.0

# I basically took vars.pm, and turned it into vars/i.pm

package Acme::CXW::vars::i;
use 5.006;

our $VERSION = '1.04'; # TRIAL

# yuck
=for IT DOESN'T WORK nor is it important (try perl -Mstrict -Mwarnings=all -We"use vars q[$a];")
BEGIN {
    eval q{
use warnings::register;
    };
    eval q{
sub warnings::enabled { return $^W; }
    } if $@;
}
=cut

use strict qw(vars subs);

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

    my %stuff;

    if( not @value ){
        if( ref $var ){
            %stuff = @$var;
        } else {
            return;     # No value given --- no-op; not an error.
        }
    } else {
        %stuff = ( $var, [@value] );
    }

    for my $k( keys %stuff ){
        $var = $k;
        if( ref $stuff{$k} eq 'ARRAY' ){
            @value = @{ $stuff{$k} };
        }
        elsif( ref $stuff{$k} eq 'HASH' ){
            @value = %{ $stuff{$k} };
        }
        else {
            @value = $stuff{$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__