Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

comment on

( [id://3333]=superdoc: 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


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":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (3)
As of 2024-04-23 23:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found