[英]retrieve patterns that exactly match all regex in 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-233, 1
u 0 1 2
我的最終目標是檢索與我的正則表達式完全匹配的事務,例如
t # 3-231, 1
u 0 1 2
u 0 2 2
謝謝您的幫助!
奧爾哈
一種方法:保留當前的事務 ID,並將感興趣的行存儲在與 hash 中的事務 ID 鍵關聯的數組引用中。
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 非“單詞”字符,這些字符可能會拋出正則表達式,其中包括空格。
上面的程序通常會丟失文件中事務 ID 的順序,因為 hash 鍵是無序的,而它保持每個 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
這假設您的數據很容易適合 memory。 如果沒有,也有很多方法可以逐塊讀取文件。
如果您只想要與第二個正則表達式有多個匹配的塊:
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-]+)/;
@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
重置並保留交易線; append 配套線; 如果累積 3 行,則打印並重置。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.