我有一个perl脚本，该脚本在文本文件上进行了一些正则表达式替换，需要按照以下几行进行修改：（a）我需要将文本处理为文本块，然后根据在场/如果没有一行，则需要进行不同的替换。 （b）我需要在每个块的末尾添加文本。 （这会将文本从转录程序转换为LaTeX代码）
这些应该分为两列：
左边是输入的外观，右边是应变成的内容：
ORIGINAL INPUT EXPECTED OUTCOME
# Single line blocks: label to be replaced and \xe added to en
txt@#Name Text text text \ex[exno=\spkr{Name}] \txt Text text text
\xe
nvb@#Name Text text text \ex[exno=\spkr{Name}] \nvb Text text text
\xe
# Multi-line blocks: labels to be replaced and \xe added to end
txt@#Name Text text text \ex[exno=\spkr{Name}] \txt Text text text
fte@#Name Text text text \freetr Text text text
\xe
txt@#Name Text text text \ex[exno=\spkr{Name}] \txt Text text text
SD (0.0) \silence{0.0}
\xe
txt@#Name Text text text \ex[exno=\spkr{Name}] \txt Text text text
tli@#Name Text text text \translit Text text text
fte@#Name Text text text \freetr Text text text
\xe
# Multi-line block that has the mrb@... line (must start with txt):
txt@#Name Text text text \ex[exno=\spkr{Name}] \begingl \glpreamble Text text text //
mrb@#Name Text text text \gla Text text text //
gle@#Name Text text text \glb Text text text //
fte@#Name Text text text \glft Text text text //
SD (0.0) \endgl
\silence{0.0}
\xe
# The tricky thing here is that (a) the labels get replaced differently, the txt line gets two commands, \begingl and \glpreamble, all lines have to end with // and they end with \endgl and \xe. In case there is an SD (silence duration) line then that needs to go between the \endgl and the \xe. (but not all have the SD).
块之间用多余的空白行隔开。每个块的第一行以标签txt@...，nvb@...或event开头，并且可以或可以不跟随以不同标签开头的后续行。每个标签都需要替换为其他标签，这里可以通过正则表达式来完成，如下面的示例所示（加上一些其他替换，出于解释目的，这只是最小的）。然后，我需要标记每个块的结尾。
此外，我需要在其中的某个位置放置一个条件：如果该块包含以mrb @标签开头的行（如上面的第六个块），则将应用不同的替换模式。
以下脚本是我所拥有的，但是它逐行处理所有内容。我知道perl可以一步一步地做，然后应该可以进行修改，但是不幸的是我的技能太基本了，无法自己解决。
#!/usr/bin/perl
use warnings;
use strict;
open my $fh_in, '<', $ARGV[0] or die "No input: $!";
open my $fh_out, '>', $ARGV[1] or die "No output: $!";
print $fh_out "\\begin{myenv}\n\n"; # begins group at beginning of file
while (<$fh_in>)
{
# general replacements for everything except if block includes a "mrb@" line:
s/^txt@#(\S*)\s+(.*)/\\ex[exno=\\spkr{$1}] \\txt $2 /g;
s/^nvb@#(\S*)\s+(.*)/\\ex[exno=\\spkr{$1}] \\txt $2 /g;
s/^tli@#\S*\s+(.*)/\\translit $1 /g;
s/^fte@#\S*\s+(.*)/\\freetr $1 /g;
s/^SD\s*\((\d*)\.(\d*)\)/\\silence{\($1\.$2\)}/g;
# after each block I need to add "\\xe"
# replacements if block includes a "mrb@" line:
s/^txt@#(\S*)\s+(.*)/\\ex[exno=\\spkr{$1}] \\begingl \\glpreamble $2 \/\/ /g;
s/^mrb@#\S*\s+(.*)/\\gla $1 \/\/ /g; #
s/^gle@#\S*\s+(.*)/\\glb $1 \/\/ /g; #
s/^fte@#\S*\s+(.*)/\\glft $1 \/\/ /g; #
s/^tli@#\S*\s+(.*)/\\translit $1 \/\/ /g; #
s/^fte@#\S*\s+(.*)/\\freetr $1 \/\/ /g; #
s/^SD\s*\((\d*)\.(\d*)\)/\\silence{\($1\.$2\)}/g;
# after each block with a "mrb@" line I need to add "\\endgl" and "\\xe"
# if there is a line starting with SD at the end of the block it needs to go between "\\endgl" and "\\xe"
print $fh_out $_;
}
print $fh_out "\\end{myenv}"; # ends group
任何帮助，不胜感激！
答案 0 :(得分：4)
处理细节显然很复杂；首先让我们弄清楚如何处理块。
一种方法是逐行并累积一个块的行，直到到达空行。然后，您处理块并清除缓冲区，然后继续进行。例如
use warnings;
use strict;
use feature 'say';
sub process_block {
say "Block:"; say "\t$_" for @{$_[0]};
}
my $file = shift // die "Usage: $0 filename\n"; #/
open my $fh, '<', $file or die "Can't open $file: $!";
my @block;
while (<$fh>) {
chomp;
if (not /\S/) {
if (@block) { # the first empty line
process_block(\@block);
@block = ();
}
next;
}
push @block, $_;
}
process_block(\@block) if @block; # last block may have remained
对于显示的示例，process_block循环之后的while调用不会触发，因为文件末尾之前有空行，因此最后一个块在循环内被处理。但是我们需要确保在末尾也没有空行时处理最后一个块。
在process_block内，您现在可以检查@block是否包含mrb@#Name，应用其他（看似复杂的）条件，运行正则表达式以及打印处理过的行。
这里是一个示例，经过澄清，但仍然省略了一些细节
use List::Util qw(any); # used to be in List::MoreUtils
sub process_block {
my @block = @{ $_[0] }; # local copy, to not change @block in caller
if ($block[0] =~ /^txt\@/ and any { /^mrb\@/ } @block) {
for (@block) {
s{^txt\@#(\S*)\s+(.*)}
{\\ex[exno=\\spkr{$1}, exnoformat=X] \\begingl \\glpreamble $2 // }g; #/
s{^mrb\@#\S*\s+(.*)}{\\gla $1 // }g;
# etc
}
if ($block[-1] =~ /^\s*SD/) {
my $SD_line = pop @block;
push @block, '\endgl', $SD_line, '\xe';
}
else {
push @block, '\endgl', '\xe';
}
}
else {
for (@block) {
s/^txt\@#(\S*)\s+(.*)/\\ex[exno=\\spkr{$1}, exnoformat=X] \\txt $2 /g;
s/^tli\@#\S*\s+(.*)/\\translit $1 /g;
# etc
}
push @block, '\xe';
}
say for @block;
say "\n"; # two lines to separate blocks
}
关于效率的说明。
此代码针对所有正则表达式替换处理块中的每一行，以找到适用于它的一行。区别模式一开始就是正确的，因此“错误”的行会立即失败，但是我们仍然对每行的所有检查运行正则表达式引擎。
对于许多正则表达式或较长的代码块，或者如果经常执行，可能会（或可能不会）出现问题，如果速度较慢，则可以对其进行优化。由于替换列表始终相同，因此我们可以使用正则表达式构建哈希，该正则表达式由模式的区别开始（作为 dispatch table ）。例如
my %repl_non_mrb = (
'txt@' => sub { s/^txt\@#(\S*)\s+(.*)/\\ex[exno=\\spkr{$1}, exnoformat=X] \\txt $2 /g }
'tli@' => sub { s/^tli\@#\S*\s+(.*)/\\translit $1 /g },
...
);
my %repl_mrb = ( ... );
，然后将其用于
# For blocks without 'mrb@'
for (@block) {
# Capture key: up to # for 'txt@' (etc), up to \s for 'SD'. Other cases?
my ($key) = /^(.*?)(?:#|\s)/;
if ($key and exists $repl_non_mrb{$key}) {
$repl_non_mrb{$key}->(); # run the coderef
}
else { say "No processing key (?) for: $_" } # some error?
}
这显然需要更多（仔细）的工作，同时还有其他方式来组织这些正则表达式。但是这些（固定的）正则表达式替换（通过其区别模式进行散列）的实现肯定会改善始终在每行上运行所有正则表达式的 O（NM）复杂性。
另一种方式是您要查询的内容
我知道perl可以一步一步地完成
可以通过设置$/ variable来完成。它设置什么然后用作输入记录之间的分隔符。如果您将其设置为\n\n，则会在每次读取时以字符串形式提供一个块
open my $fh, '<', $file or die "Can't open $file: $!";
PROCESS_FILE: {
local $/ = "\n\n";
while (my $block = <$fh>) {
chomp $block;
say "|$block|";
}
};
我将其放在一个块中（这样命名为PROCESS_FILE），以便我们可以使用local来更改$/。然后，在退出该块并再次正常读取文件后，将恢复其先前的值。
但是，在这里我看不到这样做的好处，因为您现在在标量变量中有一个块，而您需要做的似乎是面向行的。所以我建议第一种方法。