Perl 5: Как подавить интерполяцию @var в шаблонах регулярных выражений

Вот вариант, который работает: используйте $1 непосредственно в замещающей стороне, а не в заранее созданной для нее переменной. Это избавляет нас от некоторых хлопот.

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

my $text_str = 'public class ZipUtilTest extends TestCase {}';
#say $text_str;

my $re = '^(public class \w+) extends TestCase \{';
#say $re;

my $replace =  "\@RunWith(JUnit4.class)\n";
#say $replace;

$text_str =~ s/$re/${replace}$1 {/;

say $text_str;

Обновление с комментариями

Переменные для шаблона и строки замены считываются из файла конфигурации. Тогда «хлопоты», о которых я упоминаю, становятся более серьезными.

Если $1 должен быть подготовлен в переменной строки замены, это должна быть простая строка (символов $ и 1), в то время как она должна стать переменной и быть оценена в регулярном выражении.

Это означает, что переменная должна быть eval-ed (или регулярное выражение должно запускаться с /ee), и это проблема со строковой формой eval -- ввод извне: eval будет оценивать (запускать) что угодно, любой код. Нам не нужны злонамеренные действия в отношении текста, чтобы стать кодом в файлах конфигурации, просто учтите опечатки.

Что касается красивого экранирования (только) того, что нужно экранировать, к этому можно подготовиться, например, хэш:

my %esc_char = ( at => '\@' );  # etc

И используйте это при составлении переменной со строкой замены.

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

Вы можете использовать положительный прогноз, чтобы сопоставить {, не фиксируя его в 1 долларе. Тогда строка замены не обязательно должна содержать $1.

При построении регулярного выражения лучше использовать оператор заключения в кавычки регулярного выражения qr{}, чем строки; он будет цитироваться как регулярное выражение, а не как строка. Это может избежать тонких ошибок.

use v5.10;

my $text_str = 'public class ZipUtilTest extends TestCase {}';

# Use a positive-look ahead to match, but not capture, the {
# Quote as regex to avoid subtle quoting issues.
my $find = qr'^(public class \w+) extends TestCase(?>\s*\{)';

# Use double-quotes to interpolate the \n, but escape the \@.
my $replace = "\@RunWith(JUnit4.class)\n";

# Add the $1 to the end of the replacement.
$text_str =~ s{$find}{$replace$1};

say $text_str;

Демонстрация.

Кажется, вы хотите загрузить не зависящий от языка поиск и заменить шаблоны из файла конфигурации, а затем применить их через сценарий Perl.

Если это ваша цель, то использование eval не подходит, так как Perl имеет синтаксис, который вы не хотите поддерживать, как вы узнали.

Неразумно пытаться обойти эти специфичные для Perl части, пытаясь избежать их, так как это может стать довольно сложным. Например, вы рассматривали экранирование вхождений @, поскольку они могут представлять имя массива, но что, если этот символ уже экранирован обратной косой чертой? Чтобы справиться с этим должным образом, потребовалась бы почти полная повторная реализация синтаксиса строковых литералов Perl, что звучит не очень весело.

Что бы я сделал, так это определил собственный синтаксис строки замены, чтобы мы были полностью независимы от синтаксиса Perl.

Например, мы можем определить синтаксис замещающей строки как полностью дословный, за исключением того, что мы поддерживаем определенные символы обратной косой черты. Предположим, что синтаксис '\' DIGIT, такой как \1, заменяет захват, и что поддерживаются обычные переходы обратной реакции (\b \t \n \v \f \r \" \' \\ \x0A), которые являются общим подмножеством строковых литералов JavaScript , строковых литералов Python 3 и Perl. побеги, минус восьмеричные побеги. Обратите внимание, что эти языки не согласны с синтаксисом символов Unicode.

Мы можем реализовать интерпретатор для этого языка замены строк следующим образом: мы разбираем строку замены в массив опкодов, чередуя литеральную строку с номером захвата. Например, шаблон замены abc\1def будет разобран на ['abc', 1, 'def']:

sub parse_replacement_pattern {
  my ($pattern) = @_;
  my @ops = ('');  # init with empty string

  # use m//gc style parsing which lets us anchor patterns at the current "pos"
  pos($pattern) = 0;
  while (pos $pattern < length $pattern) {
    if ($pattern =~ /\G([^\\]+)/gc) {
      $ops[-1] .= $1;
    }
    elsif ($pattern =~ /\G\\n/gc) {
      $ops[-1] .= "\n";
    }
    ...  # and so on for the basic escapes
    elsif ($pattern =~ /\G\\x([0-9a-fA-F]{2})/gc) {
      $ops[-1] .= chr $1;
    }
    elsif ($pattern =~ /\G\\([1-9])/gc) {
      push @ops, $1, '';  # add replacement opcode + empty string
    }
    else {
      die "invalid syntax";
    }
  }

  return \@ops;
}

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

sub apply_replacement_pattern {
  my ($ops) = @_;
  my $output = '';
  my $is_capture = 0;

  for my $op (@$ops) {
    if ($is_capture) {
      # we know that $op must be the number of a capture buffer
      $output .= ${^CAPTURE}[$op - 1];  # like eval "\$$op"
    }
    else {
      # we know that $op must be a literal string
      $output .= $op;
    }
    $is_capture = !$is_capture;
  }

  return $output;
}

Теперь мы можем использовать эти функции в вашем тестовом примере:

my $text_str ='public class ZipUtilTest extends TestCase {}';
my $find = '^(public class \\w+) extends TestCase \\{';
my $replace = '@RunWith(JUnit4.class)\\n\\1 {';

my $replace_ops = parse_replacement_pattern($replace);
$text_str =~ s{$find}{apply_replacement_pattern($replace_ops)}mge;
say $text_str;

Это дает ожидаемый результат

@RunWith(JUnit4.class)
public class ZipUtilTest {}