Skip to content

Commit

Permalink
wrap any existing import in Attribute::Handlers' injected import
Browse files Browse the repository at this point in the history
Some modules using Attribute::Handlers autotie feature have their own
import method. When injecting an import method, attempt to wrap anything
that exists, either in the class directly or in a parent class.

We can't detect parent classes at injection time, because @isa may
change, and this is actually common since users of Exporter will add it
as a parent class at module runtime, while Attribute::Handlers injection
would happen first during compilation.

A better approach could involve using next::can from mro, but that also
requires Sub::Util::set_subname, and Attribute::Handlers is dual life
and currently supports 5.6.
  • Loading branch information
haarg committed Mar 1, 2022
1 parent 5fd4557 commit 5e880b1
Showing 1 changed file with 20 additions and 7 deletions.
27 changes: 20 additions & 7 deletions dist/Attribute-Handlers/lib/Attribute/Handlers.pm
Expand Up @@ -88,13 +88,26 @@ sub import {

if ($attr =~ /\A__CALLER__::/) {
no strict 'refs';
*{ caller . '::import' } = sub {
my $caller = caller;
my $full_attr = $attr;
$full_attr =~ s/__CALLER__/$caller/;
eval qq{ sub $full_attr $code 1; }
or die "Internal error: $@";

my $add_import = caller;
my $next = defined &{ $add_import . '::import' } && \&{ $add_import . '::import' };
*{ $add_import . '::import' } = sub {
my $caller = caller;
my $full_attr = $attr;
$full_attr =~ s/__CALLER__/$caller/;
eval qq{ sub $full_attr $code 1; }
or die "Internal error: $@";

goto &$next
if $next;
my $uni = defined &UNIVERSAL::import && \&UNIVERSAL::import;
for my $isa (@{ $add_import . '::ISA' }) {
if (my $import = $isa->can('import')) {
goto &$import
if $import != $uni;
}
}
goto &$uni
if $uni;
};
}
else {
Expand Down

0 comments on commit 5e880b1

Please sign in to comment.