ディレクトリを再帰的に名前を変更する方法

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が場に出たか表示されません。あなたが逆の順序でリストを処理、DIR3にすべてDir2をするDir1内、Test2をへのTest1とTest3は名前を変更したい

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); 
} 

それとも。

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をアップロードしましたが、それが表示されるまでからインストールすることができ、現在はfav CPANユーティリティを使用して利用可能です。このスクリプトは、ベースディレクトリ「テスト」相対作業ディレクトリに内部のディレクトリ名からスペースを削除します：

#!/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});