File Coverage

blib/lib/Devel/UseAnyFunc.pm

Criterion	Covered	Total	%
statement	41	45	91.1
branch	10	18	55.5
condition	1	2	50.0
subroutine	7	7	100.0
pod			n/a
total	59	72	81.9

package Devel::UseAnyFunc;

use strict;
use vars qw($VERSION $DIGANOSTICS);
use Carp;

BEGIN {
  $VERSION = 1.00;
  $DIGANOSTICS ||= 0;
}

sub import {
  my ( $self, $name, @sources ) = @_;

  if ( $name eq '-isasubclass' ) {
    my $subclass = ( caller )[0];
    no strict 'refs';
    unshift @{"$subclass\::ISA"}, $self;
    return;
  }

  $name or croak( "$self called without a function name" );
  scalar(@sources) or croak("$self $name called without any function sources");
  scalar(@sources) % 2 and croak("$self name called with odd number of source ".
				 "arguments, should be key-value pairs" );

  # Find the first class in the caller() stack that's not a subclass of us
  my $target;
  my $i = 0;
  do { $target = ( caller($i ++) )[0] }
	while UNIVERSAL::isa($target, __PACKAGE__ );

  my @candidates = my %candidates = @sources;
  while ( my ($class, $function) = splice @candidates, 0, 2 ) {
    (my $pm = "$class.pm") =~ s{::}{/}g;
    warn "Attempting to load $pm...\n" if $DIGANOSTICS;
    eval { require $pm };
    if ( $@ ) { warn "Failed to load $pm: $@" if $DIGANOSTICS; next }
    warn "Installing $class\::$function as $target\::$name\n" if $DIGANOSTICS;
    no strict 'refs';
    return *{"$self\::$name"} = *{"$target\::$name"} =
			ref($function) ? $function : \&{"$class\::$function"};
  }
 croak( "Can't locate any module to provide $name: " .
			    join(', ', keys %candidates) . ")" )
}

1;

__END__