В Perl я могу вызвать метод перед выполнением каждой функции в пакете?
Я пишу модуль, и я хочу, чтобы конкретный фрагмент кода выполнялся перед каждой из функций в нем.
Как это сделать?
Нет ли другого способа, кроме как просто вызвать вызов функции в начале каждой функции?
Ответы
Ответ 1
Вы можете сделать это в Moose с помощью модификаторов метода:
package Example;
use Moose;
sub foo {
print "foo\n";
}
before 'foo' => sub { print "about to call foo\n"; };
Обертка метода также возможна с атрибутами , но этот маршрут не используется в 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();
# ...
}
Ответ 2
И, если кто-то задается вопросом, как явно реализовать эффект модулей 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" - это, конечно же, имя, которое я дал нашему "до" примеру, - это нужно только в том случае, если оно фактически определено как реальный sub в том же пакете, а не анонимно или код из-за пределов пакета.
-
import() имеет особое значение и цель и обычно должен быть исключен из сценария "запускать это перед каждым вспомогательным". YMMV.
-
___ OLD_ - префикс, который мы передадим "переименованным" старым подписчикам - вам не нужно включать его сюда, если вы не беспокоитесь о том, что этот цикл выполняется дважды. Лучше, чем сожалеть.
ОБНОВЛЕНИЕ: ниже раздел об обобщении больше не имеет значения - в конце ответа. Я вставил общий пакет "before_after", выполнив именно это!!! p >
Цикл выше, очевидно, может быть легко обобщен как отдельно упакованная подпрограмма, которая принимает в качестве аргументов:
-
произвольный пакет
-
код ref для произвольной подпрограммы "до" (или, как вы можете видеть, после)
-
и список подзаголовков для исключения (или подрефиля, который проверяет, следует ли исключать имя), кроме стандартных, таких как "импорт" ).
-
... и/или список подзаголовков для включения (или подрефиля, который проверяет, следует ли включать имя), помимо стандартных, например "импорт" ). Mine просто берет ВСЕ субтитры в пакете.
ПРИМЕЧАНИЕ. Я не знаю, действительно ли Moose "before" делает это именно так. Я знаю, что я, очевидно, рекомендую перейти со стандартным модулем CPAN, чем мой собственный только что написанный фрагмент, , если:
-
Лось или любой из модулей 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");
#######################################################################
Ответ 3
См. пакет Aspect.pm в CPAN для аспектно-ориентированных вычислений.
до { Class- > метод;
} qr/^ Пакет::\w + $/;
Ответ 4
Если вы выполните поиск CPAN для 'hook', а затем откройте его, вы найдете несколько параметров, таких как
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;
