Мне нужно передать подстановку регулярных выражений в виде переменной:
sub proc {
my $pattern = shift;
my $txt = "foo baz";
$txt =~ $pattern;
}
my $pattern = 's/foo/bar/';
proc($pattern);
Это, конечно, не работает. Я попытался выполнить замену:
eval("$txt =~ $pattern;");
но это тоже не сработало. Какую ужасную очевидность я здесь не вижу?
Мне нужно передать подстановку регулярных выражений в виде переменной
Вы? Почему бы не пройти ссылку на код? Пример:
sub modify
{
my($text, $code) = @_;
$code->($text);
return $text;
}
my $new_text = modify('foo baz', sub { $_[0] =~ s/foo/bar/ });
В общем, если вы хотите передать "что-то, что делает что-то" в подпрограмму ( "замена регулярного выражения" в случае вашего вопроса), ответ должен передать ссылку на часть кода. Более высокий порядок Perl - хорошая книга по этой теме.
Ну, вы можете предварительно скомпилировать 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");
}
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
script Я использовал демонстрацию этих используемых цитируемых регулярных выражений.
#!/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 и т.д. Но он выполнил эту работу... это не был и не является производственным кодом.
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 s/// не является регулярным выражением. Таким образом, вы не можете передавать его как регулярное выражение.
Мне не нравится eval для этого, он очень хрупкий, с большим количеством bordercases.
Я думаю, что лучше всего использовать подход, похожий на один Javascript: передать как регулярное выражение (в Perl, то есть qr//), так и ссылку на код для замены. Например, чтобы передать параметры, чтобы получить тот же эффект, что и
s/(\w+)/\u\L$1/g;
Вы можете позвонить
replace($string, qr/(\w+)/, sub { "\u\L$1" }, 'g');
Обратите внимание, что модификатор 'g' на самом деле не является флагом для регулярного выражения (я думаю, что привязка его к регулярному выражению является ошибкой дизайна в Javascript), поэтому я решил передать его в третьем параметре.
После того, как 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
Это выглядит хорошо для меня.
Возможно, вы можете пересмотреть свой подход.
Вы хотите передать функции подстановке регулярных выражений, вероятно, потому, что функция будет выводить текст, который будет использоваться из другого источника (чтение из файла, сокета и т.д.). Но вы объединяете регулярное выражение с заменой регулярного выражения.
В выражении 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 или использование кодовых ссылок/закрытий для этой задачи. Это добавит сложности, которые могут сделать отладку сложнее, чем это должно быть.
Ренди
У меня очень простое script для массового переименования файлов, которое использует этот трюк:
#!/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 довольно хрупкий, как и все остальные.
Я нашел, вероятно, лучший способ сделать это:
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');
Обратите внимание, что вам не нужно скрывать / в заменяющей строке.
Вы правы - вы были очень близки:
eval('$txt =~ ' . "$pattern;");