tools/mkimgthumb

   1 #!/usr/bin/env perl
   2 use 5.014;
   3 use warnings;
   4 use lib $0 =~ s{[^/]+$}{..}r; # project root
   5 use Shiar_Sheet::ImagePrep '1.03';
   6
   7 my $failcount = 0;
   8
   9 for my $src (@ARGV) {
  10         my ($name, @cmds) = split /:(?<!\\:)/, $src =~ s/\.(\w+)\z//r;
  11         my $ext = $1 // '*';
  12         next if $name =~ m/\./;
  13         unless (-e $src) {
  14                 ($src) = grep {-e} glob qq<"$name"{,:*}.$ext> or next;
  15         }
  16         s/\\(.)/$1/g for @cmds;
  17         say $name;
  18
  19         if (@cmds and $cmds[0] =~ /^\d/) {
  20                 # crop shorthand from initial dimension argument
  21                 my @crop = split /\D/, shift @cmds;
  22                 unshift @cmds, -gravity => 'southeast', -chop => "$crop[2]%x$crop[3]%"
  23                         if @crop > 2;
  24                 unshift @cmds, -chop => "$crop[0]%x$crop[1]%";
  25         }
  26         push @cmds, -gravity => 'north';
  27         my @cmdwebp = (-resize => '630x420^', -extent => '630x420', -quality => 30);
  28         my @cmdjpeg = (-resize => '300x200^', -extent => '300x200');
  29         eval {
  30                 my $image = Shiar_Sheet::ImagePrep->new($src);
  31                 $image->convert("../$name.jpg",  [@cmds, @cmdjpeg]);
  32                 $image->convert("../$name.webp", [@cmds, @cmdwebp]);
  33         } or do {
  34                 warn "error creating image:\n";
  35                 warn ref $@ eq 'ARRAY' ? $@->[1] : $@ if $@;
  36                 $failcount++;
  37         };
  38 }
  39
  40 exit $failcount;