我正在编写一个模块，我希望在其中的每个函数之前执行一段特定的代码。
我该怎么做？
除了在每个函数的开头都有一个函数调用之外没有其他方法吗？
答案 0 :(得分：7)
您可以Moose使用method modifiers：
在method attributes中执行此操作package Example;
use Moose;
sub foo {
print "foo\n";
}
before 'foo' => sub { print "about to call foo\n"; };
使用{{3}}也可以包装方法，但是这条路径在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();
# ...
}
答案 1 :(得分：5)
并且，如果有人想知道如何明确地实现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”当然是我给“before”示例子名称的名称 - 如果它实际上被定义为同一个包中的真实sub而不是匿名或者来自包外的代码ref，则只需要这个名称
import（）具有特殊含义和目的，通常应从“在每个子场之前运行此”场景中排除。 YMMV。
___ OLD_是我们将给“重命名”的旧子队列的前缀 - 你不需要在这里包含它，除非你担心这个循环被执行两次。比抱歉更安全。
更新：以下关于概括的部分已不再相关 - 在答案结尾处我粘贴了一般“before_after”程序包 !!!
上面的循环显然可以容易推广成为一个单独打包的子程序，它接受作为参数：
任意包
代码引用任意“之前”子程序（或者你可以看到，之后）
以及要排除的子名称列表（或用于检查是否要排除名称的子引用），而不是像“import”这样的标准名称。
...和/或要包括的子名称列表（或检查是否包含名称的子参考），除了“import”之类的标准名称。我只需要包装中的所有潜艇。
注意：我不知道Moose的“之前”是否就是这样做的。我所知道的是，我明显建议使用标准的CPAN模块，而不是我自己刚编写的片段，除非：
无法安装驼鹿或任何Hook模块和/或重量太重
你对Perl足够好，你可以阅读上面的代码并分析它的缺陷。
你非常喜欢这段代码，而且使用它而不是CPAN的风险很低IYHO：）
我提供了更多用于提供信息“这是基础工作的完成方式”的目的，而不是实际的“在你的代码库中使用它”的目的，尽管如果你愿意，可以随意使用它：）
<强>更新
这是前面提到的更通用的版本：
#######################################################################
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");
#######################################################################
答案 2 :(得分：3)
如果你在CPAN搜索'hook'，然后从那里分支出来，你会发现几个选项，例如：
Hook::WrapSub
Hook::PrePostCall
Hook::LexWrap
Sub::Prepend
以下是使用Hook::LexWrap的示例。除了调试之外，我没有这个模块的经验。它为此目的工作得很好。
# In Frob.pm
package Frob;
sub new { bless {}, shift }
sub foo { print "foo()\n" }
sub bar { print "bar()\n" }
sub pre { print "pre()\n" }
use Hook::LexWrap qw(wrap);
my @wrappable_methods = qw(foo bar);
sub wrap_em {
wrap($_, pre => \&pre) for @wrappable_methods;
}
# In script.pl
use Frob;
my $frob = Frob->new;
print "\nOrig:\n";
$frob->foo;
$frob->bar;
print "\nWrapped:\n";
Frob->wrap_em();
$frob->foo;
$frob->bar;
答案 3 :(得分：3)
请参阅CPAN上的Aspect.pm包以进行面向方面的计算。
{p>之前{ 讲座＆GT;方法; } qr / ^ Package :: \ w + $ /;