Kann ich in Perl eine Methode aufrufen, bevor ich jede Funktion in einem Paket ausführe?

Question

Ich schreibe ein Modul und möchte, dass ein bestimmtes Codestück vor jeder der darin enthaltenen Funktionen ausgeführt wird.

Wie kann ich das tun?

Gibt es keine andere Möglichkeit als einen Funktionsaufruf am Anfang jeder Funktion?

Answer 1

Sie können dies tun in Elch con Methoden-Modifikatoren :

package Example;

use Moose;

sub foo {
    print "foo\n";
}

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

Das Umschließen einer Methode ist auch möglich mit Methoden-Attribute aber dieser Weg ist in Perl nicht sehr verbreitet und befindet sich noch in der Entwicklung, daher würde ich ihn nicht empfehlen. Für normale Anwendungsfälle würde ich den gemeinsamen Code einfach in eine andere Methode packen und sie am Anfang jeder 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

Und falls sich jemand fragt, wie man den Effekt von Hook*-Modulen oder Moose's "before" explizit erreichen kann (z.B. welcher tatsächliche Perl-Mechanismus dafür verwendet werden kann), hier ist 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 die "nächste" Zeile ausschließen:

• "call_before" ist natürlich der Name, den ich unserem "before"-Beispiel-Sub gegeben habe - dies wird nur benötigt, wenn es tatsächlich als echter Sub im selben Paket definiert ist und nicht anonym oder als Code-Referenz von außerhalb des Pakets.

• import() hat eine besondere Bedeutung und einen besonderen Zweck und sollte im Allgemeinen vom Szenario "vor jedem Sub ausführen" ausgeschlossen werden. YMMV.

• ___OLD_ ist ein Präfix, das wir den "umbenannten" alten Subs geben werden - Sie müssen es hier nicht einfügen, es sei denn, Sie sind besorgt, dass diese Schleife zweimal ausgeführt wird. Vorsicht ist besser als Nachsicht.

UPDATE : Der untere Abschnitt über die Verallgemeinerung ist nicht mehr relevant - am Ende der Antwort habe ich ein allgemeines "Vorher-Nachher"-Paket eingefügt, das genau das tut !!!

Die obige Schleife kann natürlich auch leicht verallgemeinerbar ein separat verpacktes Unterprogramm sein, das als Argumente akzeptiert:

• ein beliebiges Paket

• eine Code-Referenz auf ein beliebiges "Vorher"-Unterprogramm (oder, wie Sie sehen können, nachher)

• und eine Liste der auszuschließenden Sub-Namen (oder eine Sub-Referenz, die prüft, ob ein Name auszuschließen ist), abgesehen von Standardnamen wie "import").

• ... und/oder eine Liste der einzuschließenden Sub-Namen (oder eine Sub-Referenz, die prüft, ob ein Name einzuschließen ist), abgesehen von Standardnamen wie "import"). Meiner nimmt einfach ALLE Unterprogramme in einem Paket.

NOTA : Ich weiß nicht, ob Moose's "vorher" es genau so macht. Was ich weiß, ist, dass ich natürlich empfehlen würde, ein Standard-CPAN-Modul zu verwenden, als mein eigenes, gerade geschriebenes Snippet, es sei denn, :

1. Moose oder eines der Hook-Module kann nicht installiert werden und/oder ist zu schwer für Sie

2. Sie kennen sich gut genug mit Perl aus, um den obigen Code zu lesen und ihn auf Fehler zu untersuchen.

3. Sie mögen diesen Code sehr, UND das Risiko der Verwendung über CPAN Zeug ist gering IYHO :)

Ich habe es mehr zu Informationszwecken zur Verfügung gestellt, um zu zeigen, wie die zugrundeliegende Arbeit gemacht wird, als zu praktischen Zwecken, um es in Ihrer Codebasis zu verwenden, aber Sie können es gerne verwenden, wenn Sie möchten :)

---

UPDATE

Hier ist eine allgemeinere Version, 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 3

Wenn Sie suchen CPAN nach "Haken" suchen und von dort aus verzweigen, finden Sie mehrere Optionen, wie z. B.:

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

Hier ist ein Beispiel mit Haken::LexWrap . Ich habe keine Erfahrung mit diesem Modul, außer bei der Fehlersuche. Zu diesem Zweck hat es 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 4

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

vor { Klasse->Methode; } qr/^Package:: \w +$/;