Dans Perl, puis-je appeler une méthode avant d'exécuter toutes les fonctions dans un paquet?

Vous pouvez le faire dans Moose avec Modificateurs de méthode :

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();
    # ...
}

Si vous recherchez CPAN pour 'Hook', puis sur la branche de là, vous trouverez plusieurs Options, telles que:

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

Et, au cas où quelqu'un se demande comment atteindre l'effet des modules * des modules ou de l'orignal "avant" explicitement (par exemple, quel mécanisme perl réel peut être utilisé pour le faire), voici un exemple:

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

• "call_before" est bien sûr le nom que j'ai donné à notre exemple "avant" Sub - seulement besoin de cela s'il est défini comme un sous réel dans le même paquet et non anonymement ou code Ref de l'extérieur du colis . P> li>

• importation () a une signification et un objectif particulier et devrait généralement être exclu de "exécuter ceci avant chaque sous-sol". Ymmv. P> li>

• ___ old_ est un préfixe que nous donnerons à "renommé" olfs Subs - Vous n'avez pas besoin d'y inclure ici, à moins que vous n'ayez été inquiet à propos de cette boucle en cours d'exécution deux fois. Mieux vaut sûr que désolé. P> li> ul>

  Mise à jour forte>: ci-dessous section sur la généralisation n'est plus pertinente - à la fin de la réponse, j'ai collé un paquet général "avant_after" faisant juste que strong>! !! / p>

  La boucle ci-dessus peut évidemment être facilement généralisée forte> être un sous-programme emballé séparément qui accepte, comme des arguments: p>

  • Un package arbitraire p> li>

  • Un code Ref to arbitraire "avant" le sous-programme (ou comme vous pouvez le voir, après) p> li>

  • et une liste de sous-noms à exclure (ou sous-référence qui vérifie si un nom doit être exclu) de côté des standards tels que "Importer"). P> LI>

  • ... et / ou une liste de sous-noms à inclure (ou sous-référence qui vérifie si un nom doit être inclus) à part ceux standard tels que "Import"). Le mien prend juste tous les sous-marins dans un colis. P> li> ul>

    note strong>: Je ne sais pas si Moose's "avant" le fait exactement de cette façon. Ce que je sais, c'est que je recommanderais évidemment d'aller avec un module CPAN standard que mon propre extrait juste écrit, à moins que fort>: p>

    1. L'orignal ou l'un des modules de crochet ne peut pas être installé et / ou sont trop lourds pour vous P> LI>

    2. Vous êtes assez bon avec Perl que vous pouvez lire le code ci-dessus et l'analyser pour des défauts. p> li>

    3. Vous aimez beaucoup ce code, et le risque de l'utiliser sur cpan Stuff est faible IYHO :) p> li> OL>

       Je l'ai fourni plus pour information "C'est ainsi que le travail sous-jacent est effectué" des fins plutôt que pratiques "l'utiliser dans vos fins de codebase", bien que vous n'hésitez pas à l'utiliser si vous le souhaitez :) P >

       ---

       update strong> p>

       Voici une version plus générique comme mentionné précédemment: p>

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