Question

我有一个使用Perl的readdir（）的问题。我想收集目录中具有我指定的相同前缀文件名的所有文件。因此，对于每个前缀，我需要使用Perl的readdir（）来grep所有相关文件。

假设前缀为“abc”，有几个名称为“abc_1”，“abc_2”等的文件。

但是，我注意到如果我把opendir，closedir放在一个循环之外（循环遍历文件名前缀列表），我只能从dir grep第一个前缀 - 以下所有grepping都失败了。如果我选择在循环中每次调用opendir和closedir，它工作正常，但我担心它根本没有效率。

我的问题是如何才能提高效率？奇怪的是我无法在循环中多次调用readdir。

提前多多感谢！

-Jin

Answer 1

目录（和文件）句柄是迭代器。从一个读取消耗数据，您需要存储该数据或重置迭代器的位置。关闭和重新开放是艰难的方式;请改用rewinddir。

或者，使用glob一步完成阅读和过滤。

Answer 2

为什么不一次读取所有文件，然后在该列表上执行过滤？

Answer 3

rewinddir（）会在这个时刻提供帮助吗？

Answer 4

为什么不要只让@files = <abc_*>？

Answer 5

使用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'
          ]
        ];

Answer 6

我会在一次传递中对此进行编码，如下所示：

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

如何在同一目录中多次有效地使用Perl的readdir？

6 个答案: