检索与Perl中的所有正则表达式完全匹配的模式

问题描述

我有一个子图数据库，如下所示：

t # 3-231,1
v 0 94
v 1 14
v 2 16
v 3 17
u 0 1 2
u 0 2 2
u 0 3 2
t # 3-232,1
v 0 14
v 1 94
v 2 19
v 3 91
u 0 1 2
u 0 3 2
u 1 2 2
t # 3-233,1
v 0 17
v 1 91
v 2 16
v 3 94
u 0 1 2
u 0 3 2
u 1 2 2
t # 3-234,1
v 0 90
v 1 93
v 2 102
v 3 95
u 0 1 2
u 0 3 2
u 1 2 2

我想检索包含以下模式的所有交易：'u 0 1 2'和'u 0 2 2'以及交易ID（例如，行以t＃开头）。

我使用以下代码来完成这项工作：

#!/usr/bin/perl -w

use strict;

my $input = shift @ARGV or die $!; 

open (FILE,"$input") or die $!;

while (<FILE>) {

my @fields = ('t','u\ 0\ 1','u\ 0\ 2');  
my $field_regex = join( "|",@fields );
my @field_lines;

    push( @field_lines,$_ ) if ( /^(?:$field_regex) / );
    last if @field_lines == @fields;

push @field_lines,"";

print join( "\n",sort @field_lines );
}

close FILE;

但是，当只有一行匹配时，它将检索模式，例如：

t # 3-231,1
u 0 1 2
u 0 2 2
t # 3-232,1
u 0 1 2
t # 3-233,1
u 0 1 2

我的最终目标是检索与我的正则表达式完全匹配的交易，例如

t # 3-231,1
u 0 1 2
u 0 2 2

谢谢您的帮助！

Olha

解决方法

一种方法：保留当前的交易ID，并将感兴趣的行存储在与该交易ID密钥关联的arrayref中的哈希中。

use warnings;
use strict;
use feature 'say';    
use Data::Dump qw(dd);

my @fields = ('u 0 1','u 0 2');  
my $field_regex = join '|',map { quotemeta } @fields;
    
my (%trans,$tid);

while (<>) {
    chomp;
    if (/^t #/) { 
        $tid = $_; 
        next;
    }   
  
    push @{$trans{$tid}},$_  if /$field_regex/;
}

dd %trans;

# foreach my $tid (sort keys %trans) { 
#     say $tid;
#     say for @{$trans{$tid}};
# }

为简化起见，我使用while (<>)逐行读取调用程序时命令行中给定的所有文件（或STDIN）。我使用Data::Dump来显示复杂的数据结构；核心是Data::Dumper。

qotemeta会转义所有ASCI非“ word”字符，这些字符可能会抛出正则表达式，并且其中包括空格。

上面的程序通常会从文件中丢失事务ID的顺序，因为哈希键是无序的，而由于每个ID在数组中，因此它会保留每个ID的行顺序。如果需要，这并不难补救。

仅使用提供的数据文件进行了测试。

,

通过将文件内容视为块而不是行，可以最轻松地处理这种模式。

这是一个简单的示例（包含您的数据）：

use strict;

my $big_string;
my $trans;
my $block;

open my $fh,'<','/tmp/file.txt' or die "Can't open file $!";

$big_string = do { local $/; <$fh> };

while ($big_string=~/^(t\h*#\h*[0-9,\h-]+[\s\S]*?(?=(?:^t\h*#\h*[0-9,\h-]+)|\z))/mg) {
    $block=$1;
    $trans=$1 if $block=~/^(t\h*#\h*[0-9,\h-]+)/;
    if ($block=~/^(u\h+0\h+[12]\h+2)/m){
        print "$trans\n";
        for ($block=~/^(u\h+0\h+[12]\h+2)/mg) {
            print "$1\n";
        }
    }
}   

打印：

t # 3-231,1
u 0 2 2
u 0 2 2
t # 3-232,1
u 0 1 2
t # 3-233,1
u 0 1 2
t # 3-234,1
u 0 1 2

这假设您的数据很容易放入内存。如果没有，那么还有很多方法可以逐块读取文件。

如果只希望与第二个正则表达式具有多个匹配项的块：

while ($big_string=~/^(t\h*#\h*[0-9,\h-]+)/;
    @matches=$block=~/^(u\h+0\h+[12]\h+2)/mg;
    if (scalar @matches >1) {
        print "$trans\n";
        print join "\n",@matches;
    }
}   

打印：

t # 3-231,1
u 0 1 2
u 0 2 2

当然还有TIMTOWDI：

my @result = do{ local @_ = split(/^(t\h+#[\h\d,-]+)/m,$big_string); 
                        @_[1..$#_]};

for my $i (0 .. @result/2-1) {
    @matches=$result[2*$i+1]=~/^(u\h+0\h+[12]\h+2)/mg;
    if (scalar @matches>1){
        print "$result[2*$i]\n";
        print join("\n",@matches);
    }
}   
t # 3-231,1
u 0 1 2
u 0 2 2

,

perl -lne '@h=($_) if /^t #/; push @h,$_ if /^u 0 [12] 2/; if (@h==3) { print shift @h while @h }' file

重置并保持交易行；追加匹配行；如果您累积了3行，请打印并重置。