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

[download]

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();

[download]

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!

Cheers,

JohnGG

In reply to Modifying Image EXIF by johngg

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.