Kann ich in Perl eine Methode vor dem Ausführen jeder Funktion in einem Paket aufrufen?

Question

Ich schreibe ein Modul und ich möchte ein bestimmtes Stück Code vor jeder der darin enthaltenen Funktionen ausführen.

Wie mache ich das?

Gibt es keinen anderen Weg als nur einen Funktionsaufruf zu Beginn jeder Funktion zu haben?

Answer 1

Sie können dies mit method modifiers in Moose tun:

package Example; 

use Moose; 

sub foo { 
    print "foo\n"; 
} 

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

ein Verfahren Wrapping ist auch möglich, mit method attributes, aber diese Route nicht in Perl gut genutzt und noch in der Entwicklung, so würde ich nicht empfehlen es. Für den normalen Gebrauch-Fällen würde ich einfach den gemeinsamen Code in einem anderen Verfahren setzen und sie an der Spitze der jede Ihrer Funktionen aufrufen:

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

Wenn Sie CPAN für ‚Haken‘ zu suchen, und dann verzweigen sich aus

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

Hier ist ein Beispiel mit Hook::LexWrap:, werden Sie mehrere Möglichkeiten, wie finden. Ich habe keine Erfahrung mit diesem Modul außer Debugging. Es hat zu diesem Zweck gut funktioniert.

# 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

Und für den Fall, fragt jemand, wie die Wirkung von Hook * Module oder Moose zu erreichen „vor“ explizit (zB welche tatsächlichen Perl Mechanismus kann es verwendet werden, zu tun), hier ein Beispiel:

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(); 

die Erklärung für das, was wir über „next“ Linie sind ausgenommen:

• „call_before“ natürlich ist der Name, den ich zu unserem „vor“ Beispiel Unter gab - müssen dies nur, wenn es tatsächlich ist definiert a s ein echtes Sub im gleichen Paket und nicht anonym oder Code-Ref von außerhalb des Pakets.

• import() hat eine spezielle Bedeutung und einen besonderen Zweck und sollte generell vom Szenario "Führen Sie dies vor jedem Sub" ausgeschlossen werden. YMMV.

• ___OLD_ ist ein Präfix, das wir "alten" Subs "umbenennen" geben - Sie müssen es hier nicht einfügen, es sei denn Sie sind besorgt, dass diese Schleife zweimal ausgeführt wird. Sicher ist sicher.

UPDATE: Unter Abschnitt über Verallgemeinerung nicht mehr relevant ist - am Ende der Antwort klebte ich ein allgemeines „before_after“ Paket genau die tun !!!

Die obige Schleife kann offensichtlich leicht verallgemeinern eine separat verpackte Subroutine zu sein, die als Argument nimmt:

• ein willkürliches Paket auf beliebige

• ein Code ref „vor“ Unterprogramm (oder wie Sie sehen können, nach)

• und eine Liste von Sub-Namen zum Ausschließen (oder Subref, die überprüft, ob ein Name ausgeschlossen werden soll) neben Standard auf es wie "importieren").

• ... und/oder eine Liste von Unternamen (oder Unterreferenzen, die prüfen, ob ein Name enthalten sein soll), abgesehen von Standardnamen wie "Import". Meine nimmt nur ALLE Subs in einem Paket.

HINWEIS: Ich weiß nicht, ob Moose „vor“ tut es auf diese Weise einfach. Was ich weiß ist, dass ich offensichtlich mit einer Standard-CPAN-Modul als mein eigenen gerade geschriebenen Code-Schnipsel, es sei denn gehen würde empfehlen:

1. Elch oder einer der Haken-Module kann nicht installiert werden und/oder sind zu schwer für Sie

2. Sie sind gut genug mit Perl, dass Sie den obigen Code lesen und auf Fehler analysieren können.

3. Sie mögen diesen Code sehr viel, und das Risiko von ihm über CPAN Zeug mit niedrig IYHO :)

ich es zu Informationszwecken mehr geliefert „so beschreiben die zugrunde liegende Arbeit getan ist“ Zwecke eher als praktische „verwenden, um dies in Ihrem Code-Basis“ Zwecke, obwohl fühlen Sie sich frei, es zu benutzen, wenn Sie :)

---

UPDATE

wünschen 0

Hier ist eine generische Ausführung wie bereits erwähnt:

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

das Aspect.pm Paket auf CPAN Siehe für aspektorientierte Computing.

vorher { Klasse-> Methode; } qr/^ Paket :: \ w + $ /;