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         say $name;
  15
  16         if (@cmds and $cmds[0] =~ /^\d/) {
  17                 # crop shorthand from initial dimension argument
  18                 my @crop = split /\D/, shift @cmds;
  19                 unshift @cmds, -gravity => 'southeast', -chop => "$crop[2]%x$crop[3]%"
  20                         if @crop > 2;
  21                 unshift @cmds, -chop => "$crop[0]%x$crop[1]%";
  22         }
  23         unshift @cmds, -gravity => 'northwest' if @cmds;
  24         push @cmds, -resize => '300x200^', -gravity => 'north', -extent => '300x200';
  25         push @cmds, '-strip', -quality => '60%';
  26         system(convert => @cmds, $src => "../$name.jpg") == 0
  27                 or $failcount += warn "error creating $name.jpg from $src\n";
  28 }
  29
  30 exit $failcount;