File Coverage

blib/lib/Devel/WarnGlobal.pm

Criterion	Covered	Total	%
statement	42	44	95.4
branch	6	10	60.0
condition			n/a
subroutine	9	9	100.0
pod			n/a
total	57	63	90.4

package Devel::WarnGlobal;

# ABSTRACT: Helps track down and eliminate globals

use strict;
use warnings;

our $VERSION = '0.09'; # VERSION

use Carp;

use Devel::WarnGlobal::Scalar;

sub import {
    no strict 'refs';

    my $type = shift;
    my (@var_ties) = @_;

    my $tie_params = $type->_rearrange(\@var_ties);

    while ( my ($var_name, $options) =  each %$tie_params ) {
	tie ${ $type->_fix_name($var_name) }, $type->_get_tie_type(), $options;
    }

    1;
}

sub _rearrange {
    my $type = shift;
    my ($var_ties_in) = @_;

    my @var_ties = @$var_ties_in;
    my %fixed_ties = ();

    while ( scalar @var_ties ) {
	my $var_name = shift @var_ties;
	my $var_arg = shift @var_ties;
	my %var_opts = ( name => $var_name );

	if (ref $var_arg eq 'ARRAY') {
	    $var_opts{'get'} = $var_arg->[0] if defined $var_arg->[0];
	    $var_opts{'set'} = $var_arg->[1] if defined $var_arg->[1];
	}
	elsif (ref $var_arg eq 'CODE') {
	    $var_opts{'get'} = $var_arg;
	}
	else {
	    croak("${$type}::import() called improperly; stopped");
	}
	$fixed_ties{$var_name} = \%var_opts;
    }

    return \%fixed_ties;
}

sub _get_tie_type {
    return 'Devel::WarnGlobal::Scalar';
}

sub _fix_name {
    my $type = shift;
    my ($var_name) = @_;

    my $var = substr($var_name, 1);

    $var_name =~ m{::} and return $var;

    return ( caller(2) )[0] . '::' . $var;
}

1;

__END__