png results from the CPAN

App-sitelenmute


=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

Generate a simple gallery:

script/sitelen-mute view on Meta::CPAN


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

=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 open ':std', ':encoding(utf8)';
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) {

script/sitelen-mute view on Meta::CPAN

  '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 { shift; $indexUrl = decode(locale => shift); },
  'title=s' => sub { shift; $galleryTitle = decode(locale => shift); },
  'description=s' => sub { shift; $galleryDescription = decode(locale => shift); },
  'url=s' => sub { shift; $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, decode_utf8($_)) } 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;

script/sitelen-mute view on Meta::CPAN

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,

( run in 1.175 second using v1.01-cache-2.11-cpan-2398b32b56e )