• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl

# README: cannot use plenv & v5.40 as Image::Magick will not install from CPAN
# requires Image::Magick - easiest to install libimage-magick-perl

=begin
creates 'macbeath' style wrapbootstrap (v3.0) theme from dir or list of images in .cfg
can use create_config.pl to create .cgf file from list of images
extracts exif data from exif_data db (use extract_exif_data_to_db.pl to get it there)

usage: $0 [-q|query; -v|verbose; --force-img; --no-title; --dry-run]
	-d|dir path/to/dir (where new index.html is to be created)

idea based on exiftool util (http://www.sno.phy.queensu.ca/~phil/exiftool/)
exiftool command-line usage: exiftool -@ tags.txt -h -s . > output.txt

list of canon tags: http://www.sno.phy.queensu.ca/~phil/exiftool/TagNames/Canon.html
=cut

use v5.26; # say
use strict;
use warnings;
use autodie;

use lib ( # using system perl & local-lib - cannot install Image::Magick from cpan any more
	'/home/raj/perl5/lib/perl5',
#	'/usr/share/perl5', # these are already in system perl 5.34 @INC
#	'/usr/lib/x86_64-linux-gnu/perl5/5.34',
);

# to check which Perl we are using:
# say $^V; say for @INC; exit;

use Data::Dumper::Concise;
use Image::ExifTool;
use Image::Magick; # libimage-magick-perl
use Data::Printer;
use Net::OpenSSH;
use Getopt::Long;
use File::Rsync;
use YAML::Tiny;
use Path::Tiny;
use DateTime;
use Template;
use Net::SCP;
use IO::All;

use Local::DB;

# path to .cfg file in web-page root under ~/photo/html:
my $dir; # table truncation and full rebuild
my $debug = 0; # switches on moddebug
# force-overwrite images:
my $force_image = 0;
# dry run, doesn't transfer files to remote:
my $dry_run     = 0;
# no titles/captions - for pages with single theme eg bluebells
my $skip_title = 0;

GetOptions(
    'force-img' => \$force_image,
    'verbose|v' => \$debug,
	'no-title'  => \$skip_title,
    'dry-run'   => \$dry_run,
    'query|q'   => \$ENV{SQL_TRACE}, # switches on query trace
    'dir|d=s'   => \$dir,
); # p $dir;
unless ($dir) {
	say 'error: require -d flag + path to web-page root under ~/scripts/exifdata/folio/';
	exit;
} # warn $ENV{SQL_TRACE};

my $rsync = File::Rsync->new(
    archive      => 1,
    compress     => 1,
    update       => 1,
    moddebug     => $debug, # turns on verbose output
#   recursive    => 1,
#   rsh          => '/usr/bin/ssh',
#   'rsync-path' => '/usr/bin/rsync',
	'quote-dst'  => 1, # doesn't seem to have any effect ?
	'quote-src'  => 1, # doesn't seem to have any effect ?
);

# host domain:
my $HOST_DOMAIN = 'volvox.uk';
# path to remote images directory:
my $REMOTE = '/home/raj/images';
# full path to local images:
my $LOCAL  = '/home/raj/images';
# local path to full-size jpgs:
my $SRC_DIR = '/mnt/nas_images';
# full path to local png thumbnail images:
my $PNG_DIR = "$LOCAL/thumbnails";
# full path to local jpg carousel images:
my $JPG_DIR = "$LOCAL/medium";
# path to local index.html dir:
my $LOCAL_HTML_DIR = "/home/raj/scripts/exifdata/folio/${dir}";
# path to remote folio dir:
my $REMOTE_HTML_DIR = "/home/raj/www/photo/html/folio";

# config file containing list of images, headings, etc:
my $cfg_src  = "$LOCAL_HTML_DIR/.cfg";
unless ( -e $cfg_src ) {
	print "error: ${cfg_src} doesn't exist\n";
	exit;
}

my $dbix = Local::DB->dbix({ dbname => 'exif_data' }); # p $dbix; exit;
my $yaml = YAML::Tiny->read($cfg_src) || die "Can't read $cfg_src"; # warn Dumper $yaml;
my $cfg  = $yaml->[0]; # warn Dumper $cfg;

# diimensions to create thumbnail png images:
my %dimensions_map = (
	portrait  => '133x200', # 2:3 ratio
	landscape => '200x133', # 3:2 ratio
	carousel  => '900x600', # 3:2 ratio
);

my $query = q!select t.name, it.value from images i join
	( image_tag it join tags t on it.tag_id = t.id )
	on it.image_id = i.id where binary i.img_name = ?!;

# list of required images from config:
my $images = $cfg->{img}; # p $images;
my $folder = $cfg->{dir}; # p $folder; # alternative to $images
die q!require either 'img' or 'dir' entry in config file!
    unless $images || $folder;

# use directory if no images:
if (! $images) {
    my %h = ( path => $folder );
    # any images to skip if using directory:
    if ( my $skip_img = $cfg->{skip_img} ) { # p $skip_img;
        $h{img_name} = { -not_in => $skip_img };
    } # p %h;
	$images = $dbix->select('images', 'img_name', \%h)->column;
	$query .= ' and path = ?'; # p $images;
}

my %h; # holds data for tt

IMG: # loop through images list:
for my $img (@$images) { say $img; # next IMG unless $img =~ /2107/;
	# get exif data from db:
	my @bind = ($img); push @bind, $folder if $folder; # warn Dumper [$query, @bind];
	my $exif_data = $dbix->query($query, @bind)->map; # warn Dumper $exif_data;

	unless (%$exif_data) {
		say "no db exif data on $img, aborting";
		next IMG;
	}

	# get img folder from db, unless already using directory of images (ie $folder):
	$exif_data->{Folder} = $folder; # will be undef if config imgs, so get from db:
	unless ( defined $exif_data->{Folder} ) { # keep $folder scope local (or @bind acquires it next time round):
		$dbix->select('images', 'path', { img_name => $img })
            ->into($exif_data->{Folder});
	} # p $exif_data->{Folder};

	# convert ugly DateTimeOriginal (2013:07:29 20:49:15) to DateTime object:
	$exif_data->{DateTime} = _get_datetime($exif_data->{DateTimeOriginal});

	my $imgHeight = $exif_data->{ImageHeight};
	my $imgWidth  = $exif_data->{ImageWidth};

	# portrait or landscape (exif data unreliable - sometimes img has portrait
	# dimensions but exif Orientation tag is 'Horizontal (normal)'):
	$exif_data->{Orientation} ||= ''; # LR5 doesn't export orientation!!
	my $orientation = ( $exif_data->{Orientation} =~ /rotate/i # unreliable - see above
		|| $imgHeight > $imgWidth ) ? 'portrait' : 'landscape'; # warn $orientation;

	# get lens info:
	$exif_data->{LensModel} ||= 0; # p $exif_data->{LensModel};
	$h{lens_data}{$1}++ if $exif_data->{LensModel} =~ /(\d+(\-\d+)?)mm/;

	my ($prefix) = $img =~ /(.*)\.jpg/i; # warn $prefix;

	{ # for perlfect search to index image number:
		my ($prefix_num) = $prefix =~ /(\d+)/; # warn $numerator;
		$exif_data->{PrefixNum} = $prefix_num;
	}
	# create png unless already exists:
	my $png = sprintf '%s/%s.png', $PNG_DIR, $prefix; # warn $png;
    # skip if png already exists, unless force-recreate images:
	if ( $force_image || not -e $png ) {
		my $src = join '/', $SRC_DIR, $exif_data->{Folder}, $img; # say $src;

		my $iMagic = Image::Magick->new; # new ImageMagick object for each image
		my $x = $iMagic->Read($src); # warn $x if $x;

		my $dimensions = $dimensions_map{$orientation}; # 2:3 or 3:2 ratio
=begin # alternative method:
			my $factor = 200 / $imgHeight;
			my $dimensions = sprintf '%sx%s',
				int $factor * $imgWidth,
				int $factor * $imgHeight;
=cut
		$x = $iMagic->Resize(geometry => $dimensions); # say $x if $x;

		# if portrait img, rotate (unless already has required dimensions) & save:
		if ( $orientation eq 'portrait' && $imgWidth > $imgHeight ) {
			my ($angle) = $exif_data->{Orientation} =~ /rotate (\d+)/i; # say $angle;
			$x = $iMagic->Rotate(degrees => $angle || 90); # in case used height vs width
		}
		$iMagic->Write($png); # warn $x if $x;
        say "creating new png image for $img";
		undef $iMagic; # returns memory asap
	}
	# create carousel-sized jpg unless already exists, or force-recreate images:
	my $jpg = sprintf '%s/%s.jpg', $JPG_DIR, $prefix; # warn $jpg;
#	if ($orientation eq 'landscape' and not -e $jpg) { # portrait no good
	if ( $force_image || not -e $jpg ) {
		my $src = join '/', $SRC_DIR, $exif_data->{Folder}, $img; # say $src;

		my $iMagic = Image::Magick->new; # new ImageMagick object for each image
		my $x = $iMagic->Read($src); # warn $x if $x;

		my $dimensions = $dimensions_map{carousel}; # 3:2 ratio
		$x = $iMagic->Resize(geometry => $dimensions); # say $x if $x;
		$iMagic->Write($jpg); # say $x if $x;
        say "creating new jpg image for $img";
		undef $iMagic; # returns memory asap
	}

	# add img exif data to %h, separate by image dimensions:
	push @{ $h{images}{$orientation} }, $exif_data;
	# get image title if exists:
	if ( my $title = _get_title($prefix) ) { # return image_cation.caption if exists
		$h{titles}{$img} = $title;
	}
	elsif ( ! $skip_title ) {
		say "no caption found for $img";
	}
    # transfer full-size image to remote:
    upload({ dir => $exif_data->{Folder}, img => $img });
} # p %h; p $h{images}; exit;

{ # process template to html & save:
 	my $t = Template->new({ INCLUDE_PATH => './tt' });

 	my $output;
	my %args = ( data => \%h, cfg => $cfg );
 	$t->process('index.tt', \%args, \$output) or die $t->error; # warn Dumper $output;
	io("$LOCAL_HTML_DIR/index.html")->print($output);
}

say "dry-run, skipping rsync" and exit if $dry_run;

# rsync local 'thumbnails' & 'medium' dirs to remote ===========================
say "rsync $PNG_DIR & $JPG_DIR -> $HOST_DOMAIN:${REMOTE}";
$rsync->exec( src => $_, dest => "$HOST_DOMAIN:${REMOTE}" )
    or warn "rsync failed\n" for ($PNG_DIR, $JPG_DIR);

# rsync folio directory to remote ==============================================
=begin # for rsync'ing directory:
{
    # need to append to $REMOTE_HTML_DIR if $dir is >1 folder deep:
    my @parts = split '/', $dir; # p @parts;
    # remove last item & prepend rest to $REMOTE_HTML_DIR
    if ( @parts > 1 ) {
        pop @parts;
        $REMOTE_HTML_DIR .= '/' . join '/', @parts;
    }
} # p $LOCAL_HTML_DIR; p $REMOTE_HTML_DIR; exit;
say "rsync ${LOCAL_HTML_DIR} -> ${HOST_DOMAIN}:${REMOTE_HTML_DIR}";
$rsync->exec(
	src  => "${LOCAL_HTML_DIR}",
	dest => "$HOST_DOMAIN:${REMOTE_HTML_DIR}"
) or warn "rsync failed\n";
=cut

#=begin # scp transfer just index.html to remote ===============================
{
    my $remote = join '/', $REMOTE_HTML_DIR, $dir;         # p $remote;
    my $local  = join '/', $LOCAL_HTML_DIR, 'index.html';  # p $local;
	# say $local; say $remote";
	say "scp $local -> ${HOST_DOMAIN}:$remote";

	# create dir if it doesn't already exist (is ignored if it does):
	my $ssh = Net::OpenSSH->new( $HOST_DOMAIN ); # needs ssh-key transfer
	die "Couldn't establish SSH connection: " . $ssh->error if $ssh->error;
	$ssh->system( "mkdir -p $remote" )
        or die "mkdir $remote failed: " . $ssh->error;
    $ssh->scp_put({ verbose => $debug }, $local, $remote)
        or die 'scp transfer failed: ' . $ssh->error;
=begin # Net::SCP method:
	my $scp = Net::SCP->new( $HOST_DOMAIN ); # implies current user
    $scp->cwd( $remote ) or die $scp->{errstr};
	$scp->put( $local  ) or die $scp->{errstr};
=cut
}

#=cut
#===============================================================================

sub upload {
    my $args = shift; # p $args; # href of dir & img
	return if $dry_run; # skip uploads if dry-run

    my $filename = path( $args->{dir}, $args->{img} ); # p $filename;
    my $local    = path( $SRC_DIR, $filename );        # p $local;
=begin # rsync cannot create directories 2 or more deep
    # my $remote = path( $REMOTE, $args->{dir} ); # p $remote;
    # $remote =~ s/\s/_/g;                        # p $remote;
=cut
    my $remote = $REMOTE;                             # p $remote;

    # scp cannot create remote sub-directories, use $ssh->system( "mkdir -p ...)
    # $ssh->scp_put($local, $remote);
    $rsync->exec( src => $local, dest => "$HOST_DOMAIN:${remote}" )
        or warn "rsync failed\n";
}

sub _get_datetime {
	my $str = shift;

	my $re = qr{(\d{4}):(\d{2}):(\d{2}) (\d{2}):(\d{2}):(\d{2})};
	$str =~ /$re/;

	return DateTime->new(
		year       => $1,
		month      => $2,
		day        => $3,
		hour       => $4,
		minute     => $5,
		second     => $6,
		time_zone  => 'Europe/London',
	);
}

sub _get_title {
	my $prefix = shift; # warn $prefix;

    # just capture numbers (discard eg LR5)
        # eg IMG_00069, SAM_2480, DSCF1324, 20190807_130723, 20190807_130433_cr
    my ($img) = $prefix =~ /^(((IMG|SAM)_|DSCF)\d+|\d{8}_\w+)/i;

	$dbix->select('image_caption', 'caption',
        { image_name => $img })->into(my $caption); # warn $caption;
	return $caption;
}