И, если кто-то задается вопросом, как добиться эффекта модулей Hook * или явно «до» Moose (например, какой фактический механизм 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" - это нужно только в том случае, если оно фактически определено как реальная подпрограмма в том же пакете, а не анонимно или ref-код извне пакета .
import () имеет особое значение и цель и обычно должен быть исключен из сценария «запускать перед каждым подпрограммой». YMMV.
___ OLD_ - это префикс, который мы дадим «переименованным» старым подпрограммам - вам не нужно включать его здесь, если вы не беспокоитесь о том, что этот цикл будет выполнен дважды. Лучше безопасно, чем потом сожалеть.
ОБНОВЛЕНИЕ : приведенный ниже раздел об обобщении больше не актуален - в конце ответа я вставил общий пакет "before_after", выполняя только это !!!
Вышеприведенный цикл, очевидно, может быть легко обобщенным , чтобы быть отдельно упакованной подпрограммой, которая принимает в качестве аргументов:
произвольный пакет
код ссылки на произвольную подпрограмму «до» (или, как вы можете видеть, после)
и список исключаемых подименов (или подреф, который проверяет, следует ли исключать имя), кроме стандартных, таких как "import").
... и / или список включаемых подименов (или подреф, который проверяет, должно ли быть включено имя), кроме стандартных, таких как "import"). Мой просто берет ВСЕ подводные лодки в пакете.
ПРИМЕЧАНИЕ : Я не знаю, делает ли «предыдущий» лось именно так. Что я знаю, так это то, что я бы порекомендовал использовать стандартный модуль CPAN, а не мой собственный только что написанный фрагмент, , если :
Moose или любой из модулей Hook не могут быть установлены и / или имеют слишком большой вес для вас
С Perl вы достаточно хороши, чтобы прочитать приведенный выше код и проанализировать его на предмет недостатков.
Вам очень нравится этот код, и риск его использования по сравнению с 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");
#######################################################################