如何动态构建Perl正则表达式?

时间:2009-05-22 15:55:21

标签: regex perl configuration

我有一个使用File :: Next :: files遍历目录层次结构的Perl脚本。它只会返回以“.avi”,“。flv”,“。mp3”,“。mp4”和“.wmv”结尾的脚本文件。它还将跳过以下子目录:“。snvn”和以“.frames”结尾的任何子目录。这在下面的file_filterdescend_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$/

6 个答案:

答案 0 :(得分:26)

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

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);

答案 1 :(得分:3)

假设您使用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.
}

(这是完全未经测试的。)

答案 2 :(得分: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

答案 3 :(得分:1)

使用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”作为“规则”。

答案 4 :(得分:1)

如果你想构建一个可能很大的正则表达式并且不想打扰调试括号,请使用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)

答案 5 :(得分:0)

虽然File :: Find :: Rule已经有办法解决这个问题,但在类似的情况下,你真的不想要一个正则表达式。正则表达式在这里买不多,因为你在每个文件名的末尾都要找到一个固定的字符序列。您想知道该固定序列是否在您感兴趣的序列列表中。将所有扩展存储在散列中并查看该散列:

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

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