如何动态构建 Perl 正则表达式？答案

【问题标题】：How do I build Perl regular expressions dynamically?如何动态构建 Perl 正则表达式？
【发布时间】：2009-05-26 22:57:42
【问题描述】：

我有一个使用 File::Next::files 遍历目录层次结构的 Perl 脚本。它只会返回以“.avi”、“.flv”、“.mp3”、“.mp4”和“.wmv”结尾的脚本文件。它还将跳过以下子目录：“.svn”和任何以“.frames”结尾的子目录。这在下面的file_filter 和descend_filter 子例程中指定。

my $iter = File::Next::files(
        { file_filter => \&file_filter, descend_filter => \&descend_filter },
        $directory );

sub file_filter { 
    # Called from File::Next:files.
    # Only select video files that end with the following extensions.
    /.(avi|flv|mp3|mp4|wmv)$/
}

sub descend_filter { 
    # Called from File::Next:files.
    # Skip subfolders that either end in ".frames" or are named the following:
    $File::Next::dir !~ /.frames$|^.svn$/
}

我想要做的是将允许的文件扩展名和不允许的子目录名称放在配置文件中，以便可以即时更新它们。

我想知道的是如何根据配置文件中的参数对子例程进行编码以构建正则表达式结构？

/.(avi|flv|mp3|mp4|wmv)$/

$File::Next::dir !~ /.frames$|^.svn$/

【问题讨论】：

无法帮助您解决问题，但您使用的那个包看起来很棒。我用普通的旧 File::Find 做同样的事情，它很多更混乱。我得试试这个。谢谢！ +1
结帐：search.cpan.org/dist/File-Next
p3rl.org/File::Find::Rule 可能更适合您，具体取决于具体情况。

标签： regex perl configuration

【解决方案1】：

假设您已解析配置文件以获取扩展名和忽略目录的列表，您可以将正则表达式构建为字符串，然后使用qr 运算符将其编译为正则表达式：

my @extensions = qw(avi flv mp3 mp4 wmv);  # parsed from file
my $pattern    = '\.(' . join('|', @wanted) . ')$';
my $regex      = qr/$pattern/;

if ($file =~ $regex) {
    # do something
}

编译不是绝对必要的；你可以直接使用字符串模式：

if ($file =~ /$pattern/) {
    # do something
}

目录有点困难，因为您有两种不同的情况：全名和后缀。您的配置文件必须使用不同的键来明确哪个是哪个。例如“dir_name”和“dir_suffix”。对于全名，我只需构建一个哈希：

%ignore = ('.svn' => 1);

后缀目录可以和文件扩展名一样：

my $dir_pattern = '(?:' . join('|', map {quotemeta} @dir_suffix), ')$';
my $dir_regex   = qr/$dir_pattern/;

您甚至可以将模式构建到匿名子例程中以避免引用全局变量：

my $file_filter    = sub { $_ =~ $regex };
my $descend_filter = sub {
    ! $ignore{$File::Next::dir} &&
    ! $File::Next::dir =~ $dir_regex;
};

my $iter = File::Next::files({
    file_filter    => $file_filter,
    descend_filter => $descend_filter,
}, $directory);

【讨论】：

我没有解释的是我会让客户修改配置文件。我不能假设他们会知道 Perl 或知道的足够多，不会在正则表达式中引入语法错误。所以我真的不想从配置文件中读取正则表达式，我只想读取文件扩展名和目录名称和/或目录模式的列表。示例： ext = avi ext = flv ext = mp3 dir = .svn dirp= .frames 读取此信息后，我想动态创建功能类似于： .(avi|flv|mp3|mp4|wmv)$

【解决方案2】：

假设您使用Config::General 作为您的配置文件，并且它包含以下几行：

<MyApp>
    extensions    avi flv mp3 mp4 wmv
    unwanted      frames svn
</MyApp>

然后您可以像这样使用它（更多信息请参见 Config::General）：

my $conf = Config::General->new('/path/to/myapp.conf')->getall();
my $extension_string = $conf{'MyApp'}{'extensions'};

my @extensions = split m{ }, $extension_string;

# Some sanity checks maybe...

my $regex_builder = join '|', @extensions;

$regex_builder = '.(' . $regex_builder . ')$';

my $regex = qr/$regex_builder/;

if($file =~ m{$regex}) {
    # Do something.
}


my $uw_regex_builder = '.(' . join ('|', split (m{ }, $conf{'MyApp'}{'unwanted'})) . ')$';
my $unwanted_regex = qr/$uw_regex_builder/;

if(File::Next::dir !~ m{$unwanted_regex}) {
    # Do something. (Note that this does not enforce /^.svn$/. You
    # will need some kind of agreed syntax in your conf-file for that.
}

（这是完全未经测试的。）

【讨论】：

谢谢。顺便问一下，为什么我的 $regex = qr/$regex_builder/ 语句是必要的？
在使用qr// 之前不必将整个正则表达式构建成一个字符串。你可以这样做： my $regex_builder = join '|', @extensions;我的 $regex = qr/\.($regex_builder)$/;

【解决方案3】：

像构建普通字符串一样构建它，然后在最后使用插值将其转换为已编译的正则表达式。还要小心，你没有逃跑。或将其放在字符类中，因此它表示任何字符（而不是文字句点）。

#!/usr/bin/perl

use strict;
use warnings;

my (@ext, $dir, $dirp);
while (<DATA>) {
    next unless my ($key, $val) = /^ \s* (ext|dirp|dir) \s* = \s* (\S+)$/x;
    push @ext, $val if $key eq 'ext';
    $dir = $val     if $key eq 'dir';
    $dirp = $val    if $key eq 'dirp';
}

my $re = join "|", @ext;
$re = qr/[.]($re)$/;

print "$re\n";

while (<>) {
    print /$re/ ? "matched" : "didn't match", "\n";
}

__DATA__
ext = avi
ext = flv
ext = mp3
dir = .svn
dirp= .frames

【讨论】：

当我运行代码并打印出 $re 时，我得到了： (?-xism:[.](avi|flv|mp3)$) 似乎有效。非常感谢。
我假设目录和/或目录后缀可能有多个值可以忽略，尽管没有明确指定。

【解决方案4】：

File::Find::Rule 相当直接，只是事先创建列表的一个例子。

use strict;
use warnings;
use aliased 'File::Find::Rule';


# name can do both styles. 
my @ignoredDirs = (qr/^.svn/,  '*.frames' );
my @wantExt = qw( *.avi *.flv *.mp3 );

my $finder = Rule->or( 
    Rule->new->directory->name(@ignoredDirs)->prune->discard, 
    Rule->new->file->name(@wantExt)
);

$finder->start('./');

while( my $file = $finder->match() ){
    # Matching file.
}

那么它只是填充这些数组的一个例子。（注意：上面的代码也未经测试，但可能会工作）。我通常会为此使用 YAML，它让生活更轻松。

use strict;
use warnings;
use aliased 'File::Find::Rule';
use YAML::XS;

my $config = YAML::XS::Load(<<'EOF');
---
ignoredir:
- !!perl/regexp (?-xism:^.svn)
- '*.frames'
want:
- '*.avi'
- '*.flv'
- '*.mp3'
EOF

my $finder = Rule->or( 
    Rule->new->directory->name(@{ $config->{ignoredir} })->prune->discard, 
    Rule->new->file->name(@{ $config->{want} })
);

$finder->start('./');

while( my $file = $finder->match() ){
    # Matching file.
}

注意使用方便的模块“aliased.pm”，它为我导入“File::Find::Rule”作为“Rule”。

File::Find::Rule - File::Find 的替代接口
YAML::XS - 使用 XS 和 libyaml 进行 Perl YAML 序列化
aliased - 使用更短的类名。

【讨论】：

【解决方案5】：

如果您想构建一个可能很大的正则表达式并且不想麻烦调试括号，请使用 Perl 模块为您构建它！

use strict;
use Regexp::Assemble;

my $re = Regexp::Assemble->new->add(qw(avi flv mp3 mp4 wmv));

...

if ($file =~ /$re/) {
    # a match!
}

print "$re\n"; # (?:(?:fl|wm)v|mp[34]|avi)

【讨论】：

【解决方案6】：

虽然 File::Find::Rule 已经有办法解决这个问题，但在类似的情况下，您并不需要正则表达式。正则表达式在这里不会给您带来太多好处，因为您要在每个文件名的末尾寻找固定的字符序列。您想知道该固定序列是否在您感兴趣的序列列表中。将所有扩展存储在哈希中并查看该哈希：

my( $extension ) = $filename =~ m/\.([^.]+)$/;
if( exists $hash{$extension} ) { ... }

您无需构建正则表达式，也无需通过几种可能的正则表达式替换来检查您必须检查的每个扩展。

【讨论】：