perl File :: Find - 删除某些条件下的文件，然后删除父文件夹如果为空

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：/杰森/温度/测试/ OEBPS /媒体/被删除，但删除没有被预处理FUNC被称为时间登记。任何想法如何让这个工作？谢谢！

感谢， BP

Answer 1

由于Miller已评论，所以不能登录unlink目录。此外，在调用wanted之前，File::Find会将chdir放入节点的包含目录中。这意味着，在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

我怀疑你实际上并没有删除该目录。从documentation为unlink：

注：unlink不会尝试，除非你是超级用户，并且-U标记提供给Perl来删除目录。即使满足这些条件，也要警告，取消链接目录可能会对文件系统造成损害。最后，在许多操作系统上不支持在目录上使用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阵列加载一百万个文件，但只要我必须调试我的程序，我将花费更多的时间。