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 => !/\dx\d+$/ ? $_ : ("$_^", -extent => $_)
  31                 for split / /, $r;
  32 }
  33
  34 my $target = '..';
  35 $target = pop @ARGV if @ARGV >= 2 and -d $ARGV[-1];
  36
  37 my $failcount = 0;
  38
  39 for my $src (@ARGV) {
  40         my ($name, @cmds) = split /:(?<!\\:)/, $src =~ s/\.(\w+)\z//r;
  41         my $ext = $1 // '*';
  42         print $name;
  43         next if $name =~ m/\./;
  44         unless (-e $src) {
  45                 ($src) = grep {-e} glob qq<"$name"{,:*}.$ext> or next;
  46         }
  47         s/\\(.)/$1/g for @cmds;
  48         print ':';
  49
  50         if (@cmds and $cmds[0] =~ /^\d/) {
  51                 # crop shorthand from initial dimension argument
  52                 my @crop = split /\D/, shift @cmds;
  53                 unshift @cmds, -gravity => 'southeast', -chop => "$crop[2]%x$crop[3]%"
  54                         if @crop > 2;
  55                 unshift @cmds, -chop => "$crop[0]%x$crop[1]%";
  56         }
  57         push @cmds, -gravity => 'north';
  58         eval {
  59                 my $image = Shiar_Sheet::ImagePrep->new($src);
  60                 for (@ffs) {
  61                         my ($ff, @ffcmds) = @{$_};
  62                         print " $ff";
  63                         $image->convert("$target/$name.$ff", [@cmds, @ffcmds]);
  64                 }
  65                 1;
  66         } or do {
  67                 say ' FAILED';
  68                 warn ref $@ eq 'ARRAY' ? $@->[1] : $@ if $@;
  69                 $failcount++;
  70         };
  71 }
  72 continue {
  73         say '';
  74 }
  75
  76 exit $failcount;