File Coverage

blib/lib/Acme/Pr0n.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	10	10	100.0
condition	2	3	66.6
subroutine	4	4	100.0
pod			n/a
total	56	57	98.2

package Acme::Pr0n;

use strict;
use vars '$VERSION';

$VERSION = '0.04';

sub import
{
	my $caller = caller();

	no strict 'refs';

	for my $victim (@_)
	{
		( my $path = $victim ) =~ s[::][/]g;
		unless ( exists $INC{ $path . '.pm' } )
		{
			require Carp;
			Carp::croak("Some pervert is looking at unloaded module $victim!");
		}
		my $glob = *{"main::${victim}::"};

		unless ( exists $glob->{VERSION}
			and ${ *{ $glob->{VERSION} }{SCALAR} } >= 0.18 )
		{
			require Carp;
			Carp::carp( "Module '$victim' too young!" );
		}

		my @exportlists = grep { exists $glob->{$_} } qw( EXPORT EXPORT_OK );

		my %skip;
		@skip{ map { @{ *{ $glob->{$_} }{ARRAY} } } @exportlists } = ();

		for my $symbol ( keys %$glob )
		{
			for my $slots (
				[ 'CODE',   '&', '' ],
				[ 'SCALAR', '$' ],
				[ 'ARRAY',  '@' ],
				[ 'HASH',   '%' ],
				[ 'IO',     '*' ],
				)
			{
				my $slot      = shift @$slots;
				my $skip_slot = 0;
				while (@$slots)
				{
					$skip_slot = 1, last
						if exists $skip{ shift(@$slots) . $symbol };
				}
				next if $skip_slot;

				if ( defined( my $ref = *{ $glob->{$symbol} }{$slot} ) )
				{
					*{ $caller . "::$symbol" } = $ref;
				}
			}
		}
	}
}

1;

__END__