Почему моя перегрузка:: константа не срабатывает при использовании строковой переменной?

Я пытаюсь константы перегрузки в регулярных выражениях. Вот мой пакет Tagger:

package Tagger;
use overload;

sub import { overload::constant 'qr' => \&convert }

sub convert {
    my $re = shift;
    $re =~ s/\\nom/((?:[A-Z]{1}[a-z]+\\s*){2,3}(\\((\\w|\\s)+\\)+?)*)/xg;
    return $re;
}

1;

Вот подпрограмма, в которой я хотел бы вызвать перегрузку:

sub ChopPattern {
    my $string= shift;
    my $pattern = shift;

    if($string =~ m/$pattern/) {
        $string =~ s/$&/ /g;
        return ($string, $&);
    } else {
        return ($string, '');
    }
}

Вот мой тест:

$test = "foo bar Max Fast bar foo";
($test, $name) = ChopPattern($test, '\nom');
say $test;
say $name;

Если я проведу тестовый шаблон, \nom в подпрограмме:

sub ChopPattern {
    my $string= shift;
    my $pattern = shift;

    if($string =~ m/\nom/) {
        $string =~ s/$&/ /g;
        return ($string, $&);
    } else {
        return ($string, '');
    }
}

тест дает правильный ответ:

foo bar  bar foo
Max Fast

Но если я использую $pattern в матче, как указано выше, результат теста:

foo bar Max Fast bar foo
<null line>

Есть ли причина, по которой \nom запускает Tagger, но переменная, равная \nom, не работает?

Ниже приведены детали используемой версии Perl:

This is perl 5, version 16, subversion 3 (v5.16.3) built for MSWin32-x64-multi-thread (with 1 registered patch, see perl -V for more detail)

Copyright 1987-2012, Larry Wall

Binary build 1604 [298023] provided by ActiveState http://www.ActiveState.com
Built Apr 14 2014 15:29:45

Ответ 1

Программирование Perl говорит, что overload::constant работает с константами.

Любые обработчики, которые вы предоставляете для integer и float, будут вызываться всякий раз, когда tokener Perl встречает постоянное число.

Когда вы вызываете m/$pattern/, это не константа. Это переменная.

($test, $name) = ChopPattern($test, '\nom');

Теперь '\nom' является константой, но это строка. Поверните это в qr//, и у вас будет регулярное выражение, содержащее константу.

($test, my $name) = ChopPattern($test, qr'\nom');

Соответствие шаблону в ChopPattern может оставаться неизменным:

if($string =~ m/$pattern/) { ... } 

Поскольку теперь существует постоянная часть регулярного выражения, Perl может вызывать перегрузку convert и выполнять регулярное выражение.


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

Рассмотрим следующий пример:

BEGIN {
    overload::constant 'qr' => sub {
        my $re = shift;
        $re =~ s/\\nom/foobar/;
        return $re;
    };
}

sub match {
    my ( $t, $p ) = @_;
    $t =~ m/$p/;
}
match( 'some text', '\nom' );

Не важно, что делает код. Когда мы его отменяем, мы получаем этот результат:

$ perl -MO=Deparse scratch.pl 
sub BEGIN {
    use warnings;
    use strict;
    use feature 'say';
    overload::constant('qr', sub {
        my $re = shift();
        $re =~ s/\\nom/foobar/;
        return $re;
    }
    );
}
sub match {
    use warnings;
    use strict;
    use feature 'say';
    BEGIN {
        $^H{'qr'} = 'CODE(0x147a048)';
    }
    my($t, $p) = @_;
    $t =~ /$p/;
}
use warnings;
use strict;
use feature 'say';
BEGIN {
    $^H{'qr'} = 'CODE(0x147a048)';
}
match 'some text', '\\nom';                       # <-- here

Мы видим, что обработчик был установлен, но в последней строке вызова функции есть строка '\\nom'.

Теперь, если мы используем цитированное выражение qr// вместо строки, все меняется.

BEGIN {
    overload::constant 'qr' => sub {
        my $re = shift;
        $re =~ s/\\nom/foobar/;
        return $re;
    };
}

sub match {
    my ( $t, $p ) = @_;
    $t =~ m/$p/;
}
match( 'some text', qr/\nom/ );

Теперь в разложенной программе неожиданно появляется foobar. Регулярное выражение было изменено.

$ perl -MO=Deparse scratch2.pl 
sub BEGIN {
    use warnings;
    use strict;
    use feature 'say';
    overload::constant('qr', sub {
        my $re = shift();
        $re =~ s/\\nom/foobar/;
        return $re;
    }
    );
}
sub match {
    use warnings;
    use strict;
    use feature 'say';
    BEGIN {
        $^H{'qr'} = 'CODE(0x1e81048)';
    }
    my($t, $p) = @_;
    $t =~ /$p/;
}
use warnings;
use strict;
use feature 'say';
BEGIN {
    $^H{'qr'} = 'CODE(0x1e81048)';
}
match 'some text', qr/foobar/;                       # <-- here

Он сделал это до того, как код был запущен.

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

$ perl -MO=Concise scratch.pl 
8  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 2529 scratch.pl:5950) v:%,R,*,&,{,x*,x&,x$,$,469762048 ->3
7     <1> entersub[t1] vKS/TARG,2 ->8
-        <1> ex-list K ->7
3           <0> pushmark s ->4
4           <$> const(PV "some text") sM ->5       # <-- here
5           <$> const(PV "\\nom") sM ->6
-           <1> ex-rv2cv sK/2 ->-
6              <$> gv(*match) s ->7

И с qr//:

 $ perl -MO=Concise scratch2.pl 
8  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 2529 scratch2.pl:5950) v:%,R,*,&,{,x*,x&,x$,$,469762048 ->3
7     <1> entersub[t1] vKS/TARG,2 ->8
-        <1> ex-list K ->7
3           <0> pushmark s ->4
4           <$> const(PV "some text") sM ->5       # <-- here
5           </> qr(/"foobar"/) lM/RTIME ->6
-           <1> ex-rv2cv sK/2 ->-
6              <$> gv(*match) s ->7

Ответ 2

Есть ли причина, по которой \nom запускает Tagger, но переменная, равная \nom, не работает?

Потому что '\nom' - строковый литерал, а не постоянный кусок регулярного выражения:

$ perl -Moverload -E'BEGIN { overload::constant qr => sub { say "@_" } } $foo =~ "bar"'
$ perl -Moverload -E'BEGIN { overload::constant qr => sub { say "@_" } } $foo =~ /bar/'
bar bar qq

То, что вы делаете, - плохая идея. Следующая реализация намного легче понять и не изменяет семантику регулярного выражения всюду:

use strict;
use warnings 'all';
use 5.010;

sub chop_pattern {
    my ($string, $pattern) = @_;

    my %mapping = (
        '\nom' => qr/((?:[A-Z][a-z]+\s*){2,3}(?:\([\w\s]+\)+?)*)/
    );

    if (exists $mapping{$pattern}) {
        my $matched = $string =~ s/$mapping{$pattern}/ /g;
        return $string, $1 if $matched;
    }

    return $string, '';
}

my ($string, $chopped) = chop_pattern('foo Bar Baz qux', '\nom');
say "<$string> <$chopped>";

Вывод:

<foo  qux> <Bar Baz >

Я предполагаю, что вы пошли с перегрузкой, потому что хотите обрабатывать более одной "магической" строки (например, \nom). Я сделал это с помощью простого хэша, который отображает строки в регулярные выражения.