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 - $!}; } }