假设我已经拥有包含多个子例程的Child
包和Parent
包。这两个包通过聚合组合在一起,就像perltoot
:
use warnings;
use strict;
package Child;
sub new {
my ($class, %arg) = @_;
return bless { %arg }, $class;
}
sub method_x {
warn 'call method x';
}
sub method_y {
warn 'call method y';
}
sub method_z {
warn 'call method z';
}
1;
package Parent;
sub new {
my ($class, %arg) = @_;
return bless {
child => undef,
%arg,
}, $class;
}
sub child { shift->{child} }
sub x { shift->child->method_x(@_) }
sub y { shift->child->method_y(@_) }
sub z { shift->child->method_z(@_) }
sub _callback {
warn "I want to kick this callback after every child methods.";
}
1;
package main;
my $p = Parent->new(
child => Child->new,
);
$p->x;
$p->y;
$p->z;
1;
过了一段时间,我想为每个_callback
的方法踢Child
,我惊呆了,我试图将这个回调添加到每个包装器方法(x
/ {{ 1}} / y
)。
我能更优雅地完成这项工作吗?我是否必须在开始时为包提供更多灵活性?怎么样?
感谢任何建议。
答案 0 :(得分:6)
一种可能性是使用方法修饰符,它们由 Moose 或 Moo 等对象系统提供:
use strict; use warnings;
package Child {
use Moose;
sub method_x { warn "call method_x" }
sub method_y { warn "call method_y" }
sub method_z { warn "call method_z" }
}
package Parent {
use Moose;
has child => (is => 'rw');
sub x { shift->child->method_x(@_) }
sub y { shift->child->method_y(@_) }
sub z { shift->child->method_z(@_) }
# A method modifier in action
after [qw/ x y z /] => sub {
warn "called after every Parent (!) invocation";
};
}
my $p = Parent->new(child => Child->new);
$p->x; $p->y; $p->z;
输出:
call method_x at - line 7.
called after every Parent (!) invocation at - line 23.
call method_y at - line 8.
called after every Parent (!) invocation at - line 23.
call method_z at - line 9.
called after every Parent (!) invocation at - line 23.
如果你真的希望包装所有 Child
的方法,请使用子类:
package WrappedChild {
use Moose;
extends 'Child';
# the /(?=)/ regex matches always
after qr/(?=)/ => sub {
warn "called after each method in Child";
};
}
my $p = Parent->new(child => WrappedChild->new);
$p->x; $p->y; $p->z;
这会产生
called after each method in Child at - line 32.
called after each method in Child at - line 32.
called after each method in Child at - line 32.
called after each method in Child at - line 32.
called after each method in Child at - line 32.
called after each method in Child at - line 32.
call method_x at - line 7.
called after each method in Child at - line 32.
called after every Parent (!) invocation at - line 22.
call method_y at - line 8.
called after each method in Child at - line 32.
called after every Parent (!) invocation at - line 22.
call method_z at - line 9.
called after each method in Child at - line 32.
called after every Parent (!) invocation at - line 22.
called after each method in Child at - line 32.
called after each method in Child at - line 32.
called after each method in Child at - line 32.
可能有点过分。坚持使用明确的名称可能更合适。
有关详细信息,请参阅Moose::Manual::MethodModifiers
。
如果您不想使用任何模块,可以通过 jungle 符号表进行破解:
for my $name (qw/method_x method_y method_z/) {
no strict 'refs';
no warnings 'redefine';
my $orig = \&{"Child::$name"};
*{"Child::$name} = sub {
my @return_values = wantarray ? $orig->() : scalar $orig->();
warn "called after each method";
return wantarray ? @return_values : $return_values[0];
};
}
输出:
call method_x at - line 7.
called after each method at - line 31.
call method_y at - line 8.
called after each method at - line 31.
call method_z at - line 9.
called after each method at - line 31.
答案 1 :(得分:4)
package Wrapper;
use strict;
use warnings;
use Carp qw( );
sub wrap {
my ($cb, $o) = @_;
return bless({
o => $o,
cb => $cb,
});
}
sub AUTOLOAD {
my $self = shift;
my $o = $self->{o};
my $cb = $self->{cb};
my ($method) = our $AUTOLOAD =~ /^.*::(.*)\z/;
my $sub = ;
if (!$o->can($method) && !$o->can("AUTOLOAD")) {
my $package = ref($o);
Carp::croak("Can't locate object method \"$method\" via package \"$pkg\"");
}
if (wantarray) {
my @rv = $object->$method(@_);
$cb->($method, @_);
return @rv;
}
elsif (defined(wantarray)) {
my $rv = $object->$method(@_);
$cb->($method, @_);
return $rv;
}
else {
$object->$method(@_);
$cb->($method, @_);
return;
}
}
my $w = wrap(sub { warn "Returning from $_[0]\n" }, Child->new);
$w->x; $w->y; $w->z;