No problems :) All I did was grok the symbol table for the name of the glob, whereas
Symbol's
qualify_to_ref simply uses perl's symbolic lookup
use strict;
{
package Foo;
use warnings;
use warnings::register;
sub foo { print "Foo!\n" };
sub import {
my $cur = shift;
my $dest = caller;
for my $g (grep $cur->can($_), @_) {
warnings::warnif("sub '$g' already exists in $dest") and next
if $dest->can($g);
my($dest, $src) = map qualify_to_ref("$_\::$g"), $dest, $cur;
*$dest = *$src;
}
}
# This is what we need from Symbol to provide the qualify_to_ref fun
+ction
my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN
+STDOUT);
sub qualify ($;$) {
my ($name) = @_;
if (!ref($name) && index($name, '::') == -1 && index($name, "'")
+ == -1) {
my $pkg;
# Global names: special character, "^x", or other.
if ($name =~ /^([^a-z])|(\^[a-z])$/i || $global{$name}) {
$pkg = "main";
}
else {
$pkg = (@_ > 1) ? $_[1] : caller;
}
$name = $pkg . "::" . $name;
}
$name;
}
sub qualify_to_ref ($;$) {
my @pkgs = split '::', qualify $_[0], @_ > 1 ? $_[1] : caller;
my $tbl = \%main::;
$tbl = $tbl->{"$_\::"}
for @pkgs[0 .. $#pkgs - 1];
return \$tbl->{$pkgs[-1]};
}
}
Foo->import('foo');
foo();
__output__
Foo!