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, -resize => '300x200^', -gravity => 'north', -extent => '300x200';
  26         push @cmds, '-strip', -quality => '60%';
  27         system(convert => $src, @cmds, "../$name.jpg") == 0
  28                 or $failcount += warn "error creating $name.jpg from $src\n";
  29 }
  30
  31 exit $failcount;