在Perl中，我可以在执行包中的每个函数之前调用一个方法吗？

我正在编写一个模块，我希望在其中的每个函数之前执行一段特定的代码

我该怎么做

除了在每个函数的开头进行函数调用之外，没有其他方法了吗？

您可以通过以下方式完成此操作：

使用包装方法也是可能的，但是这种方法在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”，然后从那里进行分支，您将发现几个选项，例如：

Hook::WrapSub
Hook::PrePostCall
Hook::LexWrap
Sub::Prepend

下面是一个使用的示例。除了调试之外，我没有这个模块的经验。为此目的，它工作得很好

# 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;

---

如果有人想知道如何显式地实现Hook*模块或Moose的“before”的效果（例如，可以使用什么实际的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的名字，只有当它实际上被定义为同一个包中的真实sub，而不是匿名的或者来自包外的code ref时，才需要它

• import（）具有特殊的含义和用途，通常应排除在“在每个子项之前运行此项”场景之外。YMMV

• ___OLD_u是一个前缀，我们将给“重命名”的旧subs一个前缀-您不需要在这里包含它，除非您担心这个循环被执行两次。安全总比后悔好

更新：下面关于泛化的部分不再相关-在回答的末尾，我粘贴了一个“前后通用”的程序包，这样做

显然，上面的循环可以轻松地推广为一个单独打包的子例程，它接受以下参数：

• 任意包装

• 对任意“before”子例程的代码引用（或如您所见，after）

• 以及要排除的子名称列表（或检查是否要排除名称的子引用），以及标准名称（如“导入”）之外的子名称列表

• 。。。和/或除“导入”等标准名称外，要包含的子名称列表（或检查是否要包含名称的子引用）。我的只是把所有的潜艇装在一个包里

注意：我不知道驼鹿的“before”是否就是这样做的。我所知道的是，我显然建议使用标准的CPAN模块，而不是我自己刚刚编写的代码片段，，除非：

Moose或任何吊钩模块无法安装和/或对您来说太重

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");
#######################################################################

---

有关面向方面的计算，请参阅CPAN上的Aspect.pm包

以前{ 类->方法；

---

}qr/^Package:：\w+$/

让你的模块面向对象怎么样？我认识的一个很酷的家伙写了一篇关于这个主题的好文章：同意do_common_stuff方法，对于不是Moose专家的其他维护人员来说，这会容易得多。您不需要手动执行常见的操作-请参阅我的答案，了解如何在不使用Moose或属性的情况下实现相同的效果。@顺便说一句，如果有人对此代码有批评/改进建议，请大声说出来。谢谢您这么做。我试着做类似的事情；失败；然后求助于see CPAN的回答。我一直在努力学习高阶Perl，所以这些天来，我对理解类似的事情是很感兴趣的。@FM-欢迎：）这类东西是我非常喜欢用Perl开发的主要原因之一：）顺便说一句，我同时使用include和exclude过滤器的原因是历史-原始版本有include/exclude列表：），所以。。。从这方面的发展来看，这只是我一开始所说的一个很好的证明：“我显然建议使用标准的CPAN模块，而不是我自己刚刚编写的代码片段”。

#######################################################################
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");
#######################################################################