画像ファイルのリネーム (Image::ExifToolを使ってみました)

会社ではこっそりとEXCEL VBAを勉強したりしているbonlifeです。oo4oでOracleにアクセスしてデータを取得し、新しいブックを作成して保存、みたいなツールを作って自己満足。(その件は後で整理してみます。)
さてさて、「初めてのPerl」の練習問題も終わってないのに、ちょっとした用事があったのでPerlでツールを作ってみました。よくあるリネームツールです。GUIベースのツールで簡単に出来ることを敢えてPerlで書くのはPerlっ子としてはアウトかもしれませんが、勉強中の身、ということで勘弁願いたいです。
おそらく出来るであろうことは、下記の通り。

画像ファイルのファイル名をファイル作成日時(YYYYMMDD_hhmmss)にすること (Image::ExifToolの力)
ディレクトリを引数に指定した場合、そのディレクトリ以下のファイル全部を対象に処理 (File::Findの力)

問題点は以下の通りです。

ファイル作成日時が秒まで同じデータがあった場合、大事なファイルが天国に…

bonlifeが自分で出来たら良いな、と思うことは以下の通りです。

連番にリネームする機能 (ディレクトリを再帰的に処理させる場合、ちょっと面倒かも)
Getopt::StdかGetopt::Longを使って色々なオプションに対応

まぁ、そんなこんなで素人がモジュールを使ったりしながら書いてみましたよ。
[参考URL]

スクリプトは以下の通りです。(気になる点、修正すべき点などあればご指摘お願いいたします。)

image_rename.pl

#! Perl

# use warnings;
use Image::ExifTool;
use File::Basename;
use File::Find;

# 引数の確認 (指定されていない場合エラー)

if ( $#ARGV < 0 ) {
    $script_name = basename($0);
    print "ERR : $script_name needs arguments.\n";
    print "      usage : $script_name path [path...]\n";
    exit 1;
}

# ファイル名のリストを取得

my @file_lists;
find sub {
    push(@file_lists,$File::Find::name) if -f
}, @ARGV;

my $exif_tool = new Image::ExifTool; # ExifToolオブジェクトの生成
my %date_list;

# ファイルごとにExifToolオブジェクトのImageInfoメソッドで
# Exif情報を取得

for $file (@file_lists) {
    my $exif_info = $exif_tool->ImageInfo($file);
    # for $key (sort keys %$exif_info) {
    #      print "$file - $key : $exif_info->{$key}\n";
    # }
    # Exif情報の中のCreateDateを取得
    my $creation_date = $exif_info->{CreateDate};
    # CreateDateの値を取得できなかった場合はメッセージを出力
    # 次のループに移動
    if ( ! $creation_date ){
        print "WAR : Can't get \"CreateDate\" information of \"$file\"\n";
        next
    }
    $creation_date =~ s|:||g ; # YYYY:MM:DD hh:mm:ss -> YYYYMMDD hhmmss
    $creation_date =~ s| |_|g; # YYYYMMDD hhmmss     -> YYYYMMDD_hhmmss
    # ハッシュにファイル名をキーにして整形したCreateDateを保存
    $date_list{$file} = $creation_date;
}

# ハッシュを値でソートした場合のキーの配列を取得

@keys = sort {
    $date_list{$a} cmp $date_list{$b}
} keys %date_list;

# キーの配列ごとに表示処理

for $file_path (@keys){
    # 現在の拡張子(一番最後のドット以降の文字列)を取得し、$extに代入
    $file_path =~ /(\..*$)/;
    $ext = $1;
    # File::Basenameのfileparseを使い、ファイルのパスを分解
    ($base,$path,$type) = fileparse($file_path,$ext);
    $old_file_name = $file_path;
    $new_file_name = "$path$date_list{$file_path}$type";
    # renameでリネーム
    rename($old_file_name,$new_file_name) or die "ERR : $!";
    print "INF : Renamed successfully : \"$old_file_name\" -> \"$new_file_name\"\n";
}

出力イメージは以下の通りです。

>image_rename.pl dir
WAR : Can't get "CreateDate" information of "dir/CCC.txt"
WAR : Can't get "CreateDate" information of "dir/DDD.txt"
WAR : Can't get "CreateDate" information of "dir/dir2/GGG.txt"
WAR : Can't get "CreateDate" information of "dir/dir2/HHH.txt"
INF : Renamed successfully : "dir/AAA.jpg" -> "dir/20060716_125913.jpg"
INF : Renamed successfully : "dir/BBB.jpg" -> "dir/20060716_125939.jpg"
INF : Renamed successfully : "dir/dir2/FFF.jpg" -> "dir/dir2/20060716_182905.jpg"
INF : Renamed successfully : "dir/dir2/EEE.jpg" -> "dir/dir2/20060717_002233.jpg"

ちなみに自力で再帰的な処理を実装しようとして、サブルーチン内でそのサブルーチン自身を呼び出すようなソースを書いてみたら「Deep recursion on subroutine」とかなんとか怒られちゃいました。あらまあ。後、ファイルの拡張子はExif情報のファイルタイプをベースにして生成するようにしても良いかな、と思ったのですが、面倒なのでやめました。拡張子変えるような悪い子は何か意味があって拡張子変えてるはずなので、敢えてそのままに。という言い訳。
この調子で早めに「初めてのPerl」を卒業します！