在Perl中，我可以在執行包中的每個函數之前調用方法嗎？

Question

我正在寫一個模塊，我想要在它的每個函數之前執行一段特定的代碼。

我該怎麼做？

除了在每個函數的開頭只有一個函數調用，沒有別的辦法嗎？

Answer 1

您可以Moose與method modifiers做到這一點：

package Example; 

use Moose; 

sub foo { 
    print "foo\n"; 
} 

before 'foo' => sub { print "about to call foo\n"; }; 

包裝紙的方法也可以用method attributes，但在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(); 
    # ... 
} 

Answer 2

如果您搜索CPAN爲「鉤」，然後從那裏分支出來，您會發現幾個選項，例如：

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; 

Answer 3

而且，萬一有人不知道如何「之前」實現掛鉤*模塊或駝鹿的效果明確（例如什麼實際的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」當然是我給的名字我們的「前」的例子子 - 只需要這一點，如果它實際上是定義了一個在同一個軟件包中是一個真正的子組件，並且不是匿名的，也不是來自包之外的代碼。

• import（）有一個特殊的含義和用途，通常應該排除在「在每個子文件之前運行」場景中。因人而異。

• ___OLD_是一個前綴，我們將給「重命名」舊的潛艇 - 你不需要在這裏包括它，除非你擔心這個循環被執行兩次。比對不起更安全。

UPDATE：下面關於泛化部分不再適用 - 在回答最後我粘貼一般的「before_after」包正是這樣做！

環路上面顯然可以容易廣義是一個單獨包裝的子程序，它接受，作爲參數：

• 一個任意的包

• 一個代碼裁判任意「之前」子程序（或者你可以看到，之後）

• 和除了標準之外的要排除的子名稱列表（或者檢查是否排除名稱的子引用）像「進口」）。

• ...和/或要包括的子名稱列表（或者除了諸如「導入」之類的標準名稱之外將檢查是否要包括名稱的子引用）。我只需要一個包中的所有潛艇。

注意：我不知道是不是麋的「前」不只是這樣。我所知道的是，我明明建議用標準CPAN模塊比我自己剛剛寫好的代碼段去，除非：

1. 駝鹿或任何掛鉤的模塊不能安裝和/或者對你而言體重過重

2. 你用Perl足夠好，你可以閱讀上面的代碼並分析它的缺陷。

3. 你這樣的代碼非常多，並用它在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"); 
####################################################################### 

Answer 4

見Aspect.pm包上CPAN爲面向方面的計算。

前{ 類 - >方法; } qr/^ Package :: \ w + $ /;;