Perl - 基于捕获组的多行正则表达式和追加
Perl - Multi-line Regex & Appending Based on Capture Group
我是 Perl 的新手，正在尝试构建一个脚本来解析来自 IBM SPSS Statistics (SPSS) 的一些输出文件，以自动为一些标准程序生成语法 (在此示例中，重新编码并指定缺失值）。
此时，我已经删除了一些无关的行，并通过一些替换正则表达式（我关闭了输入记录分隔符以进行多行替换）对我的文件进行了清理和重新格式化。我正在使用的文本如下所示：
VALUE LABELS ROAD
0 'No'
1 'Yes'.
VALUE LABELS NOCALL
1 'Refused to be interviewed'
2 'Not at home'
3 'No one on Premises'
8 'Other'
9997 'Not Applicable'
9999 'Don't Know'.
VALUE LABELS Q1
999 'Don't know'.
VALUE LABELS Q2
1 'Strongly dislike'
2 'Somewhat dislike'
3 'Would not care'
4 'Somewhat like'
5 'Strongly like'
7 'Not Applicable'
9 'Don't know'.
我想将正则表达式添加到我的脚本中，它将遍历 "VALUE LABELS" 和“.”之间的每个块。在最后查找 7 后跟 "Not Applicable" 或 9 后跟 "Don't Know"，捕获紧跟在 "VALUE LABELS" 之后的变量名称并将其附加到我的输出的末尾我知道哪些变量具有 "Not Applicable" 值，哪些变量具有 "Don't Know" 值。所以在这个例子中，我的输出将是原始文件，末尾有这些额外的行：
NOT APPLICABLE: NOCALL Q2
DON'T KNOW: NOCALL Q1 Q2
目前，我一辈子都想不出如何让我的正则表达式在从 "VALUE LABELS" 到句号的每个块内只读。相反，它将跨块从第一个 "VALUE LABELS" 到“7 Not Applicable”的最后一个实例，或者从第一个 "VALUE LABELS" 到“7 Not Applicable”的第一个实例，无论是否NA 值在同一个块中。
我目前的Perl代码如下：
#!/bin/perl
use strict;
use warnings;
BEGIN { # Input and Output Record Separators Off
$\ = undef;
$/ = undef;
}
open( my $infile, "<", $ARGV[0]);
my $outfile = "t2" . $ARGV[0];
open( my $write, ">", $outfile);
LINE: while ( <$infile> ) {
# These are the regexes currently cleaning and reformatting the input
s/\f/\n/g;
s/(\d+\s.*)(\n\n)/\./g;
s/(\R\R).*\R\R//g;
s/(\R\R).*\R\R//g;
s/(\R\R)(.*\R)/VALUE LABELS /g;
}
continue {
die "-p destination: $!\n" unless print $write "$_";
# Here is the regex I'm having an issue with
if ( $infile =~ m/VALUE LABELS(.*)\n(?s).*\d+7 \x27Not Applicable\x27.*?\./g) {
print $write "\n\nNOT APPLICABLE: ";
]
}
有什么方法可以让我得到这个return我正在寻找的东西吗？是否有更好的方法来编写整个脚本，让我在中途更改行分隔符？
我会将整个输入文件读取到一个变量中，然后尝试匹配 /(VALUE LABELS(.*?)\.\n)/gm 之类的东西。 /m 修饰符告诉正则表达式引擎使用多行匹配和 .*?非贪婪匹配紧接在换行符之前的第一个点。
然后，在该匹配结果中，使用第二个正则表达式查找 "Not Applicable" 字符串。重复直到消耗完所有输入。
从表面上看，您要求 range operator。
while (<$fh>)
{
if (/^\s*VALUE LABELS/ .. /\.$/) {
# a line between the two identified above (including them)
# process as below
}
}
您的说明“到时期”有点简单，但我相信您知道您的数据。
但是，由于您的文件已经“清理”，因此它们只有显示格式的块，所以您实际上不需要确定范围。其余代码相当简单。
根据数据我把7或9作为一组数字中的最后一个，排在第一位，后面是空格和那些短语。如果这不正确，请澄清。
my (%res, $label_name);
while (<$fh>)
{
next if /^\s*$/;
if (/^\s*VALUE LABELS\s*(.*)/) {
$label_name = ;
next;
}
if (/^\d*7\s*'(Not Applicable)'/i or /^\d*9\s*'(Don't Know)'/i) # '
{
# has either "Not Applicable" or "Don't Know"
push @{$res{uc }}, $label_name;
}
}
print "$_: @{$res{$_}}\n" for keys %res;
这将打印所需的输出。
一旦遇到该行，我们将重置 $label_name。空行也被跳过。
数据在哈希 %res 中结束，键是这两个捕获的短语。每个键的值都是一个匿名数组，每次检测到一个短语时都会添加该块的 $label_name。这是通过 push 将其添加到该键的取消引用数组 @{ $res{} } 来完成的。
有关参考资料和复杂的数据结构，请参阅教程 perlreftut and cookbook perldsc。
uc 用于根据所需的输出格式更改为大写。这有点浪费，因为 uc 每次都运行。您可以省略它并 post-process 获得的散列。这确实涉及将哈希复制到一个新的哈希中，这可能会或可能不会更有效。或者，您可以只在打印结果时使用 uc。
为了将内容追加到文件open，它处于追加模式，'>>'。见下文。
剩下的就是将其与您显示的清理数据的处理联系起来。我不知道你为什么需要将文件作为字符串处理。这可能有充分的理由，但我 不 推荐它用于问题所要求的，在数据被清理后。多行文本上的正则表达式代替上述简单处理更难更改。
您的代码有必要更改一下，更改记录分隔符的使用方式。通常你想要localize他们的变化，而不是在BEGIN块中设置它们。像这样
my $file_content;
CLEAN_UP_DATA: {
local $/; # slurp the file ($/ is now undef)
open my $fh, '<', $file or die "Can't open $file: $!";
$file_content = <$fh>;
# process file content, for example like with code in the question
};
# Here $/ is whatever it was before the block, likely the good old default
我只是这样命名块 (CLEAN_UP_DATA:)，这不是必需的。 };最后的分号是。请注意，一旦我们取消设置 $/ ，整个文件就会立即读入一个字符串。 （您的 while (<$infile>)
有 一次迭代 。您可以通过在循环内打印 $. 来查看。）
那你就可以继续了。一种方法是将包含清理内容的字符串分成行
foreach my $line (split /\n/, $file_content) {
# process line by line
}
并按原样使用此答案中的代码（或其他逐行方法）。
另一种方法是简单地写出清理后的文件并重新打开它。
CLEAN_UP_DATA: {
local $/; # slurp the file ($/ is now undef)
open my $fh, '<', $file or die "Can't open $file: $!";
my $file_content = <$fh>;
# process file content
my $fh_out, '>', $outfile or die "Can't open $outfile: $!";
# write it out
};
open my $fh, '<', $outfile or die "Can't open $outfile: $!";
# Process line by line, obtaining %res
close $fh;
open my $fh_app, '>>', $outfile or die "Can't open $outfile to append: $!";
# Now append results as needed, for example
print $fh_app "$_: @{$res{$_}}\n" for keys %res;
在这里您也可以按原样使用此答案中的代码，或其他逐行解决方案。
如果句号 . 保证只出现在每个块的末尾，那么我建议使用它作为输入分隔符
该程序将每个块读入$_并提取VALUE LABELS之后的变量名。然后检查该块是否存在 7 Not Applicable 和 9 Don't Know，并将变量名称添加到 [=15= 中的列表中] 对于出现的每个短语
输出只是转储哈希的问题
use strict;
use warnings 'all';
my ($file) = @ARGV;
my %info;
open my $fh, '<', $file or die qq{Unable to open "$file" for input: $!};
local $/ = "."; # Terminate each read at a full stop
while ( <$fh> ) {
next unless my ($var) = /VALUE LABELS\s+(\S+)/;
for my $pattern ( qr/7\s+'(Not Applicable)'/i, qr/9 '(Don't Know)'/i ) {
push @{ $info{uc } }, $var if /$pattern/;
}
}
while ( my ($label, $vars) = each %info ) {
printf "%s: %s\n", $label, "@$vars";
}
输出
DON'T KNOW: NOCALL Q1 Q2
NOT APPLICABLE: NOCALL Q2
我是 Perl 的新手，正在尝试构建一个脚本来解析来自 IBM SPSS Statistics (SPSS) 的一些输出文件，以自动为一些标准程序生成语法 (在此示例中，重新编码并指定缺失值）。
此时，我已经删除了一些无关的行，并通过一些替换正则表达式（我关闭了输入记录分隔符以进行多行替换）对我的文件进行了清理和重新格式化。我正在使用的文本如下所示：
VALUE LABELS ROAD
0 'No'
1 'Yes'.
VALUE LABELS NOCALL
1 'Refused to be interviewed'
2 'Not at home'
3 'No one on Premises'
8 'Other'
9997 'Not Applicable'
9999 'Don't Know'.
VALUE LABELS Q1
999 'Don't know'.
VALUE LABELS Q2
1 'Strongly dislike'
2 'Somewhat dislike'
3 'Would not care'
4 'Somewhat like'
5 'Strongly like'
7 'Not Applicable'
9 'Don't know'.
我想将正则表达式添加到我的脚本中，它将遍历 "VALUE LABELS" 和“.”之间的每个块。在最后查找 7 后跟 "Not Applicable" 或 9 后跟 "Don't Know"，捕获紧跟在 "VALUE LABELS" 之后的变量名称并将其附加到我的输出的末尾我知道哪些变量具有 "Not Applicable" 值，哪些变量具有 "Don't Know" 值。所以在这个例子中，我的输出将是原始文件，末尾有这些额外的行：
NOT APPLICABLE: NOCALL Q2
DON'T KNOW: NOCALL Q1 Q2
目前，我一辈子都想不出如何让我的正则表达式在从 "VALUE LABELS" 到句号的每个块内只读。相反，它将跨块从第一个 "VALUE LABELS" 到“7 Not Applicable”的最后一个实例，或者从第一个 "VALUE LABELS" 到“7 Not Applicable”的第一个实例，无论是否NA 值在同一个块中。
我目前的Perl代码如下：
#!/bin/perl
use strict;
use warnings;
BEGIN { # Input and Output Record Separators Off
$\ = undef;
$/ = undef;
}
open( my $infile, "<", $ARGV[0]);
my $outfile = "t2" . $ARGV[0];
open( my $write, ">", $outfile);
LINE: while ( <$infile> ) {
# These are the regexes currently cleaning and reformatting the input
s/\f/\n/g;
s/(\d+\s.*)(\n\n)/\./g;
s/(\R\R).*\R\R//g;
s/(\R\R).*\R\R//g;
s/(\R\R)(.*\R)/VALUE LABELS /g;
}
continue {
die "-p destination: $!\n" unless print $write "$_";
# Here is the regex I'm having an issue with
if ( $infile =~ m/VALUE LABELS(.*)\n(?s).*\d+7 \x27Not Applicable\x27.*?\./g) {
print $write "\n\nNOT APPLICABLE: ";
]
}
有什么方法可以让我得到这个return我正在寻找的东西吗？是否有更好的方法来编写整个脚本，让我在中途更改行分隔符？
我会将整个输入文件读取到一个变量中，然后尝试匹配 /(VALUE LABELS(.*?)\.\n)/gm 之类的东西。 /m 修饰符告诉正则表达式引擎使用多行匹配和 .*?非贪婪匹配紧接在换行符之前的第一个点。
然后，在该匹配结果中，使用第二个正则表达式查找 "Not Applicable" 字符串。重复直到消耗完所有输入。
从表面上看，您要求 range operator。
while (<$fh>)
{
if (/^\s*VALUE LABELS/ .. /\.$/) {
# a line between the two identified above (including them)
# process as below
}
}
您的说明“到时期”有点简单，但我相信您知道您的数据。
但是，由于您的文件已经“清理”，因此它们只有显示格式的块，所以您实际上不需要确定范围。其余代码相当简单。
根据数据我把7或9作为一组数字中的最后一个，排在第一位，后面是空格和那些短语。如果这不正确，请澄清。
my (%res, $label_name);
while (<$fh>)
{
next if /^\s*$/;
if (/^\s*VALUE LABELS\s*(.*)/) {
$label_name = ;
next;
}
if (/^\d*7\s*'(Not Applicable)'/i or /^\d*9\s*'(Don't Know)'/i) # '
{
# has either "Not Applicable" or "Don't Know"
push @{$res{uc }}, $label_name;
}
}
print "$_: @{$res{$_}}\n" for keys %res;
这将打印所需的输出。
一旦遇到该行，我们将重置 $label_name。空行也被跳过。
数据在哈希 %res 中结束，键是这两个捕获的短语。每个键的值都是一个匿名数组，每次检测到一个短语时都会添加该块的 $label_name。这是通过 push 将其添加到该键的取消引用数组 @{ $res{} } 来完成的。
有关参考资料和复杂的数据结构，请参阅教程 perlreftut and cookbook perldsc。
uc 用于根据所需的输出格式更改为大写。这有点浪费，因为 uc 每次都运行。您可以省略它并 post-process 获得的散列。这确实涉及将哈希复制到一个新的哈希中，这可能会或可能不会更有效。或者，您可以只在打印结果时使用 uc。
为了将内容追加到文件open，它处于追加模式，'>>'。见下文。
剩下的就是将其与您显示的清理数据的处理联系起来。我不知道你为什么需要将文件作为字符串处理。这可能有充分的理由，但我 不 推荐它用于问题所要求的，在数据被清理后。多行文本上的正则表达式代替上述简单处理更难更改。
您的代码有必要更改一下，更改记录分隔符的使用方式。通常你想要localize他们的变化，而不是在BEGIN块中设置它们。像这样
my $file_content;
CLEAN_UP_DATA: {
local $/; # slurp the file ($/ is now undef)
open my $fh, '<', $file or die "Can't open $file: $!";
$file_content = <$fh>;
# process file content, for example like with code in the question
};
# Here $/ is whatever it was before the block, likely the good old default
我只是这样命名块 (CLEAN_UP_DATA:)，这不是必需的。 };最后的分号是。请注意，一旦我们取消设置 $/ ，整个文件就会立即读入一个字符串。 （您的 while (<$infile>)
有 一次迭代 。您可以通过在循环内打印 $. 来查看。）
那你就可以继续了。一种方法是将包含清理内容的字符串分成行
foreach my $line (split /\n/, $file_content) {
# process line by line
}
并按原样使用此答案中的代码（或其他逐行方法）。
另一种方法是简单地写出清理后的文件并重新打开它。
CLEAN_UP_DATA: {
local $/; # slurp the file ($/ is now undef)
open my $fh, '<', $file or die "Can't open $file: $!";
my $file_content = <$fh>;
# process file content
my $fh_out, '>', $outfile or die "Can't open $outfile: $!";
# write it out
};
open my $fh, '<', $outfile or die "Can't open $outfile: $!";
# Process line by line, obtaining %res
close $fh;
open my $fh_app, '>>', $outfile or die "Can't open $outfile to append: $!";
# Now append results as needed, for example
print $fh_app "$_: @{$res{$_}}\n" for keys %res;
在这里您也可以按原样使用此答案中的代码，或其他逐行解决方案。
如果句号 . 保证只出现在每个块的末尾，那么我建议使用它作为输入分隔符
该程序将每个块读入$_并提取VALUE LABELS之后的变量名。然后检查该块是否存在 7 Not Applicable 和 9 Don't Know，并将变量名称添加到 [=15= 中的列表中] 对于出现的每个短语
输出只是转储哈希的问题
use strict;
use warnings 'all';
my ($file) = @ARGV;
my %info;
open my $fh, '<', $file or die qq{Unable to open "$file" for input: $!};
local $/ = "."; # Terminate each read at a full stop
while ( <$fh> ) {
next unless my ($var) = /VALUE LABELS\s+(\S+)/;
for my $pattern ( qr/7\s+'(Not Applicable)'/i, qr/9 '(Don't Know)'/i ) {
push @{ $info{uc } }, $var if /$pattern/;
}
}
while ( my ($label, $vars) = each %info ) {
printf "%s: %s\n", $label, "@$vars";
}
输出
DON'T KNOW: NOCALL Q1 Q2
NOT APPLICABLE: NOCALL Q2