Передача подстановки регулярных выражений в качестве переменной в Perl?

Question

Мне нужно передать подстановочное выражение в качестве переменной:

sub proc {
    my $pattern = shift;
    my $txt = "foo baz";

    $txt =~ $pattern;
}

my $pattern = 's/foo/bar/';
proc($pattern);

Это, конечно, не работает. Я попытался оценить замену:

eval("$txt =~ $pattern;");

но это тоже не сработало. Какую ужасно очевидную вещь я здесь упускаю?

Answer 1

Мне нужно передать подстановку регулярных выражений в качестве переменной

А ты? Почему бы не передать ссылку на код? Пример:

sub modify
{
  my($text, $code) = @_;
  $code->($text);
  return $text;
}

my $new_text = modify('foo baz', sub { $_[0] =~ s/foo/bar/ });

В общем, когда вы хотите передать «что-то, что что-то делает» подпрограмме («подстановка регулярного выражения» в случае вашего вопроса), ответ - передать ссылку на фрагмент кода. Perl высшего порядка - хорошая книга по теме.

Answer 2

sub proc {
    my($match, $subst) = @_;
    my $txt = "foo baz";
    $txt =~ s/$match/$subst/;
    print "$txt\n";
}

my $matcher = qr/foo/;
my $sub_str = "bar";

proc($matcher, $sub_str);

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

Недавно мне нужно было создать синтаксический анализатор (тестовый анализатор) для операторов с некоторыми своеобразными (диалектом) SQL-типами, распознавая такие строки, разбивая его на три типа:

input: datetime year to second,decimal(16,6), integer

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

#!/bin/perl -w
use strict;
while (<>)
{
    chomp;
    print "Read: <$_>\n";
    my($r1) = qr%^input\s*:\s*%i;
    if ($_ =~ $r1)
    {
        print "Found input:\n";
        s%$r1%%;
        print "Residue: <$_>\n";
        my($r3) = qr%(?:year|month|day|hour|minute|second|fraction(?:\([1-5]\))?)%;
        my($r2) = qr%
                        (?:\s*,?\s*)?   # Commas and spaces
                        (
                            (?:money|numeric|decimal)(?:\(\d+(?:,\d+)?\))?   |
                            int(?:eger)?  |
                            smallint      |
                            datetime\s+$r3\s+to\s+$r3
                        )
                    %ix;
        while ($_ =~ m/$r2/)
        {
            print "Got type: <$1>\n";
            s/$r2//;
        }
        print "Residue 2: <$_>\n";
    }
    else
    {
        print "No match:\n";
    }
    print "Next?\n";
}

Мы можем поспорить об использовании имен, таких как $ r1 и т. Д. Но это сработало ... это не было и не является рабочим кодом.

Answer 3

Ну, вы можете предварительно скомпилировать RE, используя оператор qr //. Но вы не можете передать оператор (s ///).

$pattern = qr/foo/;

print "match!\n" if $text =~ $pattern;

Но если вам нужно передать оператор подстановки, вы можете передать либо код, либо строку:

proc('$text =~ s/foo/bar');

sub proc { 
   my $code = shift;

   ...

   eval $code;
}

или код:

proc(sub {my $text = shift;  $text =~ s/foo/bar});

sub proc {
   my $code = shift;

   ...

   $code->("some text");
}

Answer 4

s/// не является регулярным выражением. Таким образом, вы не можете передать это как регулярное выражение.

Мне не нравится eval, он очень хрупкий, с множеством граничных случаев.

Я думаю, что лучше всего использовать подход, подобный тому, который использует Javascript: передать как регулярное выражение (в Perl, то есть qr//), так и ссылку на код для подстановки. Например, чтобы передать параметры, чтобы получить тот же эффект, что и

s/(\w+)/\u\L$1/g;

Вы можете позвонить

replace($string, qr/(\w+)/, sub { "\u\L$1" }, 'g');

Обратите внимание, что модификатор 'g' на самом деле не является флагом для регулярного выражения (я думаю, что присоединение его к регулярному выражению - ошибка проектирования в Javascript), поэтому я решил передать его в 3-м параметре.

Как только API определен, реализация может быть сделана следующим образом:

sub replace {
    my($string, $find, $replace, $global) = @_;
    unless($global) {
        $string =~ s($find){ $replace->() }e;
    } else {
        $string =~ s($find){ $replace->() }ge;
    }
    return $string;
}

Давайте попробуем это:

print replace('content-TYPE', qr/(\w+)/, sub { "\u\L$1" }, 'g');

Результат:

Content-Type

Это выглядит хорошо для меня.

Answer 5

eval "$txt =~ $pattern";

Это становится

eval "\"foo baz\" =~ s/foo/bar/"

, и подстановки не работают на литеральных строках.

Это будет работать:

eval "\$txt =~ $pattern"

, но это не очень приятно. eval почти никогда не является правильным решением.

Решение zigdon может сделать что угодно, и решение Джонатана вполне подходит, если замещающая строка является статической. Если вы хотите что-то более структурированное, чем первое и более гибкое, чем второе, я бы предложил гибрид:

sub proc {
    my $pattern = shift;
    my $code = shift;
    my $txt = "foo baz";
    $txt =~ s/$pattern/$code->()/e;
    print "$txt\n";
}
my $pattern = qr/foo/;
proc($pattern, sub { "bar" });   # ==> bar baz
proc($pattern, sub { "\U$&" });  # ==> FOO baz

Answer 6

Возможно, вы могли бы переосмыслить свой подход.

Вы хотите передать в функцию подстановку регулярных выражений, возможно, потому, что функция будет извлекать текст для обработки из какого-либо другого источника (чтение из файла, сокета и т. Д.). Но вы смешиваете регулярное выражение с заменой регулярного выражения .

В выражении s/foo/bar/ у вас есть регулярное выражение ("/ foo /") и подстановка ("bar"), которая должна заменить то, что соответствует выражению. В тех подходах, которые вы пробовали до сих пор, вы столкнулись с проблемами, пытаясь использовать eval, главным образом из-за вероятности использования специальных символов в выражении, которые либо мешают работе eval, либо интерполируются (т. Е. Поглощаются) в процессе. оценки.

Итак, вместо этого попробуйте передать вашей программе два аргумента: выражение и подстановку:

sub apply_regex {
    my $regex = shift;
    my $subst = shift || ''; # No subst string will mean matches are "deleted"

    # some setup and processing happens...

    # time to make use of the regex that was passed in:
    while (defined($_ = <$some_filehandle>)) {
        s/$regex/$subst/g; # You can decide if you want to use /g etc.
    }

    # rest of processing...
}

Этот подход имеет дополнительное преимущество: если в вашем шаблоне регулярных выражений нет специальных символов, вы можете просто передать его напрямую:

apply_regex('foo', 'bar');

Или, если это так, вы можете использовать оператор цитирования qr//, чтобы создать объект регулярного выражения и передать его в качестве первого параметра:

apply_regex(qr{(foo|bar)}, 'baz');
apply_regex(qr/[ab]+/, '(one or more of "a" or "b")');
apply_regex(qr|\d+|); # Delete any sequences of digits

Более того, вам действительно не нужно eval или использование кодовых ссылок / замыканий для этой задачи. Это только добавит сложности, которая может сделать отладку сложнее, чем нужно.

Randy

Answer 7

Я нашел, вероятно, лучший способ сделать это:

sub proc {
    my ($pattern, $replacement) = @_;
    my $txt = "foo baz";

    $txt =~ s/$pattern/$replacement/g;  # This substitution is global.
}

my $pattern = qr/foo/;  # qr means the regex is pre-compiled.
my $replacement = 'bar';

proc($pattern, $replacement);

Если флаги подстановки должны быть переменными, вы можете использовать это:

sub proc {
    my ($pattern, $replacement, $flags) = @_;
    my $txt = "foo baz";

    eval('$txt =~ s/$pattern/$replacement/' . $flags);
}

proc(qr/foo/, 'bar', 'g');

Обратите внимание, что вам не нужно экранировать / в строке замены.

Answer 8

У меня очень простой скрипт для массового переименования файлов, использующий этот трюк:

#!/opt/local/bin/perl
sub oops { die "Usage : sednames s/old/new [files ..]\n"; }
oops if ($#ARGV < 0);

$regex = eval 'sub { $_ = $_[0]; ' . shift(@ARGV) . '; return $_; }';
sub regex_rename { foreach (<$_[0]>) {
    rename("$_", &$regex($_));
} }

if ($#ARGV < 0) {  regex_rename("*");  }
else {  regex_rename(@ARGV);  }

Любая команда perl, которая изменяет $_, например s/old/new, может использоваться для изменения файлов.

Я решил использовать eval, чтобы регулярное выражение нужно было скомпилировать только один раз. Есть некоторые странности с eval и $_, которые помешали мне использовать просто:

eval 'sub { ' . shift(@ARGV) . ' }';

хотя это &$regex определенно изменяет $_; требующий "$_" для оценки $_ перед вызовом rename. Да, eval довольно хрупкий, как все говорили.

Answer 9

Вы правы - вы были очень близки:

eval('$txt =~ ' . "$pattern;");