Perl - 遍历潜在的正则表达式匹配列表，直到找到一个然后退出循环答案

【问题标题】：Perl - iterate through list of potential regex matches until one is found then exit loopPerl - 遍历潜在的正则表达式匹配列表，直到找到一个然后退出循环
【发布时间】：2014-09-05 11:53:09
【问题描述】：

在我的 perl 脚本中，我想在许多目录中的某些文件中查找一些潜在的正则表达式匹配项。

我有一个哈希

my %qc = ("QCNM Daily QC"      => "GUN", 
          "Intrinsic Flood QA" => "PUN");

这将大大增长。在$STUDY_DIR 目录中，我想查看所有图像头文件（image1.hd、image2.hd 等）并查找文本中是否存在任何哈希键。图像头文件只是纯文本文件。例如，我想查询 image1.hd 以查看文本“QCNM Daily QC”或“Intrinsic Flood QA”是否存在“如果 QCNM Daily QC 存在我想设置一个变量 $study_type = “GUN”，类似地如果“Intrinsic Flood” QA" 匹配我想设置 $study_type = "PUN"。如果没有找到匹配，我想继续下一个图像文件。

这是我目前的代码

#Loop through all images
for ( my $i = 1; $i <= $num_images; $i++ ) {
    # Check image is of type described in %qc
    # We are only interested in manipulating these files
    my $match = 0;     #matched qc key to image header
    my $study_type;    #key value for when hash key is found in image header (eg PUN)

    #reset the internal iterator so a prior each() doesn't affect the loop
    keys %qc;
    while ( my ( $k, $v ) = each %qc ) {
        my @match = grep {/$k/} glob("$STUDY_DIR/image${i}.hd");
        $match = 1 if match is found then break out of loop;
    }

    next if $match == 0;    #Not a QC image we are interested in skip to next image
}

我正在努力做的是遍历每个哈希键并查看该文本是否存在于 image.hd 中。如果确实存在，我想设置 $match = 1 和 $study_type = %qc{key} 并退出循环。如果它不存在，我想继续下一个潜在的比赛。哈希键是互斥的。虽然文本文件中可能没有匹配的键，但只能存在一个键。

解决方案必须在 perl 中，因为我有一些额外的 perl 命令要对匹配的文件执行。

【问题讨论】：

Grep 只是查看从 glob 返回的文件的名称，而不是内容。
@RobEarl 我可以像 linux shell 一样在 perl 中 grep 文件内容吗？
见：stackoverflow.com/questions/3783909/…

标签： regex perl grep

【解决方案1】：

您将需要实际加载文件内容以测试它们是否包含某些字符串。

我建议使用哈希键构建一个正则表达式进行比较。

以下打印出每个文件中的第一个匹配值，然后移动到下一个文件。请注意，我使用Sort::Key::Natural natsort 按自然顺序处理文件，但这只是样式偏好。

use strict;
use warnings;
use autodie;

use Sort::Key::Natural qw(natsort);

my $STUDY_DIR = '...';

my %qc = (
    "QCNM Daily QC"      => "GUN",
    "Intrinsic Flood QA" => "PUN"
);
my $qc_re = '(?:' . join('|', map quotemeta, sort {length $b <=> length $a} keys %qc) . ')';

FILE:
for my $file ( natsort glob("$STUDY_DIR/image*.hd") ) {
    open my $fh, '<', $file;
    while (<$fh>) {
        if (/($qc_re)/) {
            print "$qc{$1} - $file\n";
            next FILE;
        }
    }
}

【讨论】：

【解决方案2】：

以下解决方案虽然有点麻烦，但似乎可行。我敢肯定，一个合理的 perl 程序员会将代码行数减少一半以上。

#Loop through all images
for ( my $i = 1; $i <= $num_images; $i++ ) {
    # Check image is of type described in %qc
    # We are only interested in moving these files to QC filestore
    my $match      = 0;     #matched qc key to image header
    my $study_type = "";    #key value for when hash key is found in image header (eg PUN)

    my $image_header = "$STUDY_DIR/image${i}.hd";

    #reset the internal iterator so a prior each() doesn't affect the loop
    keys %qc;
    while ( my ( $k, $v ) = each %qc ) {
        open my $FH, $image_header or die "Could not open $image_header: $!";
        my (@lines) = grep /$k/, <$FH>;
        #If we get a match update required fields
        $match = 1 and $study_type = $qc{$k} if ( $#lines > 0 );
        close $FH;
        last if $match = 1;
    }

    print "$match, $study_type\n";
    next if $match == 0;    #Not a QC image we are interested in skip to next image
}

【讨论】：

【解决方案3】：

您可以使用 any 中的 List::MoreUtils 。它在第一次成功匹配时退出。

@images = glob("$STUDY_DIR/image${i}.hd)";

    if (any { $_ =~ /$k/ } @images){
       $match = 1;
       last;
    }

    $study_type = $qc{$key} and last if $match == 1;

【讨论】：