efgallery

#!/usr/pkg/bin/perl
# Generate a refined photo album in HTML/CSS and optional JavaScript
#
# Maintained by Adrian Steinmann <ast@NetBSD.org>
# BSD pkgsrc integration at https://github.com/0-ast-0/efgallery
#
# Also maintained for Linux by Alex Schroeder <alex@gnu.org> and
# Petr Ruzicka <petr.ruzicka@gmail.com> (Docker integration)
# at https://github.com/kensanata/sitelen-mute
#
# Forked from fgallery https://www.thregr.org/~wavexx/software/fgallery/
# Copyright(c) 2011-2016 by wave++ "Yuri D'Elia" <wavexx@thregr.org>
# Distributed under GPLv2+ (see COPYING) WITHOUT ANY WARRANTY.

use v5.14;
use strict;
use warnings;

our $VERSION = "2.5";

use locale;
use utf8;
use if $^V lt v5.23.4, open => qw{:std :utf8};
use if $^V ge v5.23.4, open => qw{:std :locale};
require Encode;
require encoding;
our $ENCODING = encoding::_get_locale_encoding() || 'UTF-8';
sub decode { return Encode::decode($ENCODING, $_[0]); }
sub encode { return Encode::encode($ENCODING, $_[0]); }

use Getopt::Long qw{:config bundling};

use threads;
use threads::shared;
use Thread::Queue;
use Storable qw{freeze thaw};
use Fcntl;

use File::Basename qw{fileparse};
use File::Find qw{find};
use File::Path qw{make_path remove_tree};
use File::Spec::Functions qw{rel2abs abs2rel updir canonpath catfile splitpath};

use Image::ExifTool qw{ImageInfo};
use Time::Piece;

use JSON::PP;
use Digest::SHA;

use Data::Dumper;
$Data::Dumper::Indent = 1;

# our name, directory path, and directory creation mode
my $me = (splitpath($0))[2];
use FindBin qw($Bin);
# view subdirectory where the JavaScript and CSS lives
my $viewdir = catfile((splitpath($Bin))[1], 'share', $me, 'view');
umask oct('0022');

# defaults
my $facedetect_url = 'http://www.thregr.org/~wavexx/hacks/facedetect/';
my $filemode = oct('0644');
my $include = 0;
my $orient = 1;
my $chronological = 1;
my %filetypes = map { $_ => 1 } qw{JPEG PNG TIFF};
my %extensions = map { $_ => 1 } qw{jpg jpeg png tif tiff};
my $ext = "jpg";
my @minthumb = (150, 112);
my @maxthumb = (267, 200);
my @maxfull = (3840, 2160);
my $imgquality = 90;
my $fullpano = 1;
my $offerzip = 1;
my $panort = 2.;
my $facedetect = 0;
my $optimize = 1;
my $optimize_jpg = 1;
my $optimize_png = 1;
my $p7zip = 1;
my $verbose = 0;
my $workers = 0;
my $sRGB = 1;
my $do_blur = 1;
my $indexUrl = undef;
my @captions = (qw{txt xmp exif cmt});
my %captions = map { $_ => 1} @captions;
my $galleryTitle = '';
my $galleryDescription = '';
my $galleryUrl = '';
my $updating = 0;
my $startslideshow = 'no';
my %copy_method = (
  copy => '',
  hard => '--link',
  syml => '--symbolic-link',
);
$copy_method{ref} = '--reflink' if $^O =~ m{linux$}oi;
my $copy_method_view = 'syml';
my $copy_method_orig = 'copy';
my $albumzip = catfile('files', 'album.zip');
my $alg = 'sha256';
my $sha = Digest::SHA->new($alg);
my $odata = { data => [] };
my $ofiles;
my @deleted = ();
my $dir;
my $absDir;
my $out;
my $absOut;
my $name;
my $aprops;
my $adata;
my $zipfile;
my $json_file;

# support functions
sub fatal
{
  die map { "$_\n" } 'Fatal error:', @_;
}

# check if our environment has a given command installed
sub cmd_exists
{
  my ($c) = @_;
  return qx{/bin/sh -c "command -v $c"};
}

# remove binary ThumbnailImage when dumping properties (verbosity > 2)
sub dump_properties
{
  die "USAGE: dump_properties ARRAY" unless (@_ == 1) && (ref $_[0] eq 'ARRAY');
  my ($x) = @_;
  my $i = 0;
  for (@$x) {
    next unless $_;
    if (ref $_ eq 'HASH') {
      my %h = %$_;                        # make a copy to leave original intact
      delete $h{ThumbnailImage};          # when called with aprops
      delete $h{props}->{ThumbnailImage}; # when called with adata
      warn Data::Dumper->Dump([\%h], ["props[$i]"]), "\n";
      $i++;
    } else {
      warn "dump_properties: i=$i, value '$_' (should be a HASH)\n";
    }
  }
  1;
}

sub _sys
{
  my ($with_output, @cmd) = @_;
  my $cmd = join ' ', @cmd;
  warn "+ $cmd\n" if $verbose > 1;
  my $i = 0;
  my @s = ();
  while (my $x = (caller($i))[3]) {
    push @s, "  $x line " .  (caller($i))[2];
    $i++;
  }
  @s = reverse (@s, '  Current directory: ' . rel2abs('.'));
  my ($fd, @o);
  if (!open($fd, '-|', @cmd)) {
    warn join "\n", @s, "  Cannot execute $cmd: $!" if $verbose;
    return $with_output ? (255, []) : 255;
  } else {
    local $/ = undef;
    my $o = <$fd>;
    @o = split(m{\n+}o, $o);
    if (!close($fd)) {
      warn join "\n", @s, "  Close failed on $cmd: $!", @o if $verbose;
      return $with_output ? (254, \@o) : 254;
    }
  }
  my $x = "$cmd succeeded; with following output:";
  warn map { sprintf "  %s\n", $_ } $x, @o if @o && $verbose > 2;
  return $with_output ? (0, \@o) : 0;
}
sub sys             { _sys(0, @_); }
sub sys_with_output { _sys(1, @_); }

sub do_copy
# OS-specific handling of cp and ln commands
{
  die "USAGE: do_copy TYPE ARGS" unless @_ > 2;
  my ($t, @args) = @_;
  fatal "Unknown copy method '$t'" unless exists $copy_method{$t};
  my @cmd = ('cp');
  if ($^O =~ m{bsd$}oi) {
    if ($t eq 'hard') {
      @cmd = ('ln');
    } elsif ($t eq 'syml') {
      @cmd = ('ln', '-s');
    } elsif ($t eq 'copy') {
      @cmd = ('cp');
    } else {
      fatal "do_copy: cp option '$t' not supported";
    }
  } else {
    push @cmd, $copy_method{$t};
  }
  sys(@cmd, @args);
};

sub copy_source_file
{
  my ($file, $fout) = @_;
  # symlinks need the right dest path so just give them an abs path
  $file = rel2abs($file) if $copy_method_orig eq 'syml';
  do_copy($copy_method_orig, $file, $fout);
}

sub is_a_gallery
{
    my ($d) = @_;
    return unless -e catfile($d, 'view');
    return unless -e catfile($d, 'index.html');
    return unless -e catfile($d, 'data.json');
    return 1;
}

sub slurp
{
  my ($fn) = @_;
  no warnings; # avoid wide character warnings
  open(my $fd, '<', $fn) || fatal "cannot read $fn: $!";
  binmode($fd, ":encoding($ENCODING)") if $^V lt v5.23.4;
  local $/ = undef;
  my $o = <$fd>;
  close $fd;
  return $o // '';
}

sub read_json
{
  my($f) = @_;
  my $j = slurp($f);
  fatal "Failed to read $f" unless $j;
  my $h = decode_json($j);
  fatal "Failed to parse $f"
    unless $h && ref $h eq 'HASH';
  fatal "Failed to parse $f: missing data"
    unless exists $h->{data};
  fatal "Failed to parse $f: data not an array"
    unless ref $h->{data} eq 'ARRAY';
  return $h;
}

sub write_json
{
  my ($f, $jh, $ja) = @_;
  die "USAGE: write_json FILENAME HREF AREF"
    unless (@_ == 3) && (ref $jh eq 'HASH') && (ref $ja eq 'ARRAY');
  my $fd;
  fatal("cannot write file '$f': $!")
    unless(open($fd, ">:raw", $f));
  my $j = {};
  for (qw(thumb blur date)) {
    $j->{$_} = $jh->{$_} if exists $jh->{$_};
  }
  for (@{$ja}) {
    my $file = $_->{file};
    if ($file && ! -e $file) {
      # original name in zipfile but view/index.js will not display it
      $_->{orig} = $file;
      delete $_->{file};
    }
  }
  if ($chronological == 0) {
    $j->{data} = $ja;
  } elsif ($chronological  < 0) {
    $j->{data} = [ sort { $b->{stamp} <=> $a->{stamp} } @{$jh->{data}}, @$ja ];
  } else {
    $j->{data} = [ sort { $a->{stamp} <=> $b->{stamp} } @{$jh->{data}}, @$ja ];
  }
  $j->{version} = $VERSION;
  $j->{startslideshow} = $startslideshow;
  $j->{timestamp} = time();
  $j->{timecreated} = sprintf "%s", scalar localtime $j->{timestamp};
  $j->{name} = $name if $name;
  $j->{download} = $albumzip if $zipfile && -f $zipfile;
  $j->{index} = $indexUrl if $indexUrl;
  my $json = JSON::PP->new->ascii->pretty->canonical->encode($j);
  print $fd $json;
  warn "New file $f:\n$json" if $verbose > 1;
  if (close($fd)) {
      warn "Wrote new $f\n";
      return $f;
  }
  fatal "Failed to write $f: $!";
}

sub dispatch
{
  my ($fun, @seq) = @_;
  my $workers = $workers || 1;
  my $queue = Thread::Queue->new();
  $queue->enqueue($_) for @seq;
  my @threads;
  for (1 .. $workers) {
    my $thr = threads->create(
      sub { while (defined (my $v = $queue->dequeue_nb()) ) { &$fun($v) } }
    );
    push(@threads, $thr);
  }
  $_->join() for @threads;
}

sub run_in_parallel
{
  my ($fn, $fun, $seq) = @_;
  die "USAGE: run_in_parallel NAME FUNCTION AREF"
    unless @_ == 3 && ref $fun eq 'CODE'
                   && ref $seq eq 'ARRAY'
                   && @$seq > 0;
  my $n = @$seq;
  my @res :shared = (undef) x $n;
  dispatch(
    sub {
      my ($i) = @_;
      my $r = &$fun($seq->[$i]);
      $res[$i] = defined($r) ? freeze($r) : undef;
    },
    0 .. $n-1
  );
  return [ map { defined $_ ? thaw $_ : undef } @res ];
}

sub min
{
  my ($a, $b) = @_;
  return ($a < $b) ? $a : $b;
}

sub max
{
  my ($a, $b) = @_;
  return ($a > $b) ? $a : $b;
}

sub pmin
{
  my ($m, $v) = @_;
  return 0 if $v < 0;
  return min($m, $v);
}

# thread-safe progress bar
{
  package progress;

  my $act :shared;
  my $total :shared;
  my $cnt :shared;
  my $llen :shared;

  sub init
  {
    my ($_act, $_total) = @_;
    $act = $_act;
    $total = $_total;
    $cnt = 0;
    $llen = 0;
    print(pad($act . ' ...') . "\r");
    STDOUT->flush();
  }

  sub pad
  {
    my ($str) = @_;
    my $len = length($str);
    $str .= " " x ($llen - $len) if $len < $llen;
    $llen = $len;
    return $str;
  }

  sub status
  {
    my ($msg) = @_;
    lock($cnt);
    my $pc = ($cnt++ / $total * 100);
    my $str = sprintf("%s %2.0f%% completed", $act, $pc);
    $str .= ": " . $msg if $msg;
    print pad($str) . "\r";
    STDOUT->flush();
  }

  sub done
  {
    print pad(join ' ', $act, '100%', 'completed', @_), "\n";
  }
}

# caption utilities
sub cap_clean
{
  my ($x) = @_;
  return '' unless $x;
  $x =~ s{\s+}{ }go;
  $x =~ s{^\s+|\s+$}{}go;
  return $x;
}

sub cap_from_str
{
  my ($title, $desc) = @_;
  return unless $title;
  ($title, $desc) = split m{\n+}o, $title unless $desc;
  return [cap_clean($title), cap_clean($desc)];
}

sub cap_from_props
{
  my ($props) = @_;
  my $ret = ['', ''];
  if ($props->{Title})
  {
    my $title = Encode::decode_utf8($props->{Title});
    $ret->[0] = cap_clean($title);
  }
  if ($props->{Description}) {
    my $desc = Encode::decode_utf8($props->{Description});
    $ret->[1] = cap_clean($desc);
  }
  return $ret;
}

# option parsing
sub parse_wh
{
  my ($opt, $spec) = @_;
  my ($w, $h) = ($spec =~ m{^(\d+)x(\d+)$}o);
  unless(defined($w) && $w > 0 && defined($h) && $h > 0) {
    fatal "bad WxH specification in option $opt";
  }
  return (int($w), int($h));
}

sub parse_int
{
  my ($opt, $value, $min, $max) = @_;
  if ((defined($min) && $value < $min) || (defined($max) && $value > $max)) {
    fatal "bad value for option $opt";
  }
  return int($value);
}

sub parse_captions
{
  my ($o, $v) = @_;
  return [] if $v eq 'none';
  my @cm = split(m{\s,\s}o, $v);
  for my $m (@cm) {
    fatal "'$m' not a caption method; use one of "
          . join ', ', sort keys %captions
      unless exists $captions{$m};
  }
  return \@cm;
}

sub parse_copy_method
{
  my ($o, $v) = @_;
  fatal "'$v' not a copy method; use one of "
        . join ', ', sort keys %copy_method
    unless $v && exists $copy_method{$v};
  return $v;
}

# given a directory return an aref of files with .$ext in that directory
sub current_imgs
{
  my ($d) = @_;
  fatal "current_imgs: '$d' not a directory" unless -d $d;
  opendir(my $dh, $d) || fatal " Failed to open directory '$d': $!";
  my @i = ();
  while (readdir $dh) {
    push @i, $_ if m{\.$ext$}o;
  }
  closedir $dh;
  warn map { "$_\n" } "Current images in $d:", sort @i if $verbose > 1;
  return \@i;
}

sub print_help
{
  my $cpmethods = join ', ', sort keys %copy_method;
  warn qq{Usage: $me [options] INPUT_DIR [OUTPUT_DIR]
  -h, --help            this help
  -v                    verbosity (repeat for more detail)
  -i                    include individual original image files
  -c "METHODS"          caption extraction methods (txt,xmp,exif,cmt,none)
  -o                    do not auto-orient images
  -k                    use original images (do not pngcrush/jpegoptim/auto-orient)
  -t                    sort alphabetically (default is to sort chronologically)
  -r                    album images in reverse chronological order (newest first)
  -u                    add/remove images (OUTPUT_DIR optional when removing)
  -p                    do not automatically include full-sized panoramas
  -n "ALBUM_NAME"       set album name (title in browser window)
  -d                    do not offer full album zip download of original files
  -f                    improve thumbnail cutting by performing face detection
  -j N                  set process-level parallelism (number of workers)
  --no-blur             skip blurry backdrop generation (just dark noise)
  --max-full WxH        maximum full image size ($maxfull[0]x$maxfull[1])
  --max-thumb WxH       maximum thumbnail size ($maxthumb[0]x$maxthumb[1])
  --min-thumb WxH       minimum thumbnail size ($minthumb[0]x$minthumb[1])
  --no-sRGB             do not remap preview/thumbnail color profiles to sRGB
  --quality Q           preview image quality (0-100, currently: $imgquality)
  --startslideshow      gallery URLs will immediately start slide show
  --link-orig           copy method ($cpmethods); default: $copy_method_orig
  --link-view           copy method ($cpmethods); default: $copy_method_view
  --viewdir             CSS/JavaScript srcdir ($viewdir)
  --index url           URL location for the index/back button
  --version             output current $me version ($VERSION)
  Add meta tags for Facebook/Twitter (must be specified all or none):
  --url URL             URL of gallery
  --title "TITLE"       title for Facebook and Twitter previews
  --description "DESC"  description for Facebook and Twitter previews
};
  exit $_[0];
}


# main program
@ARGV = map { decode($_) } @ARGV;
my ($rc, @ARGS) = GetOptions(
  'help|h' => sub { print_help(0); },
  'version' => sub { print "$0 $VERSION\n"; exit 0; },
  'c=s' => sub { @captions = @{ parse_captions($_[0], $_[1]) }; },
  'd' => sub { $offerzip = 0; },
  'f' => sub { $facedetect = 1; },
  'i' => sub { $include = 1; },
  'j=i' => sub { $workers = parse_int($_[0], $_[1], 1, undef); },
  'o' => sub { $orient = 0; },
  'k' => sub { $optimize = 0; },
  'n=s' => \$name,
  'p' => sub { $fullpano = 0; },
  'r' => sub { $chronological = -1; },
  't' => sub { $chronological = 0; },
  'u' => sub { $updating = 1; },
  'v' => sub { $verbose++; },
  'no-blur' => sub { $do_blur = 0; },
  'no-sRGB' => sub { $sRGB = 0; },
  'max-full=s' => sub { @maxfull = parse_wh(@_); },
  'max-thumb=s' => sub { @maxthumb = parse_wh(@_); },
  'min-thumb=s' => sub { @minthumb = parse_wh(@_); },
  'quality=i' => sub { $imgquality = parse_int($_[0], $_[1], 0, 100); },
  'index=s' => \$indexUrl,
  'title=s' => \$galleryTitle,
  'description=s' => \$galleryDescription,
  'url=s' => \$galleryUrl,
  'link-orig:s' => sub { $copy_method_orig = parse_copy_method($_[0], $_[1]); },
  'link-view:s' => sub { $copy_method_view = parse_copy_method($_[0], $_[1]); },
  'viewdir:s' => \$viewdir,
  'startslideshow' => sub { $startslideshow = 'yes'; },
);

print_help(2) unless $rc && ( (@ARGV == 2) || ((@ARGV == 1) && $updating) );

fatal "no such directory $viewdir; try --viewdir option\n"
  unless -d $viewdir;

if (($galleryTitle || $galleryDescription || $galleryUrl)
    && !($galleryTitle && $galleryDescription && $galleryUrl)) {
  fatal "All three are required: --title, --description, and --url";
}

# only -u may operate on the "input directory" (i.e., for image removals)
($dir, $out) = @ARGV;
$absDir = canonpath(rel2abs($dir)) . '/';
$json_file = catfile($absDir, 'data.json');
if ($out) {
  $absOut = canonpath(rel2abs($out));
  $json_file = catfile($absOut, 'data.json');
  if (!-d $absDir) {
    fatal "input directory '$absDir' does not exist";
  } elsif ($absDir eq $absOut) {
    fatal "input and output directory are the same" unless $updating;
  } elsif (substr($absOut, 0, length($absDir)) eq $absDir) {
    fatal "output directory cannot be a sub-directory of input directory";
  } elsif (!-d $absOut) {
    if ($updating) {
      fatal "Directory '$absOut' missing, cannot update" unless is_a_gallery($absOut);
    }
  } elsif (!is_a_gallery($absOut)) {
    fatal "output dir '$absOut' exists, but doesn't look like an $me album";
  }
} else {
  fatal "Use -u option if you want to update image removals"
    unless $updating;
  fatal "input directory '$absDir' does not exist"
    unless -d $absDir;
  $absOut = $absDir;
}

# check for required commands
for (qw(cp ln mv touch)) {
  fatal "Command '$_' missing" unless cmd_exists($_);
}
fatal 'Missing convert executable (from ImageMagick)'
  unless cmd_exists('convert');
if ($offerzip) {
  if (!cmd_exists('7za')) {
    $p7zip = 0;
    cmd_exists('zip') || fatal "Missing '7z' or 'zip' command; try -d option"
  }
}
if (!cmd_exists('jpegoptim')) {
  $optimize_jpg = 0;
  warn "Command jpegoptim missing - will not optimize JPEG images (see also -k option)\n"
    if $verbose;
}
if (!cmd_exists('pngcrush')) {
  $optimize_png = 0;
  warn "Command pngcrush missing - will not optimize PNG images (see also -k option)\n"
    if $verbose;
}
fatal "Missing facedetect (see $facedetect_url); cannot use -f option"
  if $facedetect && !cmd_exists('facedetect');
fatal 'Missing tificc executable (from lcms2 library); try --no-sRGB option'
  if $sRGB && !cmd_exists('tificc');
my $tificccmd = 'tificc';
my $exiftrancmd;
while($orient)
{
  $exiftrancmd = "exiftran -aip" if cmd_exists('exiftran');
  last if $exiftrancmd;
  $exiftrancmd = "exifautotran" if cmd_exists('exifautotran');
  fatal 'Missing exiftran or exifautotran executable for JPEG autorotation; try -o option'
    unless $exiftrancmd;
}

if ($updating) {
  # if the directory already exists, don't fiddle with it unless it has a data.json file
  fatal "Output directory '$absOut' doesn't contain '$json_file'; cannot continue"
    unless -f $json_file;
  fatal "File '$json_file' not writable; cannot update album"
    unless -w _;
}

$zipfile = catfile($absOut, $albumzip);
if ($updating && $offerzip) {
  if (! -f $zipfile) {
    warn "Original zip file '$zipfile' missing: will not create one when updating (see -d option)\n";
    $offerzip = 0;
  }
  if (! -w _) {
    warn "Original zip file '$zipfile' not writable: will not create one when updating (see -d option)\n";
    $offerzip = 0;
  }
}

# get a list of available files with desired extensions
my @files;
find(
  {
    no_chdir => 1,
    wanted => sub {
      my $file = decode($_);
      return unless -f $file;
      my ($base, undef, $suffix) = fileparse($file, qr/\.[^.]*$/);
      return if (length($suffix) < 2 || $base =~ /^\./);
      $suffix = lc(substr($suffix, 1));
      push(@files, $file) if exists $extensions{$suffix};
    }
  }, encode($absDir)
) unless $absOut eq $absDir;
@files = sort @files;
fatal "No image files found in '$absDir'" unless @files || $updating;

# derived arguments
my $backblur = int(($minthumb[0] + $minthumb[1]) / 2 * 0.1);
my @backsize = (int($minthumb[0] * 4), int($minthumb[1] * 3));

# updating reads data from the original JSON file and rewrites it later
if (-f $json_file) {
  fatal "A non-writable '$json_file' was found; cannot continue" unless -w _;
  unless ($updating) {
    warn "Found $json_file; updating ...\n";
    $updating++;
  }
  $odata = read_json($json_file);
  warn Data::Dumper->Dump([$odata], ['old_json_data']), "\n"
    if $verbose > 2;
  for (@{$odata->{data}}) {
    next unless exists $_->{$alg};
    next unless exists $_->{img};
    $ofiles->{$_->{$alg}} = $_->{img}->[0];
    warn "SHA $_->{img}->[0]: $_->{$alg}\n" if $verbose > 1;
  }
  my @newfiles = ();
  for (@files) {
    fatal("Can't read file '$_'") unless -r $_;
    $sha->addfile($_);
    my $d = $sha->hexdigest();
    $sha->reset();
    warn "SHA $_: $d\n" if $verbose > 1;
    push @newfiles, $_ unless $ofiles->{$d};
  }
  if (@newfiles) {
    printf "Updating: %d of total %d found image files are new\n",
      scalar @newfiles, scalar @files;
  } else {
    printf "Updating: None of the %d found image files are new\n",
      scalar @files if @files;
  }
  @files = @newfiles;
  $name = $odata->{name} if $odata->{name} && !$name;
} else {
  # cleanup target paths
  fatal "No $json_file file found, cannot update" if $updating;
  for ( qw(thumbs blurs imgs files) ) {
    remove_tree(catfile($absOut, $_));
    make_path(catfile($absOut, $_));
  }
}

# now that $absOut definitely exists, do all work there
chdir($absOut) || fatal "Failed to 'cd $absOut' for $me album creation: $!";

# disable sub-process parallelism when threading ourselves
$workers = @files if $workers > @files;
if ($workers) {
  $ENV{MAGICK_THREAD_LIMIT} = 1;
  $ENV{OMP_NUM_THREADS} = 1;
}

# 1st pass: extract/prepare input file data
sub analyze_file
{
  my ($file) = @_;
  my ($base, $absDir, $suffix) = fileparse(decode($file), qr/\.[^.]*$/);
  $suffix = lc(substr($suffix, 1));

  progress::status("$base.$suffix");

  my $props = ImageInfo($file, {PrintConv => 0, Sort => 'File'});
  return unless defined $props && exists $props->{FileType}
                               && exists $filetypes{$props->{FileType}};

  # sanitize file name
  my $sane = $base;
  $sane =~ s/[^\w\-]/_/gu;
  my $root = $sane;

  # create a new file, try with names_#.jpg until we find the first one free
  for (my $c = 0;; $c++) {
    my $tmp = catfile(catfile($absOut, 'imgs'), "$root.$ext");
    if ( sysopen(my $fd, $tmp, O_WRONLY|O_CREAT|O_EXCL, $filemode) ) {
      close($fd);
      last;
    }
    $root = sprintf "%s_%d", $sane, $c;
  }

  $props->{file} = $file;
  $props->{root} = $root;
  $props->{suffix} = $suffix;

  # try to get original image size by iterating to the last duplicated tag
  $props->{OrigImageWidth} = $props->{ExifImageWidth} || undef;
  $props->{OrigImageHeight} = $props->{ExifImageHeight} || undef;
  for(my $n = 1; exists $props->{"ExifImageWidth ($n)"}; $n++) {
    $props->{OrigImageWidth} = $props->{"ExifImageWidth ($n)"};
    $props->{OrigImageHeight} = $props->{"ExifImageHeight ($n)"};
  }

  # extract caption
  for my $m (@captions) {
    if ($m eq 'cmt') {
      if ($props->{Comment}) {
        my $cmt = Encode::decode_utf8($props->{Comment});
        $props->{caption} = cap_from_str($cmt);
        last;
      }
    } elsif ($m eq 'txt') {
      my $txt = catfile($absDir, $base . '.txt');
      if (-f $txt) {
        $props->{caption} = cap_from_str(slurp($txt));
        last;
      }
    } elsif ($m eq 'exif') {
      if ($props->{Title} || $props->{Description}) {
        $props->{caption} = cap_from_props($props);
        last;
      }
    } elsif ($m eq 'xmp') {
      my $xmp = ImageInfo("$file.xmp", {PrintConv => 0, Sort => 'File'});
      if (defined($xmp) && ($xmp->{Title} || $xmp->{Description})) {
        $props->{caption} = cap_from_props($xmp);
        last;
      }
    } else {
      fatal "Encountered unknown caption method '$m'";
    }
  }

  return $props;
}

# get image properties of files with image extensions
if (@files) {
  warn sprintf "Found %d candidate image files\n", scalar @files
    if $verbose;
  warn map { "  $_\n" } @files
    if @files && $verbose > 1;
  progress::init('Image file inspection', scalar @files);
  $aprops = run_in_parallel('analyze', \&analyze_file, \@files);
  dump_properties($aprops) if $verbose > 2;
  # remove any files that failed analysis
  my @nf = ();
  my @na = ();
  my $n = 0;
  for (@files) {
    if ( defined $aprops->[$n] ) {
      push @nf, $_;
      push @na, $aprops->[$n];
    } else {
      warn "Image '$_' failed analysis - skipping\n";
    }
    $n++;
  }
  progress::done(sprintf '- will now process %d image files', scalar @nf);
  @files = @nf;
  $aprops = \@na;
}

if ($updating) {
  warn "No new image files to process\n" unless @files;
  # but maybe some files were removed and data.json needs updating ...
  my %o = map { $_ => 1 } values %$ofiles;
  delete $o{catfile('imgs', $_)} for @{current_imgs(catfile($absOut, 'imgs'))};
  # these files will need to be removed from zipfile further below
  my @d = map { (File::Spec->splitpath($_))[2] } keys %o;
  if (@d) {
    my $n = scalar @d;
    $n == 1 ?  warn "One image file was removed; updating gallery\n" :
      warn sprintf "%d image files were removed; updating gallery\n", $n;
    # redefined aref $odata->{data} leaving out the deleted images
    my @ndata = ();
    for ( @{$odata->{data}} ) {
      if ( (exists $_->{img}) && (exists $o{$_->{img}->[0]}) ) {
        warn "Image file '$_->{img}->[0]' was removed\n" if $verbose;
        push @deleted, $_->{file} || $_->{orig};
        for ($_->{blur}, $_->{thumb}->[0], $_->{file} || $_->{orig}) {
          next unless -f $_;
          unlink $_ || fatal "Failed to remove '$_': $!";
          warn "Removed '$_'\n" if $verbose > 1;
        }
        next;
      }
      push @ndata, $_;
    }
    $odata->{data} = \@ndata;
  }
} else {
  warn "No image files found for processing\n" unless @files;
}

# gather dates and megapixel sizes of image files
my $amp = 0;
my $ostamp = 0;
for my $props (@$aprops) {
  # file timestamp
  my $idate = $props->{DateTimeOriginal} || $props->{DateTime} || '';
  $idate =~ s/^\s+|\s+$//g;
  my $t = Time::Piece->strptime($idate, "%Y:%m:%d %H:%M:%S");
  if ($t && $t->epoch()) {
    $props->{date} = $t->strftime("%Y-%m-%d %H:%M");
    $props->{stamp} = $ostamp = $t->epoch();
  } else {
    # no date available, cheat by using the previous timestamp
    $props->{stamp} = $ostamp = $ostamp + 1;
  }
  # megapixels and average thereof
  $props->{mp} = ($props->{ImageWidth} * $props->{ImageHeight} / 1e6);
  $amp += $props->{mp};
}
$amp /= @files if @files;

# 2nd pass: produce output files
sub process_img
{
  my %props = %{$_[0]};
  my $root = $props{root};
  my $suffix = $props{suffix};
  my $file = $props{file};

  # derived file names
  my $ffile = catfile('files', "$root.$suffix");
  my $fbase = "$root.$ext";
  my $fimg = catfile('imgs', $fbase);
  my $fthumb = catfile('thumbs', $fbase);
  my $fblur = catfile('blurs', $fbase);

  my $absFout = catfile($absOut, $ffile);
  my $absFtmp = catfile($absOut, "$ffile.tmp");

  progress::status($fbase);

  # copy source image, optimize unless suppressed, set mode and file timestamp
  return if copy_source_file($file, $absFout);
  if ($optimize || $orient) {
    if ($orient && $props{FileType} eq "JPEG" && ($props{Orientation} // 0)) {
      return if sys("$exiftrancmd '$absFout' 2>&1");
      if (($props{Orientation} // 0) > 4) {
        ($props{ImageWidth}, $props{ImageHeight})
          = ($props{ImageHeight}, $props{ImageWidth});
      }
    }
    if ($optimize_jpg && $props{FileType} eq "JPEG") {
      return if sys('jpegoptim', '-q', $absFout);
    } elsif ($optimize_png && $props{FileType} eq "PNG") {
      return if sys('pngcrush', '-q', $absFout, $absFtmp);
      rename($absFtmp, $absFout);
    }
  }
  chmod($filemode, $absFout);
  sys('touch', '-r', $file, $absFout); # ignore errors

  # intermediate sRGB colorspace conversion
  if ( !$sRGB || !defined($props{ProfileID})
              || ($props{ColorSpace} // 65535) == 1
              || ($props{DeviceModel} // '') eq 'sRGB') {
    $absFtmp = $absFout;
  } else {
    return if sys('convert', '-quiet', $absFout, '-compress', 'LZW', '-type', 'truecolor', "tiff:$absFtmp");
    return if sys($tificccmd, '-t0', $absFtmp, "$absFtmp.tmp");
    rename("$absFtmp.tmp", $absFtmp);
  }

  # generate main image
  my @sfile = ($props{ImageWidth}, $props{ImageHeight});
  my @cmd = ('convert', '-quiet', $absFtmp, '-gamma', '0.454545',
          '-geometry', "$maxfull[0]x$maxfull[1]>",
          '-print', '%w\n%h', '-gamma', '2.2', '+profile', '!icc,*',
          '-quality', $imgquality, catfile($absOut, $fimg)
  );
  my ($rc, $simg) = sys_with_output(@cmd);
  return if $rc;

  # face/center detection
  my @center = (0.5, 0.5);
  if ($facedetect) {
    my @cmd = ('facedetect', '--best', '--center', catfile($absOut, $fimg));
    my ($rc, $o) = sys_with_output(@cmd);
    return if $rc;
    for (@$o) {
      if (my @tmp = /(\d+) (\d+) (\d+) (\d+)/) {
	@center = ($tmp[0] / $simg->[0], $tmp[1] / $simg->[1]);
	last;
      }
    }
  }

  # thumbnail size
  my $thumbrt;
  if ($sfile[0] / $sfile[1] < $minthumb[0] / $minthumb[1]) {
    $thumbrt = $minthumb[0] / $sfile[0];
  } else {
    $thumbrt = $minthumb[1] / $sfile[1];
  }
  my @sthumb = (max(int($sfile[0] * $thumbrt + 0.5), $minthumb[0]),
                max(int($sfile[1] * $thumbrt + 0.5), $minthumb[1]));
  my @mthumb = (min($maxthumb[0], $sthumb[0]),
                min($maxthumb[1], $sthumb[1]));

  # cropping window
  my $dx = $sthumb[0] - $mthumb[0];
  my $cx = pmin($dx, int($center[0] * $sthumb[0] - $sthumb[0] / 2 + $dx / 2));
  my $dy = $sthumb[1] - $mthumb[1];
  my $cy = pmin($dy, int($center[1] * $sthumb[1] - $sthumb[1] / 2 + $dy / 2));

  return if sys('convert', $absFtmp,
                ($verbose > 1 ? () : '-quiet'),
                '-gamma', '0.454545',
                '-resize', "$sthumb[0]x$sthumb[1]!",
                '-gravity', 'NorthWest',
                '-crop', "$mthumb[0]x$mthumb[1]+$cx+$cy",
                '-gamma', '2.2',
                '-quality', $imgquality,
                '+profile', '!icc,*',
                $fthumb,
              );

  return if $do_blur
         && sys('convert', $fthumb,
                ($verbose > 1 ? () : '-quiet'),
                '-virtual-pixel', 'Mirror',
                '-gaussian-blur', "0x$backblur",
                '-scale', "$backsize[0]x$backsize[1]",
                '-quality', '90',
                $fblur,
              );

  my %fdata;
  $fdata{props} = \%props;
  $fdata{img} = [$fimg, [map { int } @$simg]];
  $fdata{file} = [$ffile, [map { int } @sfile]];
  $fdata{blur} = $fblur if $do_blur;

  # avoid storing duplicate information
  my @tdata = ($fthumb, [map { int } @mthumb]);
  if ($sthumb[0] != $mthumb[0] || $sthumb[1] != $mthumb[1]) {
    push(@tdata, [map { int } @sthumb], [map { int } $cx, $cy]);
  }
  $fdata{thumb} = \@tdata;

  # truncate some floats
  $center[0] = int($center[0] * 1000);
  $center[1] = int($center[1] * 1000);
  if (abs($center[0] - 500) > 1 || abs($center[0] - 500) > 1) {
    $fdata{center} = \@center;
  }

  # remove temporary files
  unlink($absFtmp) if $absFtmp ne $absFout;

  return \%fdata;
}

# create thumbnails, blurs, and do face detection where required
if (@$aprops) {
  warn map { "  $_\n" } map { $_->{file} } @$aprops
    if $verbose > 1;
  my $msg = sprintf "Processing of %d image files", scalar @$aprops;
  progress::init($msg, scalar(@$aprops));
  $adata = run_in_parallel('process', \&process_img, $aprops);
  progress::done();
  dump_properties($adata) if $verbose > 2;
}

# create or update the album zip file
if ($offerzip) {
  if ($adata && @$adata) {
    my @f = ();
    chdir('files') || fatal "Failed to cd to files subdirectory for zipping";
    for (@$adata) {
      # files that failed analysis are undefined in @$adata
      next unless $_;
      my $f = (splitpath($_->{file}[0]))[2];
      if ( $f && -f $f && -r _) {
        push @f, $f;
      } else {
        warn "No file '$f' in files subdir - not adding to $zipfile\n";
      }
    }
    warn "Adding following images to $albumzip:\n",
      map { sprintf "  $_\n" } @f if $verbose > 1;
    my $rc;
    if ($p7zip) {
      my @v = $verbose > 2 ? ('-bb3', '-bt')
            : $verbose > 1 ? ('-bb2', '-bt')
            : $verbose ?     ('-bb1', '-bt')
            :                ('-bb0');
      my $mt = $workers ? "-mmt=$workers" : '';
      $rc = sys('7za', '-tzip', @v, $mt, 'a', '--', $zipfile, @f);
    } else {
      my $v = $verbose ? '-v' : '-q';
      $rc = sys('zip', '-q9j', $v, $zipfile, @f);
    }
    fatal "Failed to create $albumzip (rc=$rc)" if $rc;
    warn sprintf "Updated %s with %d image files\n", $zipfile, scalar @f;
    chdir($absOut) || fatal "Failed to cd to $absOut after zipping: $!";
  }
} else {
  unlink $zipfile;
}
if (@deleted && -f $zipfile) {
  # @deleted refers to file/IMAGE.jpg but zipfile simply calls it IMAGE.jpg
  my @del = map { (splitpath($_))[2] } @deleted;
  warn "Deleting - if present - following files from $albumzip:\n",
        map { sprintf "  $_\n" } @del if $verbose > 1;
  if ($p7zip) {
    my @v = $verbose > 2 ? ('-bb3', '-bt')
          : $verbose > 1 ? ('-bb2', '-bt')
          : $verbose ?     ('-bb1', '-bt')
          : ();
    $rc = sys('7za', '-tzip', @v, 'd', '--', $zipfile, @del);
  } else {
    my $v = $verbose ? '-v' : '-q';
    $rc = sys('zip', '-q9j', '-d', $zipfile, @del);
  }
  fatal "Failed to update $albumzip (rc=$rc)" if $rc;
  warn sprintf "Removed %d image files from %s\n", scalar @del, $zipfile;
}

# prepare and write out the new data.json
my %json = (
  data => [],
  thumb => { min => \@minthumb, max => \@maxthumb },
);
$json{blur} = \@backsize if $do_blur;
for my $fdata (@$adata) {
  next unless $fdata;
  my %data;
  for ( qw(img thumb blur center) ) {
    $data{$_} = $fdata->{$_} if defined $fdata->{$_};
  }
  for ( qw(date stamp caption) ) {
    $data{$_} = $fdata->{props}{$_} if defined $fdata->{props}{$_};
  }
  my $file = $fdata->{file}[0];
  fatal("No such file '$file'") unless -f $file;
  fatal("Can't read file '$file'") unless -r _;
  $sha->addfile($file);
  my $d = $sha->hexdigest();
  $sha->reset();
  $data{$alg} = $d;
  $data{file} = $file;
  # remove superfluous raw files
  my $keep = $include;
  unless ($keep || !$fullpano) {
    my ($x, $y) = @{$fdata->{file}[1]};
    my $mp = ($x * $y / 1e6);
    # see if the source file is just a crop of the original
    my $ox = $fdata->{props}{OrigImageWidth} // 0;
    my $oy = $fdata->{props}{OrigImageHeight} // 0;
    my $omp = ($ox * $oy / 1e6);
    $keep = 1 if ($mp >= $omp) && ($mp > $amp) && (abs($x/$y) >= $panort);
  }
  unless ($keep) {
    unlink($file);
    warn "Deleted raw file '$file' (see -i and -k options)\n" if $verbose > 1;
  }
  push(@{$json{data}}, \%data)
    unless (exists $ofiles->{$d}) && ($ofiles->{$d} = $data{stamp});
}
write_json('data.json', \%json, $odata->{data});

# remove the files directory when empty
rmdir('files');

# (re-)setup copy/link of view subdirectory
my $vdir = 'view';
remove_tree($vdir) if $updating;
unless (-d $vdir) {
  my $rc;
  if ($copy_method_view eq 'syml') {
    $rc = sys('ln', '-s', $viewdir, '.');
   } else {
    $rc = sys('cp', '-LR', $viewdir, '.');
  }
  fatal "Failed to cp ($copy_method_view) $viewdir" if $rc;
}
# craft the index.html contents from the actual data.json file
my $html = qq{\n    <div id="photos" } .
           qq{itemscope itemtype="http://schema.org/ImageGallery">\n};
$html .= qq{\t<h1 itemprop="name">$galleryTitle</h1>\n}
    if $galleryTitle;
$html .= qq{\t<p itemprop="description">$galleryDescription</p>\n}
    if $galleryDescription;
$html .= qq{\t<div id="wrapper">};
# enumerate the images for noscript
my $id = 0;
$adata = read_json($json_file);
for (@{$adata->{data}}) {
  my $f = $_->{img}[0];
  my $t = $_->{thumb}[0];
  # find caption and description for alt and title
  my ($x, $y);
  if ((exists $_->{caption}) && (ref $_->{caption} eq 'ARRAY')) {
      my $c = $_->{caption};
      $x = $_->{caption}->[0] if @$c >= 1;
      $y = $_->{caption}->[1] if @$c >= 2;
  }
  $x = (splitpath($f))[2] unless $x;
  $y = $x unless $y;
  $html .= qq{\n\t  <a id="$id" href="$f" title="$y">}
         . qq{<img src="$t" alt="$x"/></a>};
  $id++;
}
$html .= qq{\n\t</div>\n};
$html .= qq{    </div>\n};
$html .= qq{    };
my $indexhtml = slurp('view/index.html');
$indexhtml =~ s@<noscript>.*?</noscript>@<noscript>$html</noscript>@s;
# include the optional social media decoration
if ($galleryTitle && $galleryDescription && $galleryUrl) {
  # default to the first image
  my $galleryImage = $adata->{data}->[0]->{img}->[0];
  $html = qq{
    <!-- for Facebook -->
    <meta property="og:title" content="$galleryTitle" />
    <meta property="og:description" content="$galleryDescription" />
    <meta property="og:type" content="article" />
    <meta property="og:image" content="${galleryUrl}/$galleryImage" />
    <meta property="og:url" content="$galleryUrl" />
    <!-- for Twitter -->
    <meta name="twitter:card" content="summary" />
    <meta name="twitter:title" content="$galleryTitle" />
    <meta name="twitter:description" content="$galleryDescription" />
    <meta name="twitter:image" content="${galleryUrl}/$galleryImage" />
  };
  $indexhtml =~ s@    <!-- for Facebook -->\n(    .*\n)*@@;
  $indexhtml =~ s@  </head>@$html  </head>@;
}

# and finally, write out the new index.html and noscript.html files
my $index = 'index.html';
unlink($index);
my $fd;
open($fd, ">:encoding($ENCODING)", $index)
  || fatal "cannot write $index: $!";
print $fd $indexhtml;
if (close $fd) {
  warn "Wrote new $index\n";
} else {
  fatal "Failed to write new $index: $!\n";
}
my $noscript = 'noscript.html';
open($fd, ">:encoding($ENCODING)", $noscript)
  || fatal "cannot write $noscript: $!";
for (split m{\n+}o, $indexhtml) {
  next if m{^\s*</?(no)?script\s*}o;
  print $fd $_, "\n";
}
if (close $fd) {
  warn "Wrote new $noscript\n";
} else {
  fatal "Failed to write new $noscript: $!\n";
}

print sprintf "%s version %s %s gallery in %s\n",
      $me, $VERSION, $updating ? 'updated' : 'created', $absOut;

exit 0;