Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Modifying Image EXIF

by johngg (Canon)
on Mar 24, 2021 at 16:23 UTC ( [id://11130284]=CUFP: print w/replies, xml ) Need Help??

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!

Cheers,

JohnGG

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://11130284]
Front-paged by haukex
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (7)
As of 2024-04-19 15:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found