view release on metacpan or  search on metacpan

script/sitelen-mute  view on Meta::CPAN

  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 { shift; $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 { 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';