#!/usr/bin/env perl
=begin #=============================================================================
pulls exif data for jpg files in /mnt/nas_images dir into localhost exif_data db;
args --full or -f - image_tag & images table truncation and rebuild, otherwise just gets new images
args --test or -t - output only, no db update
args --sql or -q - output sql queries
need in fstab (Ubuntu 22.04):
sshfs#raj@192.168.1.100:photo/Richard /mnt/nas_images fuse defaults,_netdev,allow_other,identityfile=/home/raj/.ssh/id_rsa 0 0
need symlink in NAS /var/services/homes/raj: "ln -s /var/services/photo photo"
# this does not work in 22.04:
raj@192.168.1.125:/mnt/backup/nas/current/photo/Richard /mnt/nas_images fuse.sshfs noauto,x-systemd.automount,_netdev,identityfile=/home/raj/.ssh/id_rsa,allow_other,default_permissions,reconnect 0
# requires libattr1-dev & libfuse-perl for Fuse::PerlSSH::FS, but doesn't work anyway
# mounting DS215j can't display file contents due to "too many symlinks" # ok using sshfs in Ubuntu 22.04
=cut #===============================================================================
use v5.26; # say
use strict;
use warnings;
use lib (
'/home/raj/perl5/lib/perl5', # for cron
'/home/raj/perl-lib',
);
# use Fuse::PerlSSH::FS; # doesn't work, ls -al /mnt: d????????? ? nas_images
use Image::ExifTool;
use SQL::Abstract;
use Getopt::Long;
use Data::Printer;
use Net::OpenSSH;
use DBIx::Simple;
use DateTime;
use IO::All;
use autodie;
use Local::DB;
my $full = 0; # image_tag & images table truncation and full rebuild
my $test = 0; # display only, does not update db
my $sql = 0; # output query statements
GetOptions( 'full|f' => \$full, 'test|t' => \$test, 'sql|q ' => \$sql)
or die "cannot process command-line opts\n";
# say "full = $full; test = $test; query = $sql"; exit;
my $dbix = do {
my %args = ( dbname => 'exif_data', dump_query => $sql );
Local::DB->dbix(\%args);
}; # p $dbix; exit;
#my $ssh = Net::OpenSSH->new( 'raj@volvox.uk' ); # needs ssh-key transfer
#die "Couldn't establish SSH connection: ". $ssh->error if $ssh->error;
# location of images (requires entry in fstab, see pod at top):
my $img_dir = '/mnt/nas_images';
my $exiftool = new Image::ExifTool;
$exiftool->Options(FastScan => 1); # to speed up jpeg processing but has no effect
my $tag_map = $dbix->select('tags', [ qw(name id) ])->map; # p $tag_map; exit;
my @tags = keys %$tag_map; # p @tags;
push @tags, 'CameraTemperature';
# get directories (and sub-dirs to infinite depth - all_dirs(0):
my @dirs = io($img_dir)->all_dirs(0); # map { warn $_->name } @dirs; exit;
if ( $full ) { # warn 'here'; exit;
$dbix->dbh->do('SET foreign_key_checks = 0');
$dbix->dbh->do("truncate $_") for qw(image_tag images);
$dbix->dbh->do('SET foreign_key_checks = 1');
}
my $today = DateTime->today;
my @all_images = grep { lc $_->ext eq 'jpg' } # just jpgs
map { io($_)->all_files } @dirs;
my $image_count = scalar @all_images; # say $image_count; exit;
my $db_images = do{ # get existing images (faster than doing individual lookup in loop):
my @cols = ( q!concat_ws('/', path, img_name)!, 1 );
$dbix->select('images', \@cols)->map;
}; # p $db_images; exit;
# say $_ for @{[ grep $_ =~ /Nick wedding/, keys %$db_images ]};
my $exif_sql = q!
select t.name, it.value
from images i
join image_tag it on it.image_id = i.id
join tags t on it.tag_id = t.id
where i.img_name = ?!;
IMG: for my $img(@all_images) { # print $img, "\n"; # stringifies to ->name;
# next IMG unless $img->name =~ /249[56789]|250[012345]/;
local $/ = '/'; # remove trailing '/' from $img->filepath:
# chomp( my $filepath = $img->filepath ); # warn $filepath;
# don't want full path, just image directory:
chomp( my ($filepath) = $img->filepath =~ m!$img_dir/(.*)! );
# p @{[$filepath, $img->filepath]}; next IMG;
my $filename = $img->filename; # say $filename;
{ # skip if already exists in images table:
my $part = join '/', $filepath, $filename; # say $part;
next IMG if $db_images->{$part}; say $part;
} say "processing new image $filename";
my $exifdata = $exiftool->ImageInfo($img->name, @tags);
# add any missing data if possible to derive:
fill_missing($exifdata);
# warn Dumper [$img->name, $exifdata]; next IMG;
# atime, ctime or mtime don't always correspond to date/time taken:
# my $img_date = DateTime->from_epoch( epoch => $img->mtime );
# warn Dumper [$img->name, $img_date->dmy, $img_date->delta_days($today)->delta_days]; next IMG;
my $image_id = do {
my %h = (
img_name => $filename,
path => $filepath,
);
if ($test) {
say "inserting $filename [$filepath] into images table";
++$image_count;
}
else {
$dbix->insert('images', \%h);
get_last_insert_id('images');
}
}; # say $image_id;
# LR5 doesn't export all exif tags (eg FocusMode), so get original image data:
if ( $filename =~ /\-LR5/ ) { # warn $filename;
$filename =~ s/\-LR5//; # warn $filename; p $exifdata;
my @data = $dbix->query( $exif_sql, $filename )->arrays; # p @data;
for my $ref(@data) {
my ($tag, $value) = @$ref;
$exifdata->{$tag} ||= $value; # add missing values
}
} # p $exifdata;
{ # update image_tag table:
TAG:
while ( my($tag_name, $value) = each %$exifdata ) {
my $tag_id = $tag_map->{$tag_name} || next TAG;
my %h = (
image_id => $image_id,
tag_id => $tag_id,
value => $value,
);
$test
? say "inserting $image_id, $tag_id, $value into image_tag table"
: $dbix->insert('image_tag', \%h);
}
}
}
=bein # replaced by Local::DB
sub _build_dbix {
my $cnf = '/home/raj/.local/mysql.cnf';
-f $cnf || die 'no mysql.cnf file found';
my $dsn = join ';', (
'dbi:mysql:host=localhost',
'database=exif_data',
'mysql_read_default_file='.$cnf
);
my %attr = (
PrintError => 0,
RaiseError => 1,
);
DBIx::Simple->connect($dsn, undef, undef, \%attr); # p $dbix;
}
=cut
sub fill_missing {
my $data = shift; # p $data;
if (! $data->{AspectRatio}) {
my $h = $data->{ImageHeight};
my $w = $data->{ImageWidth};
my $ratio = sprintf '%.02f', ( $w > $h )
? $w / $h : $h / $w; # warn $ratio;
$data->{AspectRatio} = '4:3' if $ratio == 1.33; # S7000
}
}
sub get_last_insert_id {
my $table = shift;
$dbix->last_insert_id(undef, undef, $table, 'id');
}
