#!/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>

=encoding utf8

=head1 NAME

Sitelen Mute - a static, minimalist photo gallery

=head1 SYNOPSIS

B<sitelen-mute> [B<OPTION> ...] I<SOURCE> I<DIRECTORY>

=head1 DESCRIPTION

B<Sitelen Mute> is a static photo gallery generator. It takes all the images it
can find in the source directory and writes a static gallery to the output
directory: scaled images, zipped originals, thumbnails, Javascript code for
navigation, and an HTML file. You can upload this to a simple web server.

B<-h>, B<--help> shows this help.

B<-v> increases the verbosity. Repeat for more detail.

B<-s> produces "slim" output: no original files or album to download. The
default is to create a zip file with all the originals in it. Creating a zip
files requires the C<zip> or C<7za> (7-Zip).

B<-i> include originals as individual files. The default is to create a just a
zip file with all the originals in it.

B<-d> skip creation of a full album zip file for download. Visitors can download
it by clicking the floppy icon with the downward arrow in the top left corner.

B<-c> I<METHODS> names the caption extraction methods, separated by commas.
Valid options are C<txt>, C<xmp>, C<exif>, C<cmt>, and C<none>. When multiple
methods are provided, the first available caption source is used. By default,
the method list is C<txt,xmp,exif>. You can disable caption extraction entirely
by using C<none>.

C<txt> reads the caption from a text file that has the same name as the image,
but with C<txt> extension (for example F<IMG1234.jpg> reads from
F<IMG1234.txt>). The first line of the file (which can be empty) constitutes the
title, with any following line becoming the description. These files can either
be written manually, or can be edited more conveniently using C<fcaption>. It
accepts a list of filenames or directories on the command line, and provides a
simple visual interface to quickly edit image captions in this format.

C<xmp> reads the caption from XMP sidecar metadata and C<exif> reads the caption
from EXIF metadata. Tools such as I<Darktable> or I<Geeqie> can write such
files. Use C<Ctrl+K> to bring up the metadata editor.

C<cmt> reads the caption from JPEG or PNG's built-in comment data. Both JPEG and
PNG have a built-in comment field, but it's not read by default as it's often
abused by editing software to put attribution or copyright information.

Captions can be controlled by the user using the speech bubble icon or by
pressing the C<c> keyboard shortcut, which cycles between normal, always hidden
and always shown visualisation modes.

B<-k> prevents the modification of the image files. The default is to
auto-orient images and to optimise JPEG and PNG files. Optimisation requires
C<jpegoptim> or C<pngcrush>.

B<-o> prevents auto-orientation of images. Lossless auto-orientation requires
one of C<exiftran> or C<exifautotran>.

B<-t> prevents sorting by time. Sorting by time is important if mixing the
pictures of multiple cameras.

B<-t> reverses the album order.

B<-p> prevents the inclusion of full-sized panoramas.

B<-n> I<NAME> sets the album name, i.e. the title in the browser window.

B<--index> I<URL> is the location for the index/back button.

The following three options add meta tags for previews on social media. They
must all three be specified, if at all.

B<--url> I<URL> is the eventual URL of the gallery. That is, you need to know
where you're uploading the gallery to.

B<--title> I<TITLE> is the title for previews on social media.

B<--description> I<DESCRIPTION> is the (longer) description to use for the
preview on social media.

B<-f> improves thumbnails by using face detection. This requires C<facedet>.

B<--noblur> skips the generation of blurry backdrops and simply uses dark noise
instead.

B<--max-full> I<WxH> specifies the maximum full image size (the default is
1600×1200).

B<--max-thumb> I<WxH> specifies the maximum thumbnail size (the default is
267×200).

B<--min-thumb> I<WxH> specifies the minimum thumbnail size (the default is
150×112).

B<--no-sRGB> prevents the remapping of previews and thumbnail colour profiles to
sRGB. The remapping requires C<tificc>.

B<--quality> I<Q> specifies the preview image quality (0-100, currently: 90).

B<--link-orig> I<method> specifies the copy method to use: one of C<copy>,
C<hard>, C<sym>, or C<ref>); the default is C<copy>. C<copy> uses regular C<cp>;
C<hard> uses hard links: C<cp --link>, or C<ln> on BSD; C<sym> uses symbolic
links: C<cp --symbolic-link>, or C<ln -s> on BSD; C<ref> uses lightweight copy,
where the data blocks are copied only when modified: C<cp --reflink>, and it is
not supported on BSD.

B<--viewdir> specifies the directory containing CSS/JavaScript that is copied
into the target directory.

B<--version> prints the version.

=head1 EXAMPLES

You can see example galleries at the following address:

https://alexschroeder.ch/gallery

Generate a simple gallery:

    sitelen-mute photo-dir my-gallery

To favour photos shot in portrait format, invert the
width/height of the thumbnail sizes:

  sitelen-mute --min-thumb 112x150 --max-thumb 200x267 \
     photo-dir my-gallery

This forces the thumbnails to always fit vertically, at the expense of a higher
horizontal thumbnail strip.

For a real world example including face detection and meta data for social
media, with the images stored in the F<Quito> directory and the gallery ending
up in F<2020-quito>:

    sitelen-mute -f --title "Quito 2020" \
      --description "On our way to the Galápagos we stopped for a few days in Quito, Ecuador." \
      --url https://alexschroeder.ch/gallery/2020-quito/ \
      Quito \
      2020-quito

=head1 TROUBLESHOOTING

This section talks about strange and weird problems and how to work around them.

=head2 cannot load gallery data

To test or preview the gallery locally, you might think that you can just open
the F<index.html> file of the gallery. Sadly, this is no longer the case for
security reasons (the "same-origin policy"; learn more about it on Wikipedia).

If you have Python installed, a quick way to test the gallery locally is to run
the following inside the gallery:

    python -m SimpleHTTPServer 8000

This serves all the files from C<http://localhost:8000>.

=head2 convert: width or height exceeds limit

An error message containing "convert-im6.q16: width or height exceeds limit" is
a sign that your ImageMagick installation has a security policy that prevents
"image bombs" – images that are so large that they could bomb your server if you
is using ImageMagick to process images uploaded from the Internet. If you a
I<sure> that you are not using ImageMagick in this way, here's a way to disable
this security policy.

You can show the limits using C<identify -list resource>:

    Resource limits:
      Width: 16KP
      Height: 16KP
      List length: 18.446744EP
      Area: 128MP
      Memory: 256MiB
      Map: 512MiB
      Disk: 1GiB
      File: 768
      Thread: 4
      Throttle: 0
      Time: unlimited

Compare this to the image using C<identify IMG_1234.JPG>. Clearly, this panorama
image is too big.

    IMG_1234.JPG JPEG 16382x3628 16382x3628+0+0 8-bit sRGB 25.6993MiB 0.000u 0:00.000

As root, you need to change the security policy of your installation
if you want to process such large panorama shots. Edit
F</etc/ImageMagick-6/policy.xml> and make the following change:

    62c62
    <   <policy domain="resource" name="width" value="16KP"/>
    ---
    >   <policy domain="resource" name="width" value="32KP"/>

=head1 FEATURES

There is no server-side processing, only static generation. The resulting
gallery can be uploaded anywhere without additional requirements and works with
any modern browser.

=over

=item Automatically orients pictures without quality loss.

=item Multi-camera friendly: automatically sorts pictures by time: just throw
  your (and your friends) photos and movies in a directory. The resulting
  gallery shows the pictures in seamless shooting order.

=item Adapts to the current screen size and proportions, switching from
  horizontal/vertical layout and scaling thumbnails automatically.

=item Supports face detection for improved thumbnail centring.

=item Loads fast! Especially over slow connections.

=item Images shown by the viewer are scaled, compressed, and stripped of EXIF
  tags for size

=item Includes original (raw) pictures in a zip file for downloading.

=item Panoramas can be seen full-size by default.

=back

=head1 COLOUR MANAGEMENT

Since every camera is different, and every monitor is different, some colour
transformation is necessary to reproduce the colours on your monitor as
*originally* captured by the camera. Colour management is an umbrella term for
all the techniques required to perform this task.

Most image-viewing software support colour management to some degree, but it's
rarely configured properly on most systems except for Safari on macOS. No other
browser, unfortunately, supports decent colour management.

This causes the familiar effect of looking at the same picture from your laptop
and your tablet, and noticing that the blue of the sky is just slightly off, or
that the contrast seems to be much higher on one screen as opposed to the other.
Often the image has the information required for a more balanced colour
reproduction, but the browser is just ignoring it.

Colour management has a considerable impact on image rendering performance, but
strictly speaking colour management doesn't need to be enabled on all images by
default. It would be perfectly fine to have an additional attribute on the image
tag to request colour management. The current method of enabling colour
management only on images with an ICC profile is clearly not adequate, since
images without a profile should be assumed to be in sRGB colour-space already.

Because of the general lack of colour management, *Sitelen Mute* transforms the
preview and thumbnail images from the built-in colour profile to the sRGB
colour-space by default. On most devices this will result in images appearing to
be *closer* to true colours with only minimal lack of absolute colour depth. As
usual, no transformation is done on the original downloadable files.

=head1 DEPENDENCIES

The viewer has no external dependencies. It's static HTML/CSS, and Javascript.

To resize images, C<convert> must be installed. It comes with I<ImageMagick>.

The remaining dependencies are optional. Sometimes you'll have to use certain
options work around missing dependencies.

To create the zip file: C<7za> (which comes with I<7-Zip>), or C<zip>.

To convert previews and thumbnails to the sRGB colour space: C<tificc> (which
comes with I<LittleCMS2>).

To auto-orient images: C<exiftran>, or C<exifautotran>.

To optimise JPEG file size: C<jpegoptim>.

To optimise PNG file size: C<pngcrush>.

To center thumbnails on faces: C<facedetect>.

On Debian or Ubuntu, you can all the dependencies with:

    sudo apt install \
      imagemagick p7zip liblcms2-utils exiftran \
      jpegoptim pngcrush facedetect

C<fcaption> is written in Python and requires either I<PyQT4> or I<PySide2>
(Qt5). On Debian or Ubuntu, you can it with:

    sudo apt install python-pyside2

=head1 ARCHITECTURE

I<Sitelen Mute> is composed of a backend (the F<sitelen-mute> script which
generates the gallery) and a viewer (which is copied into the F<view>
directory). The two are designed to be used independently.

The backend just cares about generating the image previews and the
album data. All the presentation logic however is inside the viewer.

It's relatively easy to generate the album data dynamically and just
use the viewer. This was Yuri D'Elia's aim when they started to develop
*fgallery*, as it's much easier to just modify an existing CMS instead
of trying to reinvent the wheel. All a backend has to do is provide a
valid "data.json" at some prefixed address.

The Gemini wiki C<phoebe> has an extension that acts as an independent viewer
for the data generated by the backend. Example:
L<gemini://alexschroeder.ch/do/gallery>.

=head1 TODO

Videos.

"Live" images as created by iPhones consisting of a JPEG cover image and a very
short video.

=head1 HISTORY

I<Sitelen Mute> grew out of I<fgallery> by Yuri D'Elia because the author said
that their mind is "on other projects".
L<https://github.com/wavexx/fgallery/pull/76#issuecomment-368947439>

=head1 LICENSE

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/>.

=cut

use Modern::Perl '2018';
use utf8;

our $VERSION = "3.0.0";

use Digest::SHA;
use Encode qw(decode 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] SOURCE DIRECTORY
  -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), cannot use -f"
  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;
if ($orient) {
  if (cmd_exists('exiftran')) { $exiftrancmd = "exiftran -aip" }
  elsif (cmd_exists('exifautotran')) { $exiftrancmd = "exifautotran" }
  else { fatal 'Missing exiftran or exifautotran executable for JPEG autorotation, use -o to skip' }
  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;
