Можно ли перехватить вызовы метода Perl?

Ответ 1

Да, вы можете перехватить вызовы подпрограммы Perl. У меня есть целая глава об этом в Освоение Perl. Ознакомьтесь с модулем Hook:: LexWrap, который позволяет вам делать это, не просматривая все детали. Perl-методы - это просто подпрограммы.

Вы также можете создать подкласс и переопределить метод, который хотите поймать. Это немного лучший способ сделать это, потому что то, как объектно-ориентированное программирование хочет, чтобы вы с ним делали. Однако иногда люди пишут код, который не позволяет вам делать это правильно. Там больше об этом в Освоение Perl".

Ответ 2

Чтобы кратко описать, Perl обладает способностью изменять таблицу символов. Вы вызываете подпрограмму (метод) через таблицу символов пакета, к которой принадлежит метод. Если вы измените таблицу символов (и это не считается очень грязным), вы можете заменить большинство вызовов методов вызовом других методов, которые вы указали. Это демонстрирует подход:

# The subroutine we'll interrupt calls to
sub call_me
{
    print shift,"\n";
}

# Intercepting factory
sub aspectate
{
    my $callee = shift;
    my $value = shift;
    return sub { $callee->($value + shift); };
}
my $aspectated_call_me = aspectate \&call_me, 100;

# Rewrite symbol table of main package (lasts to the end of the block).
# Replace "main" with the name of the package (class) you're intercepting
local *main::call_me = $aspectated_call_me;

# Voila!  Prints 105!
call_me(5);

Это также показывает, что, как только кто-то получает ссылку на подпрограмму и вызывает ее через ссылку, вы больше не можете влиять на такие вызовы.

Я уверен, что в perl есть рамки для аксессуаров, но это, я надеюсь, демонстрирует подход.

Ответ 3

Это выглядит как работа для Moose! Moose - это объектная система для Perl, которая может это сделать и многое другое. docs будет намного лучше объяснять, чем я могу, но то, что вы, скорее всего, захотите, это Модификатор метода, в частности before.

Ответ 4

Вы можете, и Павел описывает хороший способ сделать это, но вы, вероятно, должны уточнить, почему вы хотите сделать это в первую очередь.

Если вы ищете расширенные способы перехвата вызовов произвольным подпрограммам, то работа с таблицами символов будет работать для вас, но если вы хотите добавить функциональность к функциям, возможно, экспортированным в пространство имен, в котором вы сейчас работаете, тогда вам может понадобиться знать способы вызова функций, которые существуют в других пространствах имен.

Данные:: Дампер, например, обычно экспортирует функцию "Дампер" в вызывающее пространство имен, но вы можете переопределить или отключить ее и предоставить свою собственную функцию Dumper, которая затем вызывает оригинал с полным именем.

например.

use Data::Dumper;

sub Dumper {
   warn 'Dumping variables';
   print Data::Dumper::Dumper(@_);
}

my $foo = {
   bar   => 'barval',
};

Dumper($foo);

Опять же, это альтернативное решение, которое может быть более подходящим в зависимости от исходной проблемы. При игре с таблицей символов можно весело провести время, но это может быть чрезмерным и может привести к сложному поддержанию кода, если он вам не нужен.

Ответ 5

Да.

Вам нужно три вещи:

Аргументы вызова находятся в @_, который является еще одной переменной с динамической областью.

Затем goto поддерживает аргумент reference-sub, который сохраняет текущий @_, но выполняет другой (хвостовой) вызов функции.

Наконец, local можно использовать для создания глобальных переменных с лексической привязкой, а таблицы символов похоронены в %::.

Итак, у вас есть:

sub foo {
    my($x,$y)=(@_);
    print "$x / $y = " . ((0.0+$x)/$y)."\n";
}
sub doit {
    foo(3,4);
}
doit();

который, конечно же, печатает:

3 / 4 = 0.75

Мы можем заменить foo на local и go:

my $oldfoo = \&foo;
local *foo = sub { (@_)=($_[1], $_[0]); goto $oldfoo; };
doit();

И теперь мы получаем:

4 / 3 = 1.33333333333333

Если вы хотите изменить *foo без использования его имени, и вы не хотите использовать eval, вы можете изменить его, манипулируя %::, например:

$::{"foo"} = sub { (@_)=($_[0], 1); goto $oldfoo; };
doit();

И теперь мы получаем:

3 / 1 = 3