使用Perl删除一个非常庞大的文件夹的最佳策略是什么?

时间:2010-04-02 16:58:17

标签: perl file-handling

我需要删除给定文件夹下的所有内容(文件和文件夹)。问题是文件夹里面有数百万个文件和文件夹。所以我不想一次性加载所有文件名

逻辑应该是这样的:

  • 迭代文件夹而不加载所有内容
  • 获取文件或文件夹
  • 删除它 (详细说明文件或文件夹“X”已删除)
  • 转到下一个

我正在尝试这样的事情:

sub main(){
  my ($rc, $help, $debug, $root)   = ();
  $rc = GetOptions ( "HELP"           => \$help,
                     "DEBUG"          => \$debug,
                     "ROOT=s"         => \$root);

  die "Bad command line options\n$usage\n" unless ($rc);
  if ($help) { print $usage; exit (0); }

  if ($debug) {
      warn "\nProceeding to execution with following parameters: \n";
      warn "===============================================================\n";
      warn "ROOT = $root\n";

  } # write debug information to STDERR

  print "\n Starting to delete...\n";  

  die "usage: $0 dir ..\n" unless $root;
  *name = *File::Find::name;
  find \&verbose, @ARGV;

}

sub verbose {
    if (!-l && -d _) {
        print "rmdir $name\n";
    } else {
        print "unlink $name\n";
    }
}

main();

它运行正常,但每当“find”读取大文件夹时,应用程序就会卡住,我可以看到Perl的系统内存一直在增加,直到超时。为什么?它是否试图一次性加载所有文件?

感谢您的帮助。

7 个答案:

答案 0 :(得分:7)

来自File::Pathremove_tree功能可移植详细删除目录层次结构,保留顶级目录,如果需要的话。

use strict;
use warnings;
use File::Path qw(remove_tree);

my $dir = '/tmp/dir';
remove_tree($dir, {verbose => 1, keep_root => 1});

5.10之前,请使用File::Path中的rmtree功能。如果你仍然想要顶级目录,你可以再次mkdir

use File::Path;

my $dir = '/tmp/dir';
rmtree($dir, 1);  # 1 means verbose
mkdir $dir;

答案 1 :(得分:6)

出了什么问题:

`rm -rf $folder`; // ??

答案 2 :(得分:6)

perlfaq指出File::Find完成了遍历目录的艰苦工作,但工作并不那么难(假设您的目录树没有命名管道,块设备等。 ):

sub traverse_directory {
    my $dir = shift;
    opendir my $dh, $dir;
    while (my $file = readdir($dh)) {
        next if $file eq "." || $file eq "..";
        if (-d "$dir/$file") {
            &traverse_directory("$dir/$file");
        } elsif (-f "$dir/$file") {
            # $dir/$file is a regular file
            # Do something with it, for example:
            print "Removing $dir/$file\n";
            unlink "$dir/$file" or warn "unlink $dir/$file failed: $!\n";
        } else {
            warn "$dir/$file is not a directory or regular file. Ignoring ...\n";
        }
    }
    closedir $dh;
    # $dir might be empty at this point. If you want to delete it:
    if (rmdir $dir) {
        print "Removed $dir/\n";
    } else {
        warn "rmdir $dir failed: $!\n";
    }
}

替换您自己的代码,以便对文件或(可能)空目录执行某些操作,并在要处理的树的根目录上调用此函数一次。如果您之前没有遇到过,请查看opendir/closedirreaddir-d-f的含义。

答案 3 :(得分:4)

您可以使用File::Find系统地遍历目录并删除其下的文件和目录。

答案 4 :(得分:2)

好的,我放弃并使用了Perl内置函数,但是你应该使用我完全忘记的File::Path::rmtree

#!/usr/bin/perl

use strict; use warnings;
use Cwd;
use File::Find;

my ($clean) = @ARGV;
die "specify directory to clean\n" unless defined $clean;

my $current_dir = getcwd;
chdir $clean
    or die "Cannot chdir to '$clean': $!\n";

finddepth(\&wanted => '.');

chdir $current_dir
    or die "Cannot chdir back to '$current_dir':$!\n";

sub wanted {
    return if /^[.][.]?\z/;
    warn "$File::Find::name\n";
    if ( -f ) {
        unlink or die "Cannot delete '$File::Find::name': $!\n";
    }
    elsif ( -d _ ) {
        rmdir or die "Cannot remove directory '$File::Find::name': $!\n";
    }
    return;
}

答案 5 :(得分:1)

下载unix tools for windows,然后您可以rm -rv或其他任何内容。

Perl是一个很好用的工具,但是这个工具似乎可以通过一个专门的工具来完成。

答案 6 :(得分:0)

这是一种廉价的“跨平台”方法:

use Carp    qw<carp croak>;
use English qw<$OS_NAME>;
use File::Spec;  

my %deltree_op = ( nix => 'rm -rf %s', win => 'rmdir /S %s' );

my %group_for
    = ( ( map { $_ => 'nix' } qw<linux UNIX SunOS> )
      , ( map { $_ => 'win' } qw<MSWin32 WinNT>    )
      );

my $group_name = $group_for{$OS_NAME};
sub chop_tree { 
   my $full_path = shift;
   carp( "No directory $full_path exists! We're done." ) unless -e $full_path;
   croak( "No implementation for $OS_NAME!" ) unless $group_name;
   my $format = $deltree_op{$group_name};
   croak( "Could not find command format for group $group_name" ) unless $format;
   my $command = sprintf( $format, File::Spec->canonpath( $full_path ));
   qx{$command};
}