Как переименовать каталоги рекурсивно

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

У меня есть модуль для рекурсивного выполнения действий в дереве каталогов. У него не было возможности воздействовать на сами каталоги, поэтому потребовалось небольшое обновление. Я загрузил версию 0.03 моего File::chdir::WalkDir, , но до тех пор, пока он не появится, его можно установить из репозитория GitHub , и теперь он доступен с вашего фаворита Утилита 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} );