用 perl 脚本替换重复的特定文本

Question

我有一个简单的 perl 脚本，它按照以下几行进行大量文本替换：

#!/usr/bin/perl
{
open(my $in, "<", "Texts.txt") or die "No input: $!";
open(my $out, ">",  "TeXed/Texts.tex") or die "No output directory: $!";
LINE: while (<$in>) {
    s/(txt@)(.*)(?<!\t|\[)\[(.*)/\1\2\\ovl{}\3/g;# 
    # there are a bunch of other replacements like the above
    print $out $_ ; 
    }
}

到目前为止一切顺利。我正在运行此脚本的文本被组织成块（并不总是相同的长度）。每个块都以相同的标识符 (txt@) 开头，然后是唯一的标签。每个标签都以 # 开头。
我想要实现的是删除所有重复的标签 - 基本上我只想保留标签的每个第一个实例并替换/删除所有后续实例，直到标签更改。在下面的示例中，要替换/删除的是 bold。

txt@#Label1 一些文字
更多文字
还有一些文字

txt@#Label1 一些其他文本
更多文字
更多文字
还有一些文字

txt@#Label1 一些随机文本
更多文字
还有一些文字

txt@#Label2 一些文字
更多文字
更多文字
还有一些文字

txt@#Label1 一些文字
更多文字
还有一些文字

txt@#Label3 一些文字
更多文字
还有一些文字

txt@#Label3 一些文字
更多文字
还有一些文字

txt@#Label1 一些文字
更多文字
还有一些文字

等等

对不起，这个例子太长了——我想不出更好的方法来解释这一点。

所以我想删除所有重复的 Label1、Label2 等，但不修改同一行和后续行的其余文本（一些文本，一些文本）。后续行的数量并不总是相同的（因此不是每个第 n 行都必须替换）。

perl 有可能吗？还是有什么其他方式？ （我没有嫁给 perl，如果用另一种语言更容易的话，我很乐意尝试——我不是程序员，尽管如此详细的说明将不胜感激）。

Answer 1

介绍“当前标签”——最新的标签——并跟踪它。一旦出现带有标签的行比较：如果相同，则重复，则删除它，否则替换它，我们就有了新的“当前”行。

处理是逐行进行的。或者，可以一次读取整个块以启用每块处理，这可能更方便。代码显示在最后。

use warnings;
use strict;

open my $fh_out, '>', 'new_text_label.txt';
open my $fh_in, '<', 'text_label.txt';

# Our current (running) label
my $curr_label = '';

while (<$fh_in>)  
{
    # If line with label fetch it otherwise (print and) skip
    my ($label) = $_ =~ m/txt@#(\w+)/;
    if (not $label) {
        # ... process non-label line as needed ...
        print $fh_out $_;
        next;
    }       
    # Delete if repeated (matching the current), reset if new
    if ($curr_label eq $label) {
        s/(txt@)(?:#\w+)(.*)/$1$2/;
    }   
    else {
        $curr_label = $label;
    }   
    # ... process label-line as needed ...
    print $fh_out $_;
}

这将产生所需的文件。带有或不带有标签的行的处理是分开的，如果对它们的进一步处理不同，这可能会很好。或者，标签行的预处理可以在一个地方完成，如果进一步处理不区分有标签或没有标签的行，那就更好了。

while (<$fh_in>) 
{
     # If this is the label line, process it: delete or replace the label
     if (my ($label) = $_ =~ m/txt@#(\w+)/) {
        # Delete if repeated (matching the current), reset if new
        if ($curr_label eq $label) {
            s/(txt@)(?:#\w+)(.*)/$1$2/;
        }   
        else {
            $curr_label = $label;
        }
     }
     # The label is now fixed as needed. Process lines normally ...
     print $fh_out $_;
}

这替换了上面的while循环，其余代码相同。

---

源自最初发布的内容，评论

以下是代码中的更改，以便它一次读取整个块，这对于可以利用变量中的整个文本块的处理很有用。请注意，一个块包含新行（因此正则表达式可能需要/s 等）。为了实现可能的批量处理，所有块也首先被读入一个数组。

my @blocks = do { 
    # Set record separator to empty line to read blocks
    local $/ = "\n\n";
    open my $fh_in, '<', 'text_label.txt';
    <$fh_in>;    
};

# Our current (running) label
my $curr_label = '';

foreach my $bl (@blocks) 
{
     # The label pre-processing is exactly the same as above
     # Other processing can now utilize having the whole block in $bl
}