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 our $VERSION = '1.00';
   8
   9 my %opt;
  10
  11 if (@ARGV and $ARGV[0] =~ /^-/) {
  12         require Getopt::Long;
  13         Getopt::Long->import(qw( 2.33 :config gnu_getopt ));
  14         GetOptions(\%opt,
  15                 'jpg=s',
  16                 'webp=s',
  17         ) or exit 64;
  18 }
  19
  20 %opt or %opt = (
  21         jpg  => '300x200',
  22         webp => '630x420@30',
  23 );
  24
  25 my @ffs;
  26 for (keys %opt) {
  27         push @ffs, my $ff = [$_];
  28         my $r = $opt{$_};
  29         push @{$ff}, -quality => $1 if $r =~ s/@(\d+)//;
  30         push @{$ff}, -resize => "$r^", -extent => $r;
  31 }
  32
  33 my $failcount = 0;
  34
  35 for my $src (@ARGV) {
  36         my ($name, @cmds) = split /:(?<!\\:)/, $src =~ s/\.(\w+)\z//r;
  37         my $ext = $1 // '*';
  38         print $name;
  39         next if $name =~ m/\./;
  40         unless (-e $src) {
  41                 ($src) = grep {-e} glob qq<"$name"{,:*}.$ext> or next;
  42         }
  43         s/\\(.)/$1/g for @cmds;
  44         print ':';
  45
  46         if (@cmds and $cmds[0] =~ /^\d/) {
  47                 # crop shorthand from initial dimension argument
  48                 my @crop = split /\D/, shift @cmds;
  49                 unshift @cmds, -gravity => 'southeast', -chop => "$crop[2]%x$crop[3]%"
  50                         if @crop > 2;
  51                 unshift @cmds, -chop => "$crop[0]%x$crop[1]%";
  52         }
  53         push @cmds, -gravity => 'north';
  54         eval {
  55                 my $image = Shiar_Sheet::ImagePrep->new($src);
  56                 for (@ffs) {
  57                         my ($ff, @ffcmds) = @{$_};
  58                         print " $ff";
  59                         $image->convert("../$name.$ff", [@cmds, @ffcmds]);
  60                 }
  61                 1;
  62         } or do {
  63                 say ' FAILED';
  64                 warn ref $@ eq 'ARRAY' ? $@->[1] : $@ if $@;
  65                 $failcount++;
  66         };
  67 }
  68 continue {
  69         say '';
  70 }
  71
  72 exit $failcount;