package Example;
use Moose;
sub foo {
print "foo\n";
}
before 'foo' => sub { print "about to call foo\n"; };
使用方法属性也可以包装方法,但是这个路径在Perl中没有得到很好的使用,并且仍在不断发展,所以我不推荐它.对于正常的用例,我只需将公共代码放在另一个方法中,并在每个函数的顶部调用它:
Package MyApp::Foo;
sub do_common_stuff { ... }
sub method_one
{
my ($this, @args) = @_;
$this->do_common_stuff();
# ...
}
sub method_two
{
my ($this, @args) = @_;
$this->do_common_stuff();
# ...
}
并且,如果有人想知道如何明确地实现Hook*模块或Moose的"之前"的效果(例如,可以使用实际的Perl机制),这里是一个例子:
use strict;
package foo;
sub call_before { print "BEFORE\n"; } # This will be called before any sub
my $call_after = sub { print "AFTER - $_[0]\n"; };
sub fooBar { print "fooBar body\n\n"; }
sub fooBaz { print "fooBaz body\n\n"; }
no strict; # Wonder if we can get away without 'no strict'? Hate doing that!
foreach my $glob (keys %foo::) { # Iterate over symbol table of the package
next if not defined *{$foo::{$glob}}{CODE}; # Only subroutines needed
next if $glob eq "call_before" || $glob eq "import" || $glob =~ /^___OLD_/;
*{"foo::___OLD_$glob"} = \&{"foo::$glob"}; # Save original sub reference
*{"foo::$glob"} = sub {
call_before(@_); &{"foo::___OLD_$glob"}(@_); &$call_after(@_);
};
}
use strict;
1;
package main;
foo::fooBar();
foo::fooBaz();
通过"下一行"排除我们排除的内容:
"call_before"当然是我给"previous"示例子名称的名称 - 只有在实际定义为同一个包中的真实子而不是匿名或来自包外的代码引用时才需要这个.
import()具有特殊的含义和目的,通常应排除在"每个sub之前运行此"场景之外.因人而异.
___OLD_是我们将为"重命名"的旧子提供的前缀 - 除非您担心此循环执行两次,否则您不需要在此处包含它.比抱歉更安全.
更新:下面关于概括的部分不再相关 - 在答案的最后我贴了一个普通的"before_after"包就是这么做!
上面的循环显然可以很容易地推广为一个单独打包的子例程,它接受作为参数:
一个任意的包
代码引用任意"之前"子例程(或者你可以看到,之后)
和一个要排除的子名称列表(或用于检查是否要排除名称的子引用)除了"import"之类的标准名称.
...和/或要包括的子名称列表(或检查是否包含名称的子参考)除了"import"之类的标准名称.我只需要包装中的所有潜艇.
注意:我不知道Moose的"之前"是否就是这样做的.我所知道的是,我明显建议使用标准的CPAN模块而不是我自己刚编写的片段,除非:
驼鹿或任何Hook模块都无法安装和/或对您来说太重了
你对Perl足够好,你可以阅读上面的代码并分析它的缺陷.
你非常喜欢这个代码,并且使用CPAN的东西的风险很低IYHO :)
我提供了更多的信息"这是基础工作是如何完成"的目的而不是实际的"在你的代码库中使用它"的目的,但如果你愿意,可以随意使用:)
UPDATE
这是前面提到的更通用的版本:
#######################################################################
package before_after;
# Generic inserter of before/after wrapper code to all subs in any package.
# See below package "foo" for example of how to use.
my $default_prefix = "___OLD_";
my %used_prefixes = (); # To prevent multiple calls from stepping on each other
sub insert_before_after {
my ($package, $prefix, $before_code, $after_code
, $before_filter, $after_filter) = @_;
# filters are subs taking 2 args - subroutine name and package name.
# How the heck do I get the caller package without import() for a defalut?
$prefix ||= $default_prefix; # Also, default $before/after to sub {} ?
while ($used_prefixes{$prefix}) { $prefix = "_$prefix"; }; # Uniqueness
no strict;
foreach my $glob (keys %{$package . "::"}) {
next if not defined *{$package. "::$glob"}{CODE};
next if $glob =~ /import|__ANON__|BEGIN/; # Any otrher standard subs?
next if $glob =~ /^$prefix/; # Already done.
$before = (ref($before_filter) ne "CODE"
|| &$before_filter($glob, $package));
$after = (ref($after_filter) ne "CODE"
|| &$after_filter($glob, $package));
*{$package."::$prefix$glob"} = \&{$package . "::$glob"};
if ($before && $after) { # We do these ifs for performance gain only.
# Else, could wrap before/after calls in "if"
*{$package."::$glob"} = sub {
my $retval;
&$before_code(@_); # We don't save returns from before/after.
if (wantarray) {
$retval = [ &{$package . "::$prefix$glob"}(@_) ];
} else {
$retval = &{$package . "::$prefix$glob"}(@_);
}
&$after_code(@_);
return (wantarray && ref $retval eq 'ARRAY')
? @$retval : $retval;
};
} elsif ($before && !$after) {
*{$package . "::$glob"} = sub {
&$before_code(@_);
&{$package . "::$prefix$glob"}(@_);
};
} elsif (!$before && $after) {
*{$package . "::$glob"} = sub {
my $retval;
if (wantarray) {
$retval = [ &{$package . "::$prefix$glob"}(@_) ];
} else {
$retval = &{$package . "::$prefix$glob"}(@_);
}
&$after_code(@_);
return (wantarray && ref $retval eq 'ARRAY')
? @$retval : $retval;
};
}
}
use strict;
}
# May be add import() that calls insert_before_after()?
# The caller will just need "use before_after qq(args)".
1;
#######################################################################
package foo;
use strict;
sub call_before { print "BEFORE - $_[0]\n"; };
my $call_after = sub { print "AFTER - $_[0]\n"; };
sub fooBar { print "fooBar body - $_[0]\n\n"; };
sub fooBaz { print "fooBaz body - $_[0]\n\n"; };
sub fooBazNoB { print "fooBazNoB body - $_[0]\n\n"; };
sub fooBazNoA { print "fooBazNoA body - $_[0]\n\n"; };
sub fooBazNoBNoA { print "fooBazNoBNoA body - $_[0]\n\n"; };
before_after::insert_before_after(__PACKAGE__, undef
, \&call_before, $call_after
, sub { return 0 if $_[0] eq "call_before"; $_[0] !~ /NoB(NoA)?$/ }
, sub { return 0 if $_[0] eq "call_before"; $_[0] !~ /NoA$/ } );
1;
#######################################################################
package main;
use strict;
foo::fooBar("ARG1");
foo::fooBaz("ARG2");
foo::fooBazNoB("ARG3");
foo::fooBazNoA("ARG4");
foo::fooBazNoBNoA("ARG5");
#######################################################################