Rename digital photo files according to EXIF date information
Please note that while I provide this script in the hopes that it will be useful to you, I make NO GUARANTEES OR WARRANTIES OF ANY KIND. The code is provided subject to the same terms as Perl itself. For more information, please refer to the Perl Artistic License.
#!/usr/bin/perl
=for purpose
Perl script to rename all JPEG images in the current directory
using EXIF date information.
The image files will renamed to YYYY_MMDD_HHMMSSxx where xx is
a two letter suffix to distinguish images that were taken within
the same second
=cut
use strict;
use warnings;
use Image::ExifTool 'ImageInfo';
my @files;
{{
opendir my $dir, '.'
or die "Cannot open current directory: $!";
@files = grep { /.jpe?g$/i } readdir $dir;
closedir $dir or die "Cannot close .: $!";
}}
rename_to_exif_date($_) for (@files);
sub rename_to_exif_date {
my ($img) = @_;
my $ts = ImageInfo($img, 'DateTimeOriginal')->{DateTimeOriginal};
return unless defined $ts;
if( $ts =~ /^(\d\d\d\d):(\d\d):(\d\d)\s(\d\d):(\d\d):(\d\d)$/ ) {
my $new_name = "$1_$2$3_$4$5$6";
my $suffix = 'aa';
++$suffix while -e "$new_name$suffix.jpg";
$new_name .= "$suffix.jpg";
return rename $img, $new_name;
}
return;
}
__END__