I was on the point of posting this anyway but BernieC's question makes it quite timely to do so now.
I recently dug an old DSLR camera out of a cupboard to take some pictures, just to give it an outing really as I have newer cameras. Unfortunately I didn't notice that the camera had lost its date settings and had gone back to its epoch of January 1st, 2010. Not only were the dates wrong but also the filenames as the month and day is included in those, 1 .. 9, A .. C for the month then day number in offsets 1 through 3. The camera is usually configured to take only RAW files but sometimes I save both RAW and JPEG files so I had to cater for both. Luckily I knew the dates the camera had been used so I could modify filenames and EXIF dates but I also wanted the timestamps to have a sane time so I added a routine to increment the time from a starting point a random number of seconds for each successive photo. Here's the script:-
use strict;
use warnings;
use Time::Piece;
use Image::ExifTool qw{ :Public };
use feature qw{ say };
my $baseDir = q{/Path/To/Images/};
my @dirsToCorrect = (
{
dir => q{20201206_JimBirthday/},
dateCode => q{C06},
dateStr => q{2020:12:06 17:49:11},
},
{
dir => q{20210224_Garden/},
dateCode => q{224},
dateStr => q{2021:02:24 11:17:23},
},
);
foreach my $rhDir ( @dirsToCorrect )
{
my $imgDir = $baseDir . $rhDir->{ dir };
my $dateSeq = makeDateSeq( $rhDir->{ dateStr } );
opendir my $imgDH, $imgDir
or die qq{opendir: $imgDir: $!\n};
my @rawFiles = grep m{\.ORF$}, readdir $imgDH;
closedir $imgDH
or die qq{closedir: $imgDir: $!\n};
foreach my $rawFile ( @rawFiles )
{
say qq{Processing $rawFile ...};
my $origPath = $imgDir . $rawFile;
my $newRawFile = $rawFile;
substr $newRawFile, 1, 3, $rhDir->{ dateCode };
my $newPath = $imgDir . $newRawFile;
my $correctedDate = $dateSeq->();
my $exifTool = Image::ExifTool->new();
$exifTool->SetNewValue( q{CreateDate}, $correctedDate );
$exifTool->SetNewValue( q{DateTimeOriginal}, $correctedDate );
$exifTool->SetNewValue( q{FileName} => $newRawFile, Protected
+=> 1 );
writeNewExif( $exifTool, $origPath, $newPath );
( my $possJPGfile = $rawFile ) =~ s{ORF$}{JPG};
my $possJPGpath = $imgDir . $possJPGfile;
next unless -e $possJPGpath;
say qq{ ... and associated $possJPGfile ...};
my $newJPGfile = $possJPGfile;
substr $newJPGfile, 1, 3, $rhDir->{ dateCode };
my $newJPGpath = $imgDir . $newJPGfile;
$exifTool->SetNewValue( q{FileName} => $newJPGfile, Protected
+=> 1 );
writeNewExif( $exifTool, $possJPGpath, $newJPGpath );
}
}
sub makeDateSeq
{
my $dateStr = shift;
my $dateVal = Time::Piece->strptime( $dateStr, q{%Y:%m:%d %H:%M:%S
+} );
return sub {
$dateVal += ( int rand 75 ) + 10;
return $dateVal->strftime( q{%Y:%m:%d %H:%M:%S} );
};
}
sub writeNewExif
{
my( $exifTool, $origPath, $newPath ) = @_;
print q{ } x 10, qq{writing $newPath ... };
my $success = $exifTool->WriteInfo( $origPath, $newPath );
if ( ! $success )
{
say q{FAILED - }, $exifTool->GetValue( q{Error} );
}
elsif ( $success == 1 )
{
say q{OK, wrote changes};
print q{ } x 10, qq{removing $origPath ... };
say unlink( $origPath )
? q{OK}
: qq{FAILED - $!};
}
else
{
say q{FAILED, wrote unchanged};
print q{ } x 10, qq{removing $newPath ... };
say unlink( $newPath )
? q{OK}
: qq{FAILED - $!};
}
}
Here's another script that pulls the EXIF out of files supplied as arguments and Data::Dumper->Dumpxs()'s the results. The files from my cameras include an embedded thumbnail image which I exclude from the dump as it just messes up the output.
use strict;
use warnings;
use Image::ExifTool qw{ :Public };
use Data::Dumper;
my %exif;
while ( my $file = shift )
{
do {
warn qq{$file does not exist\n};
next;
} unless -e $file;
$exif{ $file } = ImageInfo( $file );
delete $exif{ $file }->{ ThumbnailImage };
}
print Data::Dumper
->new( [ \ %exif ], [ qw{ *exif } ] )
->Sortkeys( 1 )
->Indent( 1 )
->Dumpxs();
I hope this is useful.
Update: Note that the Image::ExifTool documentation states that the WriteInfo() method will accept a single filename argument in which case it will overwrite the original file with the new EXIF information included. It does encourage the user to make sure to have backups!
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.