我有一个使用Perl的readdir()的问题。我想收集目录中具有我指定的相同前缀文件名的所有文件。因此,对于每个前缀,我需要使用Perl的readdir()来grep所有相关文件。
假设前缀为“abc”,有几个名称为“abc_1”,“abc_2”等的文件。
但是,我注意到如果我把opendir,closedir放在一个循环之外(循环遍历文件名前缀列表),我只能从dir grep第一个前缀 - 以下所有grepping都失败了。如果我选择在循环中每次调用opendir和closedir,它工作正常,但我担心它根本没有效率。
我的问题是如何才能提高效率?奇怪的是我无法在循环中多次调用readdir。
提前多多感谢!
-Jin
答案 0 :(得分:8)
答案 1 :(得分:6)
为什么不一次读取所有文件,然后在该列表上执行过滤?
答案 2 :(得分:1)
rewinddir()会在这个时刻提供帮助吗?
答案 3 :(得分:1)
为什么不要只让@files = <abc_*>
?
答案 4 :(得分:-1)
使用Text::Trie模块将文件分组到readdir
:
use File::Spec::Functions qw/ catfile /;
use Text::Trie qw/ Trie walkTrie /;
sub group_files {
my($dir,$pattern) = @_;
opendir my $dh, $dir or die "$0: opendir $dir: $!";
my @trie = Trie readdir $dh;
my @groups;
my @prefix;
my $group = [];
my $exitnode = sub {
pop @prefix;
unless (@prefix) {
push @groups => $group if @$group;
$group = [];
}
};
my $leaf = sub {
local $_ = join "" => @prefix;
if (/$pattern/) {
my $full = catfile $dir => "$_$_[0]";
push @$group => $full if -f $full;
}
$exitnode->() unless @prefix;
};
my $node = sub { push @prefix => $_[0] };
@$_[0,1,5] = ($leaf, $node, $exitnode) for \my @callbacks;
walkTrie @callbacks => @trie;
wantarray ? @groups : \@groups;
}
您可以在
中使用它my($pattern,$dir) = @ARGV;
$pattern //= "^";
$dir //= ".";
my $qr = eval "qr/$pattern/" || die "$0: bad pattern ($pattern)\n";
my @groups = group_files $dir, $qr;
use Data::Dumper;
print Dumper \@groups;
例如:
$ ls abc_1 abc_12 abc_2 abc_3 abc_4 prefixes xy_7 xyz_1 xyz_2 xyz_3 $ ./prefixes $VAR1 = [ [ './prefixes' ], [ './abc_4', './abc_1', './abc_12', './abc_3', './abc_2' ], [ './xy_7', './xyz_1', './xyz_3', './xyz_2' ] ];
使用可选的regular-expression参数作为前缀的谓词:
$ ./prefixes '^.{3,}' $VAR1 = [ [ './abc_4', './abc_1', './abc_12', './abc_3', './abc_2' ], [ './xyz_1', './xyz_3', './xyz_2' ] ]; $ ./prefixes '^.{2,}' $VAR1 = [ [ './abc_4', './abc_1', './abc_12', './abc_3', './abc_2' ], [ './xy_7', './xyz_1', './xyz_3', './xyz_2' ] ];
答案 5 :(得分:-2)
我会在一次传递中对此进行编码,如下所示:
while readdir() returns a file name
if the file prefix has not been seen before
record prefix and create directory for this prefix
end if
move (copy?) file to correct directory
end while
对于anally retentive,这里有一些(未经测试的)代码应该可行。错误处理留给读者练习。
require File::Copy;
my $old_base_dir = "original_directory_path";
opendir (my $dir_handle, "$old_base_dir");
my %dir_list;
my $new_base_dir = "new_directory_path";
while (my $file_name = readdir($dir_handle)) {
next if ! -f $file_name; # only move regular files
(my $prefix) = split /_/, $file_name, 1; # assume first _ marks end of prefix
mkdir "$new_base_dir/$prefix" unless exists $dir_list{$prefix};
move("$old_base_dir/$file_name", "$new_base_dir/$file_name"); # assume unix system
}
closedir($dir_handle};