用perl regex用條件替換文本塊

Question

我有一個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

任何幫助，不勝感激！

Answer 1

處理細節顯然很復雜； 讓我們首先弄清楚如何處理塊。

一種方法是逐行移動並累積一個塊的行，直到到達空行。 然后，您處理塊並清除緩沖區，然后繼續進行。 例如

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

while循環后的process_block調用不會為所示示例觸發，因為文件末尾之前有空行，因此最后一個塊在循環內得到處理。 但是我們需要確保在末尾也沒有空行時處理最后一個塊。

在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
}

關於效率的說明。

此代碼針對所有正則表達式替換處理塊中的每一行，以找到適用於它的行。 區別模式是從一​​開始就出現的，因此“錯誤”的行會立即失敗，但是我們仍然對每行的所有檢查運行正則表達式引擎。

對於許多正則表達式或較長的代碼塊，或者如果經常執行，這可能是（或可能不是）問題，如果速度較慢，則可以對其進行優化。 由於替換列表始終相同，因此我們可以使用正則表達式構建散列，該正則表達式由模式的區別性開頭（作為調度表 ）作為鍵。 例如

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可以一步一步地做

可以通過設置$/變量來完成。 它設置什么然后用作輸入記錄之間的分隔符。 如果您將其設置為\\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更改$/ 。 然后，當退出該塊並再次正常讀取文件時，將恢復其先前的值。

但是，我看不到這樣做的好處，因為您現在在標量變量中有一個塊，而您所需要做的似乎是面向行的。 因此，我建議第一種方法。