Perl 脚本搜索/替换和转换结果

Question

我正在运行一个简单的 Perl 脚本，它将所有以 \txt 开头的行复制到 \xtx。到目前为止，一切都很好。

use strict;
use warnings;    

$^I = '.bak';

while ( <> ) {

   s/(\\txt )(.*)/$1$2\n\\xtx $2/g;

   print; 
}

现在我想“清理”所有以\\xtx 和

开头的新行

1. 删除所有非单词字符：任何非字母但保留带有变音符号的字符

2. 将所有内容转换为小写。

这就是我的基本编程技能结束的地方

我的文本文件如下所示：

\txt Text (.) with [ symbols and Num[bers (.2) and cháractẽrs with diacrítics  
\abc More text ...

到目前为止，我的脚本产生了：

\txt Text (.) with [ symbols and Num[bers (.2) and cháractẽrs with diacrítics  
\xtx Text (.) with [ symbols and Num[bers (.2) and cháractẽrs with diacrítics  
\abc More text ...

而我想实现：

\txt Text (.) with [ symbols and Num[bers (.2) and cháractẽrs with diacrítics  
\xtx text with symbols and numbers and cháractẽrs with diacrítics  
\abc More text ...

非常感谢任何帮助！

编辑：
这是一个真实的示例字符串：

\_sh v3.0  400  Text3  

\ref 2013-05-01_08.36.14 001  
\txt Djawy (.) de osẽ[ma (.2) EDJu::  
\fts Te equivocaste, saliste,   
\fte   

\ELANParticipant #TBGD  
\ELANBegin 00:00:05.367  
\ELANEnd 00:00:06.521  
\dt 26/May/2016  

\ref 2013-05-01_08.36.14 002  
\txt [A;;;;;;;;;;;;;   
\fts A;;;;;;;;;;;;;  
\fte   
...

... 一切都应该保持原样，除了以 \txt ... 开头的行...

Answer 1

你可以试试这个转换

Perl

use strict;
use warnings;

binmode (DATA, ":utf8");
binmode (STDOUT, ":utf8");

while (<DATA>) {
   s/^(\\txt )(.*)/GetConvetedLine($1,$2)/me;
   print; 
}

sub GetConvetedLine
{
    my ($txt, $body) = @_;
    my $newbody = $body;
    $newbody =~ s/[^\pL\s]+//g;
    $newbody =~ s/\s+/ /g;
    $newbody = lc($newbody);
    return $txt . $body . "\n" . "\\xtx " . $newbody;
}


__DATA__    
\txt Text (.) with [ symbols and Num[bers (.2) and cháractẽrs with diacrítics

输出

\txt Text (.) with [ symbols and Num[bers (.2) and cháractẽrs with diacrítics
\xtx text with symbols and numbers and cháractẽrs with diacrítics

Answer 2

你可以稍微重构一下，所以你不必把它全部放在一个正则表达式中：

use strict;
use warnings;    
$^I = '.bak';
while (<>) {
    print; 
    if(/^\\txt/) {
        s/^\\txt//; # remove \txt
        s/[\[\]\(\)//g; # remove all unwanted characters
        print "\xtx $_";
    }
    print; 
}

Answer 3

为了记录，这是我最终使用的上述 sln 答案的（稍作修改）版本。它可以像我用perl script.pl myfile.txt调用原始脚本一样被调用：

#!/usr/bin/perl

use strict;
use warnings;
use open qw(:std :utf8);
$^I = '.bak'; # create a backup copy 

while (<>) {
   s/^(\\txt )(.*)/GetConvetedLine($1,$2)/me;
   print;
}

sub GetConvetedLine
{
    my ($txt, $body) = @_;
    my $newbody = $body;
    $newbody =~ s/[^\pL\s]+//g;
    $newbody =~ s/ \s+/ /g;
    $newbody = lc($newbody);
    return $txt . $body . "\n" . "\\xtx " . $newbody;
}