| Subject: | ignoring global coderefs |
| Date: | Thu, 21 Jan 2010 08:26:21 +1100 |
| To: | bug-Test-Weaken [...] rt.cpan.org |
| From: | Kevin Ryde <user42 [...] zip.com.au> |
I think I've mentioned this before, but if I make a separate ticket it
won't be lost.
Now coderefs are tracked, it'd be good if there was a way to ignore
global functions that appear in objects as callbacks etc, like
\&Foo::Bar::somefunc, a package function expected to be permanent.
my $obj = { callback_func => \&somefunc,
... };
The best could be to ignore as permanent any coderef which appears as a
function in any package. But that would require searching through
everything and could be slow and would want protection against crazy
circular stashes (arising from aliasing, or botched aliasing!).
I got to three alternatives below. The "sub foo {}" one is easiest to
use, but it doesn't work on constructed "*foo=sub{}" things as they
don't acquire a name from an assignment. The particular named functions
one is the tightest, but it'd be bad to hard code names that a
sub-object might use for private purposes. The whole-package approach
is better for that, but still imperfect.
# =item C<$bool = Test::Weaken::Gtk2::ignore_global_function ($ref)>
#
# Return true if C<$ref> is a coderef to a global function like C<sub foo {}>.
#
# A global is identified by the coderef having a name, and the current
# function under that name equal to this coderef. Plain functions created
# as C<sub foo {}> etc work, but redefinitions or function-creating modules
# like C<Memoize> or C<constant> generally don't.
#
# For reference, the name in a coderef is basically just a string from its
# original creation. C<Memoize> and similar end up with anonymous
# functions, and C<constant> only ends up with a name under the scalar in
# symtab optimization.
#
sub ignore_global_function {
my ($ref) = @_;
ref $ref eq 'CODE' or return;
# could use Sub::Identify, but B comes with perl already
require B;
my $cv = B::svref_2object($ref);
my $gv = $cv->GV;
# as per Sub::Identify, for some sort of undefined GV
return if $gv->isa('B::SPECIAL');
my $fullname = $gv->STASH->NAME . '::' . $gv->NAME;
# Test::More::diag "ignore_global_function() fullname $fullname";
return (defined &$fullname && $ref == \&$fullname);
}
# =item C<$bool = ignore_function ($ref, $funcname, $funcname, ...)>
#
# Return true if C<$ref> is a coderef to any of the given named functions.
#
# Each C<$funcname> is a fully-qualified string like C<Foo::Bar::somefunc>.
# If a function doesn't exist then it's skipped, so it doesn't matter if the
# C<Foo::Bar> package is actually loaded yet, etc.
#
sub ignore_function {
my $ref = shift;
ref $ref eq 'CODE' or return;
while (@_) {
my $funcname = shift;
if (defined &$funcname && $ref == \&$funcname) {
return 1;
}
}
return 0;
}
# =item C<$bool = ignore_module_functions ($ref, $module, $module, ...)>
#
# Return true if C<$ref> is a coderef to any function in any of the given
# modules.
#
# Each C<$module> is a string like C<My::Module>. If a module doesn't exist
# then it's skipped, so it doesn't matter if the C<My::Module> package is
# actually loaded yet.
#
sub ignore_module_functions {
my $ref = shift;
ref $ref eq 'CODE' or return;
while (@_) {
my $module = shift;
my $symtabname = "${module}::";
no strict 'refs';
defined %$symtabname or next;
foreach my $name (keys %$symtabname) {
my $fullname = "${module}::$name";
if (defined &$fullname && $ref == \&$fullname) {
return 1;
}
}
}
return 0;
}