tools/mkimgthumb

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