Question

我想使用File :: Find :: Rule递归重命名目录，例如。删除每个找到的额外空格，但据我所知，该模块不执行finddepth并只重命名一个。有没有办法做到这一点。感谢。

use autodie;
use strict ;
use warnings;
use File::Find::Rule;

my $dir = 'D:/Test';

my @fd = File::Find::Rule->directory
->in( $dir );

for my $fd ( @fd ) {
    my $new = $fd;

    $new =~ s/\s\s+/ /g;

    print "$new\n";

    rename $fd, $new;   
}

Answer 1

您希望首先处理更深层次的结果，因此请反向处理列表。您只能重命名路径的叶部分;稍后你会看到更浅的部分。

use Path::Class qw( dir );

for ( reverse @fd ) {
   my $dir = dir($_);
   my $parent = $dir->parent;
   my $old_leaf = my $new_leaf = $dir->dir_list(-1);

   $new_leaf =~ s/\s+/ /g;

   if ($new_leaf ne $old_leaf) {
      my $old_file = $parent->dir($old_leaf);
      my $new_file = $parent->dir($new_leaf);

      # Prevent accidental deletion of files.
      if (-e $new_file) {
         warn("$new_file already exists\n");
         next;
      }

      rename($old_file, $new_file);
   }
}

回答原始问题：

我不知道FFR是如何发挥作用的。

rename 'Test1/Test2/Test3', 'Test1/Test2/Dir3';
rename 'Test1/Test2', 'Test1/Dir2';
rename 'Test1', 'Dir1';

对于任意路径，

use Path::Class qw( dir );

my @parts1 = dir('Test1/Test2/Test3')->dir_list();
my @parts2 = dir('Dir1/Dir2/Dir3'   )->dir_list();

die if @parts1 != @parts2;

for (reverse 0..$#parts1) {
   my $path1 = dir(@parts1[ 0..$_ ]);
   my $path2 = dir(@parts2[ 0..$_ ]);
   rename($path1, $path2);
}

或者您可能想要将所有Test1重命名为Dir1，将Test2重命名为Dir2，将Test3重命名为Dir3，以相反顺序处理列表。

my %map = (
   'Test1' => 'Dir1',
   'Test2' => 'Dir2',
   'Test3' => 'Dir3',
);

my $pat = join '|', map quotemeta, keys %map;

for ( reverse @fd ) {
   my $o = $_;
   my $n = $_;
   $n =~ s{/\K($pat)\z}{$map{$1}};
   if ($n ne $o) {
      if (-e $n) {
         warn("$n already exists\n");
         next;
      }

      rename($o, $n);
   }
}

Answer 2

我有一个模块，用于在目录树中递归执行操作。它没有能力对目录本身采取行动，因此需要稍加更新。我已经上传了File::chdir::WalkDir的版本0.03，~~但是直到它出现，~~它可以从GitHub repo安装，现在可以使用您的fav CPAN实用程序。然后，此脚本将从基本目录“Test”内的目录名中删除相对于工作目录的空格：

#!/usr/bin/env perl

use strict;
use warnings;

use File::chdir::WalkDir 0.030;
use File::Copy;

my $job = sub {
  my ($name, $in_dir) = @_;

  #ONLY act on directories
  return 0 unless (-d $name);

  my $new_name = $name;
  if ($new_name =~ s/\s+/ /g) {
    move($name, $new_name); 
  }

};

walkdir( 'Test', $job, {'act_on_directories' => 1} );

如何递归重命名目录

2 个答案: