Есть ли способ перегрузить оператор связывания регулярного выражения `= ~` в Perl? - PullRequest
Новая
       39

Есть ли способ перегрузить оператор связывания регулярного выражения `= ~` в Perl?

18 голосов
/ 14 сентября 2010

Я работаю над небольшим DSL, который использует откат nomethod для перегрузки для захвата операторов, используемых для перегруженных значений.Это похоже на функцию символьного калькулятора , описанного в документации overload.

Это прекрасно работает для стандартных операторов сравнения, но учтите следующее: 

my $ret = $overloaded =~ /regex/;

В этом случае nomethod вызывается для строкового $overloaded, и после этого перегрузка теряется.Я думал о возвращении связанной переменной, которая, по крайней мере, позволит мне носить с собой исходный перегруженный объект, но все равно будет потеряна во время выполнения регулярного выражения.

Итак, последний вопрос - есть лиспособ расширить представление overload о символьном калькуляторе, включив в него операторы привязки регулярных выражений =~ и !~, чтобы приведенный выше пример кода вызывал nomethod с ($overloaded, qr/regex/, 0, '=~') или чем-то подобным?

Я также кратко рассмотрел перегрузку оператора smartmatch ~~, но, похоже, это тоже не помогло (всегда по умолчанию используется сопоставление с регулярным выражением, а не перегрузка).

Редактировать: я изучил ~~и обнаружил, что my $ret = $overloaded ~~ q/regex/ работает из-за правил smartmatching.Близкое, но не идеальное решение, и я хотел бы, чтобы оно работало до 5.10, поэтому я приветствую другие ответы.

1 Ответ

2 голосов
/ 16 сентября 2010

Мне кажется, что DSL лучше всего писать с исходными фильтрами в perl. Вы можете буквально делать все, что вы хотите. ;-) В вашем примере вы можете регулярное выражение заменить FOO = ~ BAR на myfunc (FOO, BAR) и запустить произвольный код.

Вот пример решения: 

# THE "MyLang" SOURCE FILTER
package MyLang;
use strict;
use warnings;
use Filter::Util::Call;

sub import {
    my ($type, @args) = @_;
    my %p = @args;
    no strict 'refs';
    my $caller = caller;
    # Create the function to call
    *{"${caller}::_mylang_defaultmethod"} = sub {
        my ($a, $op, $b) = @_;
        $p{nomethod}->($a, $b, 0, $op);
    };
    my ($ref) = [];
    filter_add(bless $ref);
}

sub filter {
    my ($self) = @_;
    my ($status);
    if ($status = filter_read() > 0) {
        $_ =~ s/([^=]+)(=~)([^;]+)/ _mylang_defaultmethod($1,'$2',$3)/g;
    }
    $status;
}

1;

ПРИМЕР ИСПОЛЬЗОВАНИЯ 

use MyLang nomethod => \&mywrap;

my $a = "foo";
my $b = "bar";
$x = $a =~ $b;

sub mywrap {
   my ($a, $b, $inv, $op) = @_;
   print "$a\n";
}

Теперь вышеприведенное выведет «foo \ n», поскольку оно находится в переменной «$ a». Конечно, вы можете захотеть сделать немного более интеллектуальный анализ для замены регулярного выражения в фильтре, но это простое доказательство концепции.

...