如何動態構建Perl正則表達式？

Question

我有一個使用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$/ 

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

Answer 2

比方說，您使用Config::General爲你的配置文件，它包含這些行：

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

然後，您可以使用它像這樣（見配置::一般更多）：（這是完全未經測試）

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. 
} 

Answer 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 

Answer 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 - 替代的接口文件::查找
• YAML::XS - 使用Perl的XS YAML序列化和libyaml
• aliased - 使用較短版本的類名。

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

Answer 6

雖然文件::查找::規則已經有辦法解決這個問題，在類似的情況下，你真的不想要一個正則表達式。正則表達式在這裏不會給你多少錢，因爲你正在尋找每個文件名末尾的固定字符序列。你想知道這個固定序列是否在你感興趣的序列列表中。存儲所有的擴展在哈希，並期待在哈希：

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

你並不需要建立一個正則表達式，你不需要去通過幾種可能的正則表達式的交替檢查每一個擴展你必須檢查。