#!/usr/bin/env perl # fgallery: a modern, minimalist javascript photo gallery # Copyright(c) 2011-2016 by wave++ "Yuri D'Elia" # Distributed under GPLv2+ (see COPYING) WITHOUT ANY WARRANTY. use v5.14; use strict; use warnings; use locale; use utf8; use if $^V lt v5.23.4, open => qw{:std :utf8}; use if $^V ge v5.23.4, open => qw{:std :locale}; require Encode; require encoding; use threads; use threads::shared; use Thread::Queue; use Storable qw{freeze thaw}; use Fcntl; use File::Basename qw{fileparse}; use File::Find qw{find}; use File::Path qw{make_path remove_tree}; use File::Spec::Functions qw{rel2abs}; use FindBin qw{$RealBin}; use Getopt::Long qw{:config bundling}; use IO::Handle; use Image::ExifTool qw{ImageInfo}; use Time::Piece; # We require either Cpanel::JSON::XS or JSON::PP (JSON::XS does not support ithreads) my $JSON_cls = eval { require Cpanel::JSON::XS; "Cpanel::JSON::XS"; } // eval { require JSON::PP; "JSON::PP"; } // fatal("either Cpanel::JSON::XS or JSON::PP is required"); $JSON_cls->import(qw{encode_json}); # constants our $VERSION = "1.8.2"; our $ENCODING = encoding::_get_locale_encoding() || 'UTF-8'; # defaults my $mode = 0644; my $slim = 0; my $ofile = 0; my $orient = 1; my $timesort = 1; my $revsort = 0; my @filetypes = ("JPEG", "PNG", "TIFF"); my @exts = ("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 $keeporig = 0; my $jpegoptim = 1; my $pngoptim = 1; my $p7zip = 1; my $verbose = 0; my $workers = 0; my $sRGB = 1; my $indexUrl = undef; my @capmethods = ("txt", "xmp", "exif"); # support functions sub fatal { print(STDERR "error: " . join(" ", @_) . "\n"); exit(1); } sub sys { my @cmd = @_; if($verbose) { print(STDERR "+ " . join(" ", @cmd) . "\n") } my $fd; unless(open($fd, '-|', @cmd)) { fatal("cannot execute \"$cmd[0]\""); } local $/ = undef; my $out = <$fd>; unless(close($fd)) { fatal("command \"@cmd\" failed"); } return split("\n", $out); } sub isin { my ($id, @arr) = @_; foreach my $c(@arr) { return 1 if $c eq $id; } return 0; } sub slurp { my ($fn) = @_; open(my $fd, '<', $fn) or fatal("cannot read $fn: $!"); if($^V lt v5.23.4) { binmode($fd, ":encoding($ENCODING)"); } local $/; return <$fd> // ""; } sub dispatch { my ($fun, @seq) = @_; my $workers = $workers || 1; my $queue = Thread::Queue->new(); for my $v(@seq) { $queue->enqueue($v); } my @threads; foreach my $n(1 .. $workers) { my $thr = threads->create(sub { while(defined(my $v = $queue->dequeue_nb())) { &$fun($v); } }); push(@threads, $thr); } foreach my $thr(@threads) { $thr->join(); } } sub par_map { my ($fun, @seq) = @_; my $n = @seq; my @idx = 0 .. $n - 1; my @res :shared = (undef) x $n; dispatch(sub { my $i = shift; my $r = &$fun($seq[$i]); $res[$i] = defined($r)? freeze($r): undef; }, @idx); return map { thaw $_ } @res; } sub min { my ($a, $b) = @_; return ($a < $b? $a: $b); } sub max { my ($a, $b) = @_; return ($a > $b? $a: $b); } sub clamp { my ($a, $b, $v) = @_; return ($v < $a? $a: $v > $b? $b: $v); } sub decode { return Encode::decode($ENCODING, shift // $_); } sub encode { return Encode::encode($ENCODING, shift // $_); } # thread-safe progress bar { package progress; my $act :shared; my $total :shared; my $cnt :shared; my $llen :shared; sub init { my ($_act, $_total) = @_; $act = $_act; $total = $_total; $cnt = 0; $llen = 0; print(pad($act . ' ...') . "\r"); STDOUT->flush(); } sub pad { my $str = shift; my $len = length($str); if($len < $llen) { $str .= " " x ($llen - $len); } $llen = $len; return $str; } sub status { my ($msg) = @_; lock($cnt); my $pc = ($cnt++ / $total * 100); my $str = sprintf("%s %2.0f%%", $act, $pc); if(defined($msg)) { $str .= ": " . $msg; } print(pad($str) . "\r"); STDOUT->flush(); } sub done { print(pad($act . ' completed') . "\n"); } } # caption utilities sub cap_clean_title { $_ = shift; s/^\s+|\s+$//g; s/\s+/ /g; return $_; } sub cap_clean_desc { $_ = shift; s/^\s+|\s+$//g; s/[ \t]+/ /g; return $_; } sub cap_from_str { my ($title, $desc) = split("\n", shift, 2); return undef if(!$title && !$desc); my $ret = [cap_clean_title($title), ($desc? cap_clean_desc($desc): '')]; return $ret; } sub cap_from_props { my ($props) = @_; my $ret = ['', '']; if($props->{'Title'}) { my $title = Encode::decode_utf8($props->{'Title'}); $ret->[0] = cap_clean_title($title); } if($props->{'Description'}) { my $desc = Encode::decode_utf8($props->{'Description'}); $ret->[1] = cap_clean_desc($desc); } return $ret; } # options sub parse_wh { my ($opt, $spec) = @_; my ($w, $h) = ($spec =~ /^(\d+)x(\d+)$/); unless(defined($w) && $w > 0 && defined($h) && $h > 0) { fatal("bad WxH specification in option $opt"); } return (int($w), int($h)); } sub parse_int { my ($opt, $value, $min, $max) = @_; if((defined($min) && $value < $min) || (defined($max) && $value > $max)) { fatal("bad value for option $opt"); } return int($value); } sub parse_cap { my ($opt, $value) = @_; return () if $value eq "none"; my @capmethods = split(",", $value); foreach my $m(@capmethods) { if(!isin($m, ("txt", "xmp", "exif", "cmt"))) { fatal("invalid caption extraction method: $m"); } } return @capmethods; } sub print_version { print("fgallery $VERSION\n"); exit(0); } sub print_help { print(STDERR qq{Usage: $0 [options] input-dir output-dir [album name] -h, --help this help --version output current fgallery version -v verbose (show commands as being executed) -s slim output (no original files and downloads) -i include individual originals -c methods caption extraction methods (txt,xmp,exif,cmt or none) -o do not auto-orient -k do not modify files, keep original -t do not time-sort -r reverse album order -p do not automatically include full-sized panoramas -d do not generate a full album download -f improve thumbnail cutting by performing face detection -j N set process-level parallelism --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) --index url specify the URL location for the index/back button }); exit(shift); } # main program @ARGV = map(decode, @ARGV); my ($ret, @ARGS) = GetOptions( 'help|h' => sub { print_help(0); }, 'version' => \&print_version, 'c=s' => sub { @capmethods = parse_cap($_[0], $_[1]); }, 'd' => sub { $nodown = 1; }, 'f' => sub { $facedet = 1; }, 'i' => sub { $ofile = 1; }, 'j=i' => sub { $workers = parse_int($_[0], $_[1], 1, undef); }, 'o' => sub { $orient = 0; }, 'k' => sub { $keeporig = 1; }, 'p' => sub { $fullpano = 0; }, 'r' => sub { $revsort = 1; }, 's' => sub { $slim = 1; }, 't' => sub { $timesort = 0; }, 'v' => sub { $verbose = 1; }, '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 = $_[1]; }); if(@ARGV < 2 || @ARGV > 3 || !$ret) { print_help(2); } my $dir = $ARGV[0]; my $out = $ARGV[1]; my $name = (@ARGV < 3? undef: $ARGV[2]); # check paths my $absDir = rel2abs($dir) . '/'; my $absOut = rel2abs($out) . '/'; if(!-d $dir) { fatal("input directory \"$dir\" 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 is a sub-directory of input, refusing to scan"); } elsif(!-d $out) { sys('cp', '-L', '-R', "$RealBin/view", $out); } elsif(!-f "$out/index.html") { fatal("output directory already exists, but doesn't look like a template copy"); } # check tools if(system("identify -version >/dev/null 2>&1") || system("convert -version >/dev/null 2>&1")) { fatal("cannot run \"identify\" or \"convert\" (check if ImageMagick is installed)"); } if(system("7za -h >/dev/null 2>&1")) { $p7zip = 0; if(system("zip -h >/dev/null 2>&1")) { fatal("cannot run \"zip\" (check if 7za or zip is installed)"); } } if(system("jpegoptim -V >/dev/null 2>&1")) { $jpegoptim = 0; } if(system("pngcrush -h >/dev/null 2>&1")) { $pngoptim = 0; } if($facedet && system("facedetect -h >/dev/null 2>&1")) { fatal("cannot run \"facedetect\" (see https://www.thregr.org/~wavexx/software/facedetect/)"); } my $tificccmd; if($sRGB) { if(!system("tificc >/dev/null 2>&1")) { $tificccmd = "tificc"; } elsif(!system("tificc2 >/dev/null 2>&1")) { $tificccmd = "tificc2"; } else { fatal("cannot run \"tificc\" or \"tificc2\" (check if liblcms2-utils is installed)"); } } my $exiftrancmd; if(!$keeporig && $orient) { if(!system("exiftran -h >/dev/null 2>&1")) { $exiftrancmd = ["exiftran", "-aip"]; } elsif(!system("exifautotran >/dev/null 2>&1")) { $exiftrancmd = ["exifautotran"]; } else { fatal("cannot execute exiftran or exifautotran for lossless JPEG autorotation"); } } # list available files my @files; find( { no_chdir => 1, wanted => sub { my $file = decode($_); return if(!-f $file); my ($base, undef, $suffix) = fileparse($file, qr/\.[^.]*$/); return if(length($suffix) < 2 || $base =~ /^\./); $suffix = lc(substr($suffix, 1)); if(isin($suffix, @exts)) { push(@files, $file); } } }, encode($dir)); @files = sort(@files); if(!@files) { fatal("no available files inside \"$dir\""); } # derived arguments my $backblur = int(($minthumb[0] + $minthumb[1]) / 2 * 0.1); my @backsize = (int($minthumb[0] * 4), int($minthumb[1] * 3)); # cleanup target paths for my $path("$out/thumbs", "$out/blurs", "$out/imgs", "$out/files") { remove_tree($path); make_path($path); } # disable sub-process parallelism when threading ourselves if($workers) { $ENV{MAGICK_THREAD_LIMIT} = 1; $ENV{OMP_NUM_THREADS} = 1; } # 1st pass: extract/prepare input file data sub analyze_file { my $file = shift; my ($base, $dir, $suffix) = fileparse($file, qr/\.[^.]*$/); $suffix = lc(substr($suffix, 1)); progress::status("$base.$suffix"); my $props = ImageInfo($file, {PrintConv => 0, Sort => 'File'}); unless(defined($props) && isin($props->{FileType}, @filetypes)) { return undef; } # sanitize file name my $sane = $base; $sane =~ s/[^\w\-]/_/gu; my $root = $sane; for(my $c = 0;; ++$c) { my $tmp = "$out/imgs/$root.$ext"; if(sysopen(my $fd, $tmp, O_WRONLY|O_CREAT|O_EXCL, $mode)) { close($fd); last; } $root = "${sane}_$c"; } $props->{file} = $file; $props->{root} = $root; $props->{suffix} = $suffix; # try to fetch the 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 foreach my $m(@capmethods) { 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 = "$dir$base.txt"; if(-f $txt) { $props->{'caption'} = cap_from_str(slurp($txt)); last; } } elsif($m eq "exif") { if($props->{'Title'} || $props->{'Description'}) { $props->{'caption'} = cap_from_props($props); last; } } elsif($m eq "xmp") { my $xmp = ImageInfo("$file.xmp", {PrintConv => 0, Sort => 'File'}); if(defined($xmp) && ($xmp->{'Title'} || $xmp->{'Description'})) { $props->{'caption'} = cap_from_props($xmp); last; } } } return $props; } progress::init("reading", scalar(@files)); my @aprops = par_map(\&analyze_file, @files); progress::done(); # remove unprocessable files for(my $n = 0; $n <= $#files;) { if(defined($aprops[$n])) { ++$n; next; } splice(@files, $n, 1); splice(@aprops, $n, 1); } # gather some statistics my $amp = 0; my $ostamp = 0; foreach my $props(@aprops) { # file timestamp my $idate = $props->{'DateTimeOriginal'} || $props->{'DateTime'} || ""; $idate =~ s/^\s+|\s+$//g; my $t = eval { Time::Piece->strptime($idate, "%Y:%m:%d %H:%M:%S"); }; if(!$t || !$t->epoch) { # no date available, cheat by using the previous timestamp $props->{stamp} = $ostamp = $ostamp + 1; } else { $props->{date} = $t->strftime("%Y-%m-%d %H:%M"); $props->{stamp} = $ostamp = $t->epoch; } # mp average $props->{mp} = ($props->{ImageWidth} * $props->{ImageHeight} / 1e6); $amp += $props->{mp}; } $amp /= @files; # 2nd pass: produce output files sub process_img { my %props = %{shift()}; my $root = $props{root}; my $suffix = $props{suffix}; my $file = $props{file}; # derived file names my $fbase = "$root.$ext"; my $ffile = "files/$root.$suffix"; my $fout = "$out/$ffile"; my $ftmp = "$out/$ffile.tmp"; my $fimg = "imgs/$fbase"; my $fthumb = "thumbs/$fbase"; my $fblur = "blurs/$fbase"; progress::status($fbase); # copy source file sys('cp', '-L', $file, $fout); chmod(0600, $fout); # apply lossless transforms if(!$keeporig) { if($orient && $props{FileType} eq "JPEG" && ($props{'Orientation'} // 0)) { sys(@$exiftrancmd, $fout); if(($props{'Orientation'} // 0) > 4) { ($props{ImageWidth}, $props{ImageHeight}) = ($props{ImageHeight}, $props{ImageWidth}); } } if($jpegoptim && $props{FileType} eq "JPEG") { sys('jpegoptim', '-q', $fout); } elsif($pngoptim && $props{FileType} eq "PNG") { sys('pngcrush', '-q', $fout, $ftmp); rename($ftmp, $fout); } } # final file mode chmod($mode, $fout); sys('touch', '-r', $file, $fout); # intermediate sRGB colorspace conversion if(!$sRGB || !defined($props{ProfileID}) || ($props{ColorSpace} // 65535) == 1 || ($props{DeviceModel} // '') eq 'sRGB') { $ftmp = $fout; } else { sys('convert', '-quiet', $fout, '-compress', 'LZW', '-type', 'truecolor', "tiff:$ftmp"); sys($tificccmd, '-t0', $ftmp, "$ftmp.tmp"); rename("$ftmp.tmp", $ftmp); } # avoid conversion to string my @minthumb = @minthumb; my @maxthumb = @maxthumb; my @backsize = @backsize; # generate main image my @sfile = ($props{ImageWidth}, $props{ImageHeight}); my @simg = sys('convert', '-quiet', $ftmp, '-gamma', '0.454545', '-geometry', "$maxfull[0]x$maxfull[1]>", '-print', '%w\n%h', '-gamma', '2.2', '+profile', '!icc,*', '-quality', $imgq, "$out/$fimg"); # face/center detection my @center = (0.5, 0.5); if($facedet) { if(my @faces = sys("facedetect", "--best", "--center", "$out/$fimg")) { my @tmp = split(" ", $faces[0]); @center = ($tmp[0] / $simg[0], $tmp[1] / $simg[1]); } } # 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 = clamp(0, $dx, int($center[0] * $sthumb[0] - $sthumb[0] / 2 + $dx / 2)); my $dy = $sthumb[1] - $mthumb[1]; my $cy = clamp(0, $dy, int($center[1] * $sthumb[1] - $sthumb[1] / 2 + $dy / 2)); sys('convert', '-quiet', $ftmp, '-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, "$out/$fthumb"); # blur sys('convert', '-quiet', "$out/$fthumb", '-virtual-pixel', 'Mirror', '-gaussian-blur', "0x$backblur", '-scale', "$backsize[0]x$backsize[1]", '-quality', '90', "$out/$fblur"); my %fdata; $fdata{props} = \%props; $fdata{img} = [$fimg, [map { int } @simg]]; $fdata{file} = [$ffile, [map { int } @sfile]]; $fdata{blur} = $fblur; # do not store 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 if($ftmp ne $fout) { unlink($ftmp); } return \%fdata; } progress::init("processing", scalar(@aprops)); my @adata = par_map(\&process_img, @aprops); progress::done(); # sorting if($timesort) { @adata = sort { $a->{props}{stamp} <=> $b->{props}{stamp}; } @adata; } if($revsort) { @adata = reverse @adata; } # generate zip file my $fdownload = undef; if(!$nodown && !$slim) { print("generating archive...\n"); $fdownload = "files/album.zip"; my @files = map { "$out/$_->{'file'}[0]" } @adata; if(!$p7zip) { sys('zip', '-q9j', "$out/$fdownload", @files); } else { # make paths explicitly absolute/relative to strip file path info with 7za my $dot = substr($out, 0, 1); if($dot ne '/' && $dot ne '.') { @files = map { "./$_" } @files; } my @mt = $workers? ("-mmt=$workers"): (); sys('7za', '-tzip', @mt, 'a', '--', "$out/$fdownload", @files); } } # remove unnecessary raw files if(!$ofile || $slim) { for my $fdata(@adata) { my $file = "$out/$fdata->{'file'}[0]"; my $keep = !$slim && $ofile; if(!$slim && !$keep && $fullpano) { my ($x, $y) = @{$fdata->{file}[1]}; my $mp = ($x * $y / 1e6); # try to 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); if($mp >= $omp && $mp > $amp && abs($x / $y) >= $panort) { $keep = 1; } } if(!$keep) { unlink($file); delete($fdata->{file}); } } } # only attempt to remove the directory (if empty) rmdir("$out/files"); # generate json my %json; $json{version} = $VERSION; $json{name} = $name if($name); $json{download} = $fdownload if($fdownload); $json{index} = $indexUrl if($indexUrl); $json{blur} = \@backsize; $json{thumb} = { min => \@minthumb, max => \@maxthumb }; foreach my $fdata(@adata) { my %data; foreach('img', 'thumb', 'file', 'blur', 'center') { if(defined($fdata->{$_})) { $data{$_} = $fdata->{$_}; } } foreach('date', 'stamp', 'caption') { if(defined($fdata->{props}{$_})) { $data{$_} = $fdata->{props}{$_}; } } push(@{$json{data}}, \%data); } my $fd; unless(open($fd, '>:raw', "$out/data.json")) { fatal("cannot write data file: $!"); } print($fd encode_json(\%json)); close($fd); print("completed\n");