Question

我正在尝试使用File :: Find来1）通过给定的文件夹和子文件夹，删除任何超过30天的文件，以及b）如果父文件夹在所有删除后为空，也删除它。

这是我的代码：

use strict;
use warnings;
no warnings 'uninitialized';
use File::Find;
use File::Basename;
use File::Spec::Functions;

# excluding some home brew imports


# go into given folder, delete anything older than 30 days, and if folder is then empty,     delete it

my $testdir = 'C:/jason/temp/test';
$testdir =~ s#\\#/#g;

open(LOG, ">c:/jason/temp/delete.log");

finddepth({ wanted => \&myWanted, postprocess => \&cleanupDir }, $testdir);

sub myWanted {

   if ($_ !~ m/\.pdf$/i &&
       int(-M $_) > 30
      ) 
   {
      my $age = int(-M $_);
      my $path = $File::Find::name;
      print LOG "age : $age days - $path\n";
      unlink($path);

   }
}


sub cleanupDir {
   my $path = $File::Find::dir;
   if ( &folderIsEmpty($path) ) {
      print LOG "deleting : $path\n";
      unlink($path);
   } else {
      print LOG "$path not empty\n";
      my @files = glob("$path/*");
      foreach my $file(@files){
         print LOG "\t$file\n";
      }
   }

}

我原以为finddepth（）会到达树的底部然后向上移动，但这并没有发生。该脚本在解压缩一些电子书内容的情况下运行，并未删除包含子文件夹的目录，即使所有文件都已删除。

age : 54 days - C:/jason/temp/test/mimetype
age : 54 days - C:/jason/temp/test/META-INF/container.xml
age : 54 days - C:/jason/temp/test/META-INF/ncx.xml.kindle
deleting : C:/jason/temp/test/META-INF
age : 54 days - C:/jason/temp/test/OEBPS/content.opf
age : 54 days - C:/jason/temp/test/OEBPS/cover.html
age : 54 days - C:/jason/temp/test/OEBPS/ncx.xml
age : 54 days - C:/jason/temp/test/OEBPS/pagemap.xml
age : 54 days - C:/jason/temp/test/OEBPS/t01_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t02_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t03_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t04_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t05_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t06_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t07_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t08_00_text.html
age : 54 days - C:/jason/temp/test/OEBPS/t08_01_text.html
age : 54 days - C:/jason/temp/test/OEBPS/media/cover.jpg
age : 54 days - C:/jason/temp/test/OEBPS/media/flamlogo.gif
age : 54 days - C:/jason/temp/test/OEBPS/media/logolnmb.jpg
age : 54 days - C:/jason/temp/test/OEBPS/media/stylesheet.css
deleting : C:/jason/temp/test/OEBPS/media
C:/jason/temp/test/OEBPS not empty
    C:/jason/temp/test/OEBPS/media
C:/jason/temp/test not empty
    C:/jason/temp/test/META-INF
    C:/jason/temp/test/OEBPS

看起来像C：/ jason / temp / test / OEBPS / media /被删除了，但是在调用预处理函数时没有注册该删除。有关如何使其工作的任何想法？谢谢！

感谢， bp的

Answer 1

在Miller发表评论后，您无法unlink目录。此外，File::Find在调用chdir之前会在节点的目录中执行wanted。这意味着，在postprocess子例程中，您正在尝试删除当前正在工作的目录。 Windows不会那样。

我会这样写。我已经对它进行了测试，但显然你应该非常小心删除磁盘存储内容。

use strict;
use warnings;
use autodie;

use File::Find;
use File::Spec::Functions;

my $testdir = 'C:\jason\temp\test';

open my $log, '>', 'C:\jason\temp\delete.log';

finddepth(\&wanted, $testdir);

sub wanted {

  my $full_name = canonpath $File::Find::name;

  if (-f) {
    my $age  = int(-M);
    unless ( /\.pdf\z/ or $age <= 30) {
      print $log "Age: $age days - $full_name\n";
      unlink;
    }
  }
  elsif (-d) {
    my @contents = do {
      opendir my ($dh), $_;
      grep { not /\A\.\.?\z/ } readdir $dh;
    };
    rmdir unless @contents;
  }
}

Answer 2

我怀疑你实际上并没有删除目录。来自unlink的{{3}}：

注意：unlink不会尝试删除目录，除非您是超级用户并且向Perl提供了-U标志。即使满足这些条件，也要警告取消链接目录可能会对文件系统造成损害。最后，许多操作系统不支持在目录上使用unlink。请改用rmdir。

Answer 3

我从不喜欢File::Find，因为它只是一团糟。它吞噬了整个程序，因为它希望所有内容都在你的想要的子程序中。另外，我不喜欢我的一半代码分散在各处的事实。但是，每个Perl安装都标配其他工具。我必须做。

我更喜欢把我的所有文件都放到一个数组中。它保持代码清洁。我find找到了。我在其他地方完成剩余的处理工作。我还嵌入了我的find命令中嵌入的想要的子例程。它将所有东西都放在一个地方。

此外，您无法使用unlink删除目录。使用File::Path中的remove_tree。那是一个标准模块。您还可以使用readdir查看目录有多少个子目录。这是检查它是否为空的好方法：

use strict;
use warnings;
use feature qw(say);

use File::Find;
use File::Path qw(make_path remove_tree);

my $testdir     = 'C:/jason/temp/test';
my $mdate_limit = 30;

my @files;              # We'll store the files here
my %dirs;               # And we'll track the directories that my be empty

#
# First find the files
#
find ( sub {
    return unless -f;                  # We want just files.
    return if -M < $mdate_limit;       # Skip if we've modified since $mdate_limit days
    push @files, $File::Find::name;    # We're interested in this file,
    $dirs{$File::Find::dir} = 1;       # and the directory that file is in
}, $testdir );

#
# Delete the files that you've found
#

unlink @files;

#
# Go through the directories and see which are empty
#

for my $dir ( sort keys %dirs ) {
    opendir my $dir_fh, $dir or next;  # We'll skip bad reads
    my @dir_files = readdir $dir_fh;
    close $dir_fh;
    if ( @dir_files <= 2 ) {   # Directory is empty if there's only "." and ".." in it
        remove_tree( $dir )
          or warn qq(Can't remove directory "$dir"\n);
    }
}

请注意，我已嵌入wanted例程：

find ( sub {
    return unless -d;                  # We want just files.
    return if -M < $mdate_limit;       # File hast been modified in the $mdate_limit days
    push @files, $Find::File::name;    # We're interested in this file
    $dirs{$Find::File::dir} = 1;       # The directory that file is in
}, $testdir );

另一种选择是：

file (\&wanted, $testdir);

sub wanted {
    return unless -d;                  # Okay...
    return if -M < $mdate_limit;       # Um... Where's $mdate_limit defined?
    push @files, $Find::File::name;    # And @files?
    $dirs{$Find::File::dir} = 1;       # And %dirs?
}

问题是我的wanted子例程包含三个全局变量。并且，我的find命令可能与我的wanted子例程分开。在3个月的时间内，您必须搜索所有代码才能找到wanted例程。

而且，当你看到wanted子程序时，有三个神秘的全局变量。他们在哪里定义？这是一个错误吗？

通过将子程序与我的find相结合，我保证find命令所需的子程序不会偏离我的find。另外，它隐藏了

没有什么可以阻止我删除里面的命令。

，在搜索时更改目录结构通常不是一个好主意
但是，我喜欢我的find命令只是找到我感兴趣的文件。我不希望我的程序中有1/2的内容被填充。它成为维护的噩梦。我会忍受一点低效率。可能需要一两秒才能加载我的@files数组和一百万个文件，但只要我调试程序，我就会花费更长的时间。

perl File :: Find - 删除具有特定条件的文件，然后删除父文件夹（如果为空）

3 个答案: