指定ディレクトリのファイルの連番を、一括リネームする処理

質問

お世話になります。
@で区切られた以下のようなファイル名の連番(Number)をリネーム処理しようとしています。

Name1@Code1@Name2@Code2@Code3@Number1@Number2@Ver.txt

Number1、Number2は3桁表示の連番で、Number1の連番を1つ大きいものにし、Number2は"001"に戻します。
よって、次のようになればOKです。
元：Name1@Code1@Name2@Code2@Code3@003@002@Ver.txt
　→Name1@Code1@Name2@Code2@Code3@004@001@Ver.txt

そこで、このようなコードを書いてみました。

#!/usr/bin/perl
use File::Copy;

my $dir = "./";
opendir DH,$dir or die;
my @file = readdir DH;
foreach my $file(@file){
　next if $file =~ /^\.{1,2}$/;
　@fact = split /\@/,$file;
　$rep = sprintf("%03d",$fact[5]+1);
　$Origine = "$fact[0]\@$fact[1]\@$fact[2]\@$fact[3]\@$fact[4]\@$fact[5]\@$fact[6]\@$fact[7]";
　$Replace = "$fact[0]\@$fact[1]\@$fact[2]\@$fact[3]\@$fact[4]\@$rep\@001\@fact[7]";
# print "前 : $Origine\n";
# print "後 : $Replace\n";
　move( $Origine,$Replace );
}
closedir DH;

printさせて確認する限りではうまく動いているのですが、肝心のリネームの方は、1つのファイルしか処理されません。
何かご指摘頂けると幸いです。
また、同じ処理できれいなコードの書き方（方法）があれば教えてください。
初心者にはこのようなコードしか思いつきませんでしたので・・・

宜しくお願い致します。

回答No.2

Tacosan · ベストアンサー

あ, たぶんわかった.
「shift-jis だと全角スペースが 8140 だから @ を含んでいるように見える」
ということかな.
Perl のバージョンにもよるけど, 一度適当な文字コードに変換してから split やなんかを実行し, 再度 shift-jis に戻して move するのが安全かな.
あと, 「$file をそのまま使うと無理やりリネームされてしまう」ということについては「処理の対象ではないファイルについてはあらかじめ除外しておく」のが正しいと思います. 今でも「.」とか「..」は初めから除外してますよね. これと同じように, たとえば
next unless ($file =~ tr/@//) == 8;
とかすればいいと思います.

お礼

> 「shift-jis だと全角スペースが 8140 だから @ を含んでいるように見える」
ご名答でした。
Encodeを使って、Windows上からも正常に動作しました。

> next unless ($file =~ tr/@//) == 8;
まだ書いてある通りの事しか出来ないので、非常に助かります。
（Encodeを書く順序を間違えて、ここでもしばらく引っかかってしまいましたが・・・）

ありがとうございました。

～　完成形　～
#!/usr/bin/perl
use utf8;
binmode STDIN, ":utf8";
binmode STDOUT, ":utf8";
use File::Copy;
use Encode;

my $dir = "./";
opendir DH,$dir or die;
my @file = readdir DH;
closedir DH;

foreach my $file(@file){
　Encode::from_to($file,"cp932","utf8");
　next if $file =~ /^\.{1,2}$/;
　next unless ($file =~ tr/@//) == 7;
　my @fact = split /\@/,$file;
　my $rep = sprintf("%03d",$fact[5]+1);
　my $Replace = "$fact[0]\@$fact[1]\@$fact[2]\@$fact[3]\@$fact[4]\@$rep\@001\@D\.xfdf";

　Encode::from_to($file,"utf8","cp932");
　Encode::from_to($Replace,"utf8","cp932");

　move( "$file","$Replace" );
}

回答No.1

Tacosan

う～ん, 見た目ではそんなにおかしい気はしないなぁ....
「1つのファイルしか処理されません」と書かれていますが,
・処理されたファイルは, 最初のものなのか最後のものなのかあるいは途中のどれかなのか
・処理されなかったファイルはどうなるのか
・アクセス権などは大丈夫か
というところは補足できますでしょうか?
プログラムに手を入れるなら
・スペルミスを直す: Origine じゃなくて Origin
・そもそも $Origine と $file は同じでは?
・closedir は readdir の直後にあるべきのような気がする
というところから手をつけるかな. 無理すれば
($Replace = $file) =~ s/((?:[^@]*@){5})(\d+)@\d+(@.*)$/$1 . sprintf("@%03d@001", $2+1) . $3/e;
と書ける... けどうれしいかどうかは不明.

補足

Tacosan様、解答ありがとうございます。
コード自体はおかしくないとの事で、少し安心しました。

新たに気付いた事ですが、Name1...などに日本語、全角スペースを含むものがあり、それが原因のようです。
用意したサンプルのうち、処理可能な適切なファイル名なのが、その"1つのファイル"だったようです。
また、同じ日本語でも処理できるものとできないものがあるようで・・・。
処理可能なファイル名に変更してやると、正常に動作しました。

> そもそも $Origine と $file は同じでは
$fileだと同じディレクトリ内の全てのファイル、フォルダまで無理やり$Replaceの形にされてしまうので、
置き換えてた方が良さそうです。
スペルミスはお恥ずかしいかぎり・・・。

> ($Replace = $file) =~ s/((?:[^@]*@){5})(\d+)@\d+(@.*)$/$1 . sprintf("@%03d@001", $2+1) . $3/e;
あまり嬉しくなさそうですが、参考になります。
ありがとうございます。