老爸的工具箱之:根据日期批量重命名照片

突发奇想,想搞出这么个“老爸的工具箱”系列来,虽然我不确定这个系列中最终会有多少文章,但是感觉在女儿的成长过程中,会有不少内容逐渐添加进来,一来作为记录,二来也希望对其他和我一样的老爸有点参考。

好吧,第一个工具是一个照片批量重命名的工具。女儿出生以来,我们每天都要给她拍一张照片来记录她的成长,看着小家伙一天天变样,的确是一件挺喜人的事。但这事操作起来也有点麻烦,基本流程是:

 

  1. 每天拍好几张照片
  2. 从中挑出比较好的一张
  3. 按照日期命名后存档,并上传到SkyDrive 
但要是每天都这么做,难免太累了点,我差不多在数码相机中积累一个月的时候才会去整理一下。选出每天的照片(这个比较难自动化吧),此时如果去手工命名30张照片绝对是件痛苦的事,慢,烦,且容易出错。我希望能有个工具自动根据日期重命名照片,于是写了个perl的脚本来重命名指定目录下所有的jpg文件。只需把选中的照片都拷到一指定目录下,并调用以下命令:

        BatchRenaming.pl <Folder> 

需要注意的是:

 

  1. 程序只处理指定目录,并不会递归扫描其所有的子目录 
  2. 如果你不小心选了多张同一天的照片,程序会自动帮你备份到名为backup的子目录中
以下是程序代码,另外,你也可以在这里拿到持续维护的版本。

 

BatchRenaming
 1 #####
 2 #
 3 # This script would rename all jpg files in a folder to its creation date, for example: 20101009
 4 # For a photo, the real creation date = modified date
 5 #
 6 # Usage:
 7 # BatchRenaming.pl <Folder>
 8 # BatchRenaming.pl C:\MyPhotoes\
 9 #
10 # Author: Baiyan Huang
11 # Date: 10/9/2010
12 #
13 #####
14 
15 use strict;
16 if(@ARGV != 1)
17 {
18     print "The syntax should be:\n\tBatchRenaming.pl <Folder> \n";
19 }
20 
21 my $Folder = $ARGV[0]; 
22 $Folder =~ s/^\s*//;
23 $Folder =~ s/\s*$//;
24 $Folder =~ s/\\/\//g;
25 $Folder .= "/" if($Folder !~ /\/$/);
26 ###print $Folder, "\n";
27 
28 chdir $Folder;
29 my @AllFiles = glob "*.jpg";
30 ###print @AllFiles, "\n";
31 
32 foreach my $File (@AllFiles)
33 {
34     chomp $File;
35     
36     # Get modified timestamp
37     my $mtime;
38     my(undef, undef, undef, undef, undef, undef, undef, undef, undef, $mtime= stat($File);
39     
40     # Get relative date
41     my ($day, $mon, $year);
42     my(undef, undef, undef, $day, $mon, $year= localtime($mtime);
43      
44     # Tranform to human-readable date
45     $year = 1900 + $year;
46     $mon += 1;
47     $mon = "0" . $mon if($mon < 10);
48     $day = "0" . $day if($day < 10);
49     
50     my $date = $year . $mon . $day;
51     ###print "$date\n";
52     
53     my $NewFileName = $date . ".jpg";
54     
55     # Backup the file if there is already one exist of the same date
56     if (-$NewFileName and lc($NewFileName) ne lc($File))
57     {
58         my $Backup = "backup";
59         mkdir $Backup if(! -$Backup);
60         rename $File, $Backup . "/" . $File;
61         next;
62     }
63     
64     # rename
65     print $NewFileName, "\n";
66     rename $File, $NewFileName;
67 }
68 

 

 

 

 

posted @ 2010-10-10 22:52  lzprgmr  阅读(2416)  评论(6编辑  收藏  举报

黄将军