В perl Есть ли более компактный способ поиска по ряду шаблонов, и для каждого из них подставьте выражение

Question

В perl я читаю строку и пытаюсь заменить набор строк соответствующими выражениями, используя последовательность операторов if. Например:

my @shiftInstructions=("lsr", "lsl", "rol", "ror");
while (my $line = <>) {
  if ($line =~ /\$sh/) {
    my $r = int(rand(6));
    $line =~ s/\$sh/$r/;
  }
  if ($line =~ /\$ish/) {
    my $r = $shiftInstructions[rand(4)]
    $line =~ s/\$ish/$r/;
  }
}

Мне не нравится этот подход по ряду причин. Во-первых, это повторяется. Я должен сначала проверить, существует ли шаблон, а затем, если это так, выполнить функцию для генерации значения замены, а затем заменить. Таким образом, он является как многословным, так и медленным (2 поиска по регулярному выражению на шаблон, возможно, в конечном счете, десятки строк шаблона).

Я подумал о карте, где несколько кодов сопоставляются с соответствующим кодом для выполнения.

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

Я нашел опцию выполнения в регулярном выражении. Как насчет написания набора подпрограмм для обработки каждого регулярного выражения, а затем создания отображения:

my %regexMap = (
    "\$fn", &foundFunc,
    "\$hw", &hex8,
    "\$hb", &hex2,
    "\$sh", &rand6,
    "\$ish", &shiftInst,
    );
while (my $line = <>) {
    $line =~ s/(\$fn|\$hw|\$hb|\$sh|\$ish|)/$regexMap{$1}/e;    
    print $line;
}

Answer 1

if ($line =~ /\$sh/) {
   my $r = int(rand(6));
   $line =~ s/\$sh/$r/;
}

плохой способ записи

$line =~ s/\$sh/ int(rand(6)) /e;

Так что

my @shiftInstructions=("lsr", "lsl", "rol", "ror");
while (my $line = <>) {
  if ($line =~ /\$sh/) {
    my $r = int(rand(6));
    $line =~ s/\$sh/$r/;
  }
  if ($line =~ /\$ish/) {
    my $r = $shiftInstructions[rand(4)]
    $line =~ s/\$ish/$r/;
  }
  print($line);
}

можно записать как

my @shiftInstructions = qw( lsr lsl rol ror );

while (my $line = <>) {
   $line =~ s/\$sh/ int(rand(6)) /e;
   $line =~ s/\$ish/ $shiftInstructions[rand(@shiftInstructions)] /e;
   print($line);
}

Но это означает, что вы сканируете строка снова и снова. Давайте избегать этого.

my @shiftInstructions = qw( lsr lsl rol ror );

while (my $line = <>) {
   $line =~ s/\$(sh|ish)/
      if    ( $1 eq "sh"  ) { int(rand(6)) }
      elsif ( $1 eq "ish" ) { $shiftInstructions[rand(@shiftInstructions)] }
   /eg;
   print($line);
}

К сожалению, это вновь приводит к повторению. Мы можем решить эту проблему с помощью таблицы диспетчеризации.

my @shiftInstructions = qw( lsr lsl rol ror );

my %replacements = (
   sh  => sub { int(rand(6)) },
   ish => sub { $shiftInstructions[rand(@shiftInstructions)] },
);

my $alt = join '|', map quotemeta, keys(%replacements);
my $re = qr/\$($alt)/;

while (my $line = <>) {
   print $line =~ s/$re/ $replacements{$1}->() /reg;
}

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

---

Решение Вы добавили, что ваш вопрос был близок, но в нем было две ошибки.

1. &foo, звонки foo. Чтобы получить ссылку на него, используйте \&foo.

   my %regexMap = (
       "\$fn", \&foundFunc,
       "\$hw", \&hex8,
       "\$hb", \&hex2,
       "\$sh", \&rand6,
       "\$ish", \&shiftInst,
       );
   

2. $regexMap{$1}, теперь возвращает ссылку. Вы хотите вызвать ссылочную подпрограмму, что можно сделать с помощью $regexMap{$1}->().

   while (my $line = <>) {
       $line =~ s/(\$fn|\$hw|\$hb|\$sh|\$ish|)/ $regexMap{$1}->() /e;
       print $line;
   }
   

Answer 2

В этих случаях я часто создаю некую структуру данных, которая содержит шаблоны и их действия:

my @tuples = (
    [ qr/.../, sub { ... } ]
    [ ... ].
    );

Теперь суть процесса остается неизменной независимо от того, сколько шаблонов я хочу попробовать :

while( <> ) {
    foreach $tuple ( @tuples ) {
        $tuple->[1]() if /$tuple[0]/
        }
     }

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

sub some_sub {
    my @tuples = @_;

    while( <> ) {
        foreach $tuple ( @tuples ) {
            $tuple->[1]() if /$tuple[0]/
            }
         }
    }

Я написал об этом в Мастеринг Perl и Эффективный Perl Программирование , и это то, что входит в мои неясные модули, такие как Brick и Data :: Constraint .

---

I Я думал об этом больше, и мне интересно, являются ли регулярные выражения частью того, что вы пытаетесь сделать. Похоже, вы сопоставляете буквенные строки, но используете для этого оператор соответствия. Вы не указываете детали ввода, поэтому я предполагаю здесь - похоже, что есть операция (например, $fn, и вы хотите точно соответствовать этой операции. Проблема в том, чтобы найти эту строку, а затем отобразить ее в коде. Это выглядит примерно так (и ответ ikegami - еще одна форма этой идеи). Вместо чередования я сопоставляю все, что может выглядеть как строка:

while( <> ) {
    # find the string. Need example input to guess better
    if( m/(\$[a-z]+)/ ) {
        $table{$1}->() if exists $table{$1};
        }
    }

Но опять же, это зависит от ввода, сколько реальных подстрок вы можете сопоставить (так, количество ветвей в чередовании), сколько строк вы хотите обработать и т. д. Был замечательный разговор об обработке apache файлов журнала с Regex :: Tr ie и различные эксперименты, которые они пытались сделать быстрее. Я забыл все детали, но очень маленькие корректировки внесли заметные различия в десятки миллионов строк.

Интересное чтение :

• Может быть, этот разговор? Исследование tr ie соответствие регулярному выражению
• * 1 037 *
• Соответствует длинному списку фраз

Answer 3

Код OP можно записать в следующем виде

use strict;
use warnings;
use feature 'say';

my %regexMap = (
    '$fn'   => \&foundFunc,
    '$hw'   => \&hex8,
    '$hb'   => \&hex2,
    '$sh'   => \&rand6,
    '$ish'  => \&shiftInst,
    );

my @keys = map { "\\$_" } keys %regexMap;
my $re = join('|', @keys);

while (<DATA>) {
    chomp;
    next unless /($re)/;
    $regexMap{$1}->();
}

sub foundFunc   { say 'sub_foundFunc' }
sub hex8        { say 'sub_hex8'      }
sub hex2        { say 'sub_hex2'      }
sub rand6       { say 'sub_rand6'     }
sub shiftInst   { say 'sub_shiftInst' }

__DATA__
$fn
$hw
$ac
$hb
$sh
$fn
$mf
$hb
$ish
$hw

Вывод

sub_foundFunc
sub_hex8
sub_hex2
sub_rand6
sub_foundFunc
sub_hex2
sub_shiftInst
sub_hex8