#!/usr/bin/env perl
# A modern, minimalist javascript photo gallery
# Copyright© 2016-2021  Alex Schroeder <alex@gnu.org>
# Copyright©      2018  Adrian Steinmann <ast@marabu.ch>
# Copyright© 2011-2016  wave++ "Yuri D'Elia" <wavexx@thregr.org>
# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
# You should have received a copy of the GNU General Public License along with
# this program. If not, see <http://www.gnu.org/licenses/>.
use Modern::Perl '2018';
use utf8;
our $VERSION = "3.0.0";
use Digest::SHA;
use Encode qw(decode_utf8 encode_utf8);
use Encode::Locale;
use File::Basename qw(fileparse);
use File::Copy::Recursive qw(dircopy);
use File::Path qw{make_path remove_tree};
use File::ShareDir qw(dist_dir);
use File::Slurper qw(read_text write_text read_dir read_binary write_binary);
use File::Spec::Functions qw(rel2abs canonpath catfile splitpath);
use File::Symlink::Relative; # symlink_r
use Getopt::Long qw(:config bundling);
use Image::ExifTool qw(ImageInfo);
use JSON::Tiny qw(decode_json encode_json);
use List::Util qw(min max none);
use Time::Piece; # strptime, strftime
use Time::Progress;
# our name ;-)
my $me = (splitpath($0))[2];
# view subdirectory where the JavaScript and CSS code lives
my $viewdir = catfile(dist_dir('App-sitelenmute'), 'view');
umask oct('0022');
# defaults
my $facedetect_url = 'http://www.thregr.org/~wavexx/hacks/facedetect/';
my $filemode = oct('0644');
my $slim = 0;
my $include = 0;
my $orient = 1;
my $timesort = 1;
my $revsort = 0;
my %filetypes = map { $_ => 1 } qw{JPEG PNG TIFF};
my $extensions = join("|", qw{jpg jpeg png tif tiff});
my $ext = "jpg";
my @minthumb = (150, 112);
my @maxthumb = (267, 200);
my @maxfull = (1600, 1200);
my $imgq = 90;
my $fullpano = 1;
my $nodown = 0;
my $panort = 2.;
my $facedet = 0;
my $use_orig = 0;
my $jpegoptim = 1;
my $pngoptim = 1;
my $p7zip = 1;
my $verbose = 0;
my $sRGB = 1;
my $do_blur = 1;
my $indexUrl = undef;
my %captions = map { $_ => 1} qw{txt xmp exif cmt};
my @captions = keys %captions;
my $galleryTitle = '';
my $galleryDescription = '';
my $galleryUrl = '';
my $updating = 0;
my %copy_method = (
  # There is BSD support in sub do_copy!
  copy => '',
  hard => '--link',
  sym  => '--symbolic-link',
);
$copy_method{ref} = '--reflink' unless $^O =~ m{bsd$}oi;
my $copy_method = 'copy';
my $fdownload = catfile(qw{files album.zip});
my $alg = 'sha256';
my $sha = Digest::SHA->new($alg);
my $odata = { data => [] };
my $dir;
my $out;
my $name;
my $aprops;
my $adata;
my $zipfile;
# 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"};
}
sub sys {
  my @cmd = @_;
  my $cmd = join ' ', map { qq{"$_"} } @cmd;
  say $cmd if $verbose > 1;
  my $fd;
  open($fd, '-|', @cmd) || fatal "cannot execute $cmd: $!";
  local $/ = undef;
  my $o = <$fd>;
  close($fd) || fatal "close failed on $cmd: $!";
  return $o;
}
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 'sym') {
      @cmd = ('ln', '-s');
    } elsif ($t eq 'copy') {
      @cmd = ('cp');
    } else {
      fatal "do_copy: cp option '$t' not supported";
    }
  } else {
    push @cmd, $copy_method{$t} if $copy_method{$t}; # don't push ''
  }
  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 eq 'sym';
  do_copy($copy_method, $file, $fout);
}
sub is_a_gallery {
    my ($d) = @_;
    return unless -e catfile($d, 'data.json');
    return 1;
}
sub read_json {
  my($f) = @_;
  my $j = read_binary($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 $j = {};
  for (qw(thumb blur)) {
    $j->{$_} = $jh->{$_} if exists $jh->{$_};
  }
  $j->{data} = [ sort { $a->{stamp} <=> $b->{stamp} } @{$jh->{data}}, @$ja ];
  $j->{version} = $VERSION;
  $j->{timestamp} = time();
  $j->{timecreated} = sprintf "%s", scalar localtime $j->{timestamp};
  $j->{name} = $name if $name;
  $j->{download} = $fdownload if $zipfile && -f $zipfile;
  $j->{index} = $indexUrl if $indexUrl;
  write_binary($f, encode_json($j));
  say "Wrote new $f";
  return $f;
}
sub pmin {
  my ($m, $v) = @_;
  return 0 if $v < 0;
  return min($m, $v);
}
# normalise and trim whitespace in captions
sub cap_clean {
  my ($x) = @_;
  return '' unless $x;
  $x =~ s{\s+}{ }g;
  $x =~ s{^\s+|\s+$}{}g;
  return $x;
}
# extracting title and description from a string containing newlines
sub cap_from_str {
  my ($title, $desc) = @_;
  return unless $title;
  ($title, $desc) = split m{\n+}, $title unless $desc;
  return [cap_clean($title), cap_clean($desc)];
}
# extracting title and description from a properties hash reference
sub cap_from_props {
  my ($props) = @_;
  my $ret = ['', ''];
  if ($props->{Title}) {
    my $title = decode_utf8($props->{Title});
    $ret->[0] = cap_clean($title);
  }
  if ($props->{Description}) {
    my $desc = decode_utf8($props->{Description});
    $ret->[1] = cap_clean($desc);
  }
  return $ret;
}
# option parsing: width and height
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));
}
# option parsing: integers
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*}, $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) = @_;
  $v = $copy_method unless $v;
  fatal "'$v' not a copy method; use one of "
        . join ', ', sort keys %copy_method
    unless 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;
  my @files = grep m{\.$ext$}, read_dir($d);
  return \@files;
}
sub print_help {
  say qq{Usage: $me [options] INPUT_DIR OUTPUT_DIR
  -h, --help            this help
  -v                    verbosity (repeat for more detail)
  -s                    slim output (no original files nor album download)
  -i                    include individual original image files
  -c "METHODS"          caption extraction methods (txt,xmp,exif,cmt,none)
  -o                    do not auto-orient images
  -k                    do not modify files, keep original image files
  -t                    do not time-sort
  -r                    reverse album order
  -p                    do not automatically include full-sized panoramas
  -n "ALBUM_NAME"       set album name (title in browser window)
  -d                    skip creation of a full album zip file for download
  -f                    improve thumbnail cutting by performing face detection
  --noblur              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: $imgq)
  --link-orig           copy method (hard,sym,ref,copy); default: $copy_method
  --viewdir             directory containing $me CSS/JavaScript ($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];
}
# Options: text needs to be decoded based on locale, but filenames are not
# decoded; URLs are decoded because international domain names (IDNA) and
# internationalized resource identifiers (IRI) can still happen.
GetOptions(
  'help|h' => sub { print_help(0); },
  'version' => sub { say "$0 $VERSION"; exit 0; },
  'c=s' => sub { @captions = @{ parse_captions($_[0], $_[1]) || [] }; },
  'd' => sub { $nodown = 1; },
  'f' => sub { $facedet = 1; },
  'i' => sub { $include = 1; },
  'o' => sub { $orient = 0; },
  'k' => sub { $use_orig = 1; },
  'n=s' => sub { $name = decode(locale => shift); },
  'p' => sub { $fullpano = 0; },
  'r' => sub { $revsort = 1; },
  's' => sub { $slim = 1; },
  't' => sub { $timesort = 0; },
  'v' => sub { $verbose++; },
  'noblur' => sub { $do_blur = 0; },
  'max-full=s' => sub { @maxfull = parse_wh(@_); },
  'max-thumb=s' => sub { @maxthumb = parse_wh(@_); },
  'min-thumb=s' => sub { @minthumb = parse_wh(@_); },
  'no-sRGB' => sub { $sRGB = 0; },
  'quality=i' => sub { $imgq = parse_int($_[0], $_[1], 0, 100); },
  'index=s' => sub { $indexUrl = decode(locale => shift); },
  'title=s' => sub { $galleryTitle = decode(locale => shift); },
  'description=s' => sub { $galleryDescription = decode(locale => shift); },
  'url=s' => sub { $galleryUrl = decode(locale => shift); },
  'link-orig:s' => sub { $copy_method = parse_copy_method($_[0], $_[1]); },
  'viewdir:s' => \$viewdir,
);
print_help(2) unless @ARGV == 2;
if (($galleryTitle || $galleryDescription || $galleryUrl)
    && !($galleryTitle && $galleryDescription && $galleryUrl)) {
  fatal "All three are required: --title, --description, and --url";
}
# -u may operate on the "input directory" (i.e., for image removals)
($dir, $out) = @ARGV;
my $absDir = canonpath(rel2abs($dir)) . '/';
my $absOut = canonpath(rel2abs($out)) . '/';
if (!-d $absDir) {
  fatal "input directory '$absDir' does not exist";
} elsif ($absDir eq $absOut) {
  fatal "input and output directory are the same";
} elsif (substr($absOut, 0, length($absDir)) eq $absDir) {
  fatal "output directory cannot be a sub-directory of input directory";
} elsif (!-d $absOut) {
  make_path($absOut) || fatal "Failed to create output directory $absOut";
} elsif (!is_a_gallery($absOut)) {
  fatal "output dir '$absOut' exists, but doesn't look like a ${me} dir";
}
$zipfile = catfile($absOut, $fdownload);
# check for required commands
for (qw(cp ln mv touch)) {
  fatal "Command '$_' missing" unless cmd_exists($_);
  say "Found $_" if $verbose > 1;
}
fatal 'Missing convert executable (from ImageMagick)'
  unless cmd_exists('convert');
say "Found convert" if $verbose > 1;
unless(cmd_exists('7za')) {
  $p7zip = 0;
  cmd_exists('zip') || fatal 'Missing 7z or zip command';
}
say "Found " . ($p7zip ? "7za" : "zip") if $verbose > 1;
$jpegoptim = 0 unless cmd_exists('jpegoptim');
say (($jpegoptim ? "Found" : "No") . " jpegoptim") if $verbose > 1;
$pngoptim = 0 unless cmd_exists('pngcrush');
say (($pngoptim ? "Found" : "No") . " pngcrush") if $verbose > 1;
fatal "Missing facedetect (see $facedetect_url)"
  if $facedet && !cmd_exists('facedetect');
say "Found facedetect" if $facedet && $verbose > 1;
fatal 'Missing tificc executable (from lcms2 library)'
  if $sRGB && !cmd_exists('tificc');
say "Found tificc" if $sRGB && $verbose > 1;
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'
    unless $exiftrancmd;
}
say "Found $exiftrancmd" if $verbose > 1;
# get a list of files to work on
my @files;
@files = map { catfile($absDir, $_) } sort grep m{\.($extensions)$}i, read_dir($absDir);
fatal "No image files found in '$absDir'" unless @files;
# derived arguments
my $backblur = int(($minthumb[0] + $minthumb[1]) / 2 * 0.1);
my @backsize = (int($minthumb[0] * 4), int($minthumb[1] * 3));
# updating needs to use some data from the original JSON file; remember: the
# original files have filenames such as "P3111190.JPG"; the gallery has
# filenames such as "imgs/P3111190.jpg" (notice how the suffix is always $ext).
# That is, the digest is the only thing that allows us to definitely map the
# images.
my $json_file = catfile($absOut, 'data.json');
if (-f $json_file) {
  say "Found $json_file; updating ...";
  $updating = 1;
  $odata = read_json($json_file);
  my %ofiles;
  for (@{$odata->{data}}) {
    next unless exists $_->{$alg};
    next unless exists $_->{img};
    $ofiles{$_->{$alg}} = $_->{img}->[0];
    say "SHA $_->{$alg} $_->{img}->[0]" if $verbose > 1;
  }
  my @newfiles;
  my %digests;
  for (@files) {
    fatal("Can't read file '$_'") unless -r $_;
    $sha->addfile($_);
    my $digest = $sha->hexdigest();
    $sha->reset();
    say "SHA $digest $_ " . ($ofiles{$digest} ? "ok" : "new") if $verbose > 1;
    push @newfiles, $_ unless $ofiles{$digest}; # unknown new digest means new image to process
    delete $ofiles{$digest}; # ofiles are the files listed in the old gallery, need to delete any that remain
    $digests{$digest} = $_; # remember the original filename for each digest
  }
  if (@newfiles) {
    printf "%d of total %d found image files are new\n", scalar @newfiles, scalar @files;
  } else {
    printf "None of the %d found image files are new\n", scalar @files if @files;
  }
  @files = @newfiles;
  $name = $odata->{name} if $odata->{name} && !$name;
  # The files to delete are in %ofiles, which is based on $odata from the JSON file.
  # With this information, we can delete the appropriate entries from the JSON file.
  my @deleted = values %ofiles; # "imgs/P3111190.jpg"
  my @zipmember;
  if (@deleted) {
    if (@deleted == 1) {
      say "1 image in the gallery was deleted";
    } else {
      printf "%d images in the gallery were deleted\n", scalar @deleted;
    }
    # redefine $odata->{data} leaving out the deleted images
    my @ndata;
    for my $entry (@{$odata->{data}}) {
      if (none { $entry->{img}->[0] eq $_ } @deleted) {
        push(@ndata, $entry);
      } else {
        # unlink the three files
        unlink catfile($absOut, $_) for $entry->{img}->[0], $entry->{thumb}->[0], $entry->{blur};
        push(@zipmember, $entry->{original});
      }
    }
    $odata->{data} = \@ndata;
    # remove the files from the zipfile
    if (-f $zipfile) {
      if ($p7zip) {
        sys('7za', '-tzip', 'd', '--', $zipfile, @zipmember);
      } else {
        sys('zip', '-q9j', '-d', $zipfile, @zipmember);
      }
      unlink catfile($absOut, 'files', $_) for @deleted;
      printf "Removed %d image files from %s\n", scalar @zipmember, $zipfile;
    }
  } else {
    say "None of the images in the gallery were deleted";
  }
} 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, $_));
  }
}
# 1st pass: extract/prepare input file data
sub analyze_files {
  my $p = Time::Progress->new(min => 0, max => scalar @_);
  local $| = 1; # autoflush progress bar
  my ($i, @result);
  for (@_) {
    print $p->report("\rImage file inspection %20b ETA: %E", $i++);
    push(@result, analyze_file($_));
  }
  say $p->report("\rImage file processing %20b done       ", $i);
  return \@result;
}
sub analyze_file {
  my ($file) = @_;
  my ($base, $absDir, $suffix) = fileparse($file, qr/\.[^.]*$/);
  $suffix = substr($suffix, 1);
  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");
    last unless -e $tmp;
    $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(read_text($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) {
  printf "Found %d prospective image files\n", scalar @files
    if $verbose;
  map { say } @files if @files && $verbose > 1;
  $aprops = analyze_files(@files);
  # remove any files that failed analysis (from the back to the front)
  for (my $n = $#files; $n > 0; $n--) {
    if (not defined $aprops->[$n]) {
      splice(@files, $n, 1);
      splice(@$aprops, $n, 1);
    }
  }
  printf "Processing %d image files\n", scalar @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_images {
  my $p = Time::Progress->new(min => 0, max => scalar @_);
  local $| = 1; # autoflush progress bar
  my ($i, @result);
  for (@_) {
    print $p->report("\rImage file processing %20b ETA: %E", $i++);
    push(@result, process_image($_));
  }
  say $p->report("\rImage file processing %20b done       ", $i);
  return \@result;
}
sub process_image {
  my %props = %{$_[0]};
  my $root = $props{root};
  my $suffix = $props{suffix};
  my $file = $props{file};
  # derived file names
  my $ofile = (splitpath($file))[2];
  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");
  # copy source image, apply tranforms, set mode and file timestamp
  copy_source_file($file, $absFout);
  unless ($use_orig) {
    if ($orient && $props{FileType} eq "JPEG" && ($props{Orientation} // 0)) {
      sys("$exiftrancmd '$absFout' 2>/dev/null");
      if (($props{Orientation} // 0) > 4) {
        ($props{ImageWidth}, $props{ImageHeight})
          = ($props{ImageHeight}, $props{ImageWidth});
      }
    }
    if ($jpegoptim && $props{FileType} eq "JPEG") {
      sys('jpegoptim', '-q', $absFout);
    } elsif ($pngoptim && $props{FileType} eq "PNG") {
      sys('pngcrush', '-s', $absFout, $absFtmp);
      rename($absFtmp, $absFout);
    }
  }
  chmod($filemode, $absFout);
  sys('touch', '-r', $file, $absFout);
  # intermediate sRGB colorspace conversion
  if ( !$sRGB || !defined($props{ProfileID})
              || ($props{ColorSpace} // 65535) == 1
              || ($props{DeviceModel} // '') eq 'sRGB') {
    $absFtmp = $absFout;
  } else {
    sys('convert', '-quiet', $absFout, '-compress', 'LZW',
                   '-type', 'truecolor', "tiff:$absFtmp");
    sys($tificccmd, '-t0', $absFtmp, "$absFtmp.tmp");
    rename("$absFtmp.tmp", $absFtmp);
  }
  # generate main image
  my @sfile = ($props{ImageWidth}, $props{ImageHeight});
  my @simg = split m{\n+}, sys('convert', '-quiet', $absFtmp,
                 '-gamma', '0.454545',
                 '-geometry', "$maxfull[0]x$maxfull[1]>",
                 '-print', '%w\n%h',
                 '-gamma', '2.2',
                 '+profile', '!icc,*',
                 '-quality', $imgq, catfile($absOut, $fimg)
             );
  # face/center detection
  my @center = (0.5, 0.5);
  if ($facedet) {
    my @f = split m{\n+}, sys("facedetect", "--best", "--center", catfile($absOut, $fimg));
    for (@f) {
      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));
  sys('convert', '-quiet', $absFtmp,
      '-gamma', '0.454545',
      '-resize', "$sthumb[0]x$sthumb[1]!",
      '-gravity', 'NorthWest',
      '-crop', "$mthumb[0]x$mthumb[1]+$cx+$cy",
      '-gamma', '2.2',
      '+profile', '!icc,*',
      '-quality', $imgq, catfile($absOut, $fthumb)
  );
  # blur
  sys('convert', '-quiet', catfile($absOut, $fthumb),
      '-virtual-pixel', 'Mirror',
      '-gaussian-blur', "0x$backblur",
      '-scale', "$backsize[0]x$backsize[1]",
      '-quality', '90', catfile($absOut, $fblur)
   ) if $do_blur;
  # checksum
  $sha->addfile($file);
  my $digest = $sha->hexdigest();
  $sha->reset();
  my %fdata;
  $fdata{props} = \%props;
  $fdata{img} = [$fimg, [map { int } @simg]];
  $fdata{file} = [$ffile, [map { int } @sfile]];
  $fdata{blur} = $fblur if $do_blur;
  $fdata{original} = $ofile;
  $fdata{$alg} = $digest;
  # 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) {
  $adata = process_images(@$aprops);
}
# sorting
if ($timesort) {
  $adata = [ sort { $a->{props}{stamp} <=> $b->{props}{stamp} } @$adata ];
  $adata = [ reverse @$adata ] if $revsort;
}
# create or update the album zip file
if ($nodown || $slim) {
  unlink $zipfile;
} else {
  if (@$adata) {
    my @f = map { catfile($absOut, $_->{file}[0]) } @$adata;
    # add files in batches in order to not exceed the command line length limit
    my $n = 200;
    for my $i (0 .. @f/$n) {
      my $m = $n;
      $m = @f % $n if $i >= int(@f/$n);
      last unless $m;
      my @g = @f[$i*$n .. $i*$n + $m - 1];
      if ($p7zip) {
        sys('7za', '-tzip', 'a', '--', $zipfile, @g);
      } else {
        sys('zip', '-q9j', $zipfile, @g);
      }
    }
    printf "Updated %s with %d image files\n", $zipfile, scalar @f;
  }
}
# 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) {
  my %data;
  for (qw(img thumb blur center original), $alg) {
    $data{$_} = $fdata->{$_} if defined $fdata->{$_};
  }
  for (qw(date stamp caption)) {
    $data{$_} = $fdata->{props}{$_} if defined $fdata->{props}{$_};
  }
  my $file = catfile($absOut, $fdata->{file}[0]);
  fatal("No such file '$file'") unless -f $file;
  fatal("Can't read file '$file'") unless -r _;
  push(@{$json{data}}, \%data);
  # remove superfluous raw files
  my $keep = !$slim && $include;
  unless ($slim || $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);
    say "Deleted superfluous raw file '$file'" if $verbose > 1;
  }
}
write_json(catfile($absOut, 'data.json'), \%json, $odata->{data});
# remove the files directory when empty
rmdir(catfile($absOut, 'files'));
# (re-)setup copy/link of view subdirectory
my $vdir = catfile($absOut, 'view');
unless (-d $vdir) {
  if ($copy_method eq 'sym') {
    symlink_r $viewdir, $vdir;
  } else {
    dircopy $viewdir, $vdir;
  }
}
# 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 = -1;
$adata = read_json($json_file);
for (@{$adata->{data}}) {
  my $c = (splitpath($_->{img}[0]))[2];
  $c = $_->{caption}[0] if exists $_->{caption};
  my $f = $_->{img}[0];
  my $t = $_->{thumb}[0];
  $id++;
  $html .= qq{\n\t  <a id="$id" href="$f" title="$c">}
         . qq{<img src="$t" alt="$c"/></a>};
}
$html .= qq{\n\t</div>\n};
$html .= qq{    </div>\n};
$html .= qq{    };
# read the template for the index.html file
my $indexhtml = read_text(catfile($absOut, '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}imgs/$galleryImage" />
  };
  $indexhtml =~ s@    <!-- for Facebook -->\n(    .*\n)*@@;
  $indexhtml =~ s@  </head>@$html  </head>@;
}
# unlink any existing index and write out the new index.html file
my $index = catfile($absOut, 'index.html');
unlink($index);
my $fd;
write_text($index, $indexhtml);
say "Wrote new $index";
print sprintf "%s version %s %s gallery in %s\n",
      $me, $VERSION, $updating ? 'updated' : 'created', $absOut;
exit 0;