word/edit: move code to download and convert images

Generalise into ImagePrep class to allow external (re)setup.

diff --git a/Shiar_Sheet/ImagePrep.pm b/Shiar_Sheet/ImagePrep.pm
new file mode 100644 (file)
index 0000000..699d224
--- /dev/null
+++ b/Shiar_Sheet/ImagePrep.pm
@@ -0,0 +1,67 @@
+package Shiar_Sheet::ImagePrep;
+
+use 5.014;
+use warnings;
+
+our $VERSION = '1.00';
+
+sub new {
+       my ($class, $target) = @_;
+       bless \$target, $class;
+}
+
+sub download {
+       # copy changed remote url to local file
+       my $target = shift;
+       unlink $$target if -e $$target;
+       my $download = shift or return 1;
+       require LWP::UserAgent;
+       my $ua = LWP::UserAgent->new;
+       $ua->agent('/');
+       my $status = $ua->mirror($download, $$target);
+       $status->is_success
+               or die "Download from <q>$download</q> failed: ".$status->status_line."\n";
+}
+
+sub convert {
+       my ($imgpath, $thumbpath, $cmds) = @_;
+       if (not -e $$imgpath) {
+               return unlink $thumbpath;
+       }
+
+       my $xyres = 0 ? '600x400' : '300x200'; # cover
+       my @cmds = @{ $cmds // [] };
+       if (my ($cmdarg) = grep { $cmds[$_] eq '-area' } 0 .. $#cmds) {
+               # replace option by permillage crop
+               my @dim = map { $_ / 1000 } split /\D/, $cmds[$cmdarg + 1];
+               splice @cmds, $cmdarg, 2, (
+                       -set => 'option:distort:viewport' => sprintf(
+                               '%%[fx:w*%s]x%%[fx:h*%s]+%%[fx:w*%s]+%%[fx:h*%s]',
+                               ($dim[2] || 1) - $dim[0], # width  = x2 - x1
+                               ($dim[3] || 1) - $dim[1], # height = y2 - y1
+                               @dim[0, 1]                # offset = x1,y1
+                       ),
+                       -distort => SRT => 0, # noop transform to apply viewport
+               );
+       }
+       @cmds = (
+               'convert',
+               $$imgpath,
+               -delete => '1--1', -background => 'white',
+               -gravity => defined $cmds ? 'northwest' : 'center',
+               @cmds,
+               -resize => "$xyres^", -extent => $xyres,
+               '-strip', -quality => '60%', -interlace => 'plane',
+               $thumbpath
+       );
+
+       require IPC::Run;
+       my $output;
+       IPC::Run::run(\@cmds, '<' => \undef, '>&' => \$output) or die [
+               "Failed to convert source image.",
+               "@cmds\n" .
+               ($output || ($? & 127 ? "signal $?" : "error code ".($? >> 8))),
+       ];
+}
+
+1;

diff --git a/writer.plp b/writer.plp
index b5f503253887e3de1e744c31ece007506f420b39..fe538ddb5bbe4fc8145f531050084f9480f18541 100644 (file)
--- a/writer.plp
+++ b/writer.plp
@@ -188,67 +188,21 @@ elsif (defined $post{form}) {{
                return 1;
        } or Alert('Error creating translation entries', $@);
 
-       my $imgpath = $wordcol{source}->{-src}->($row);
+       require Shiar_Sheet::ImagePrep;
+       my $image = Shiar_Sheet::ImagePrep->new($wordcol{source}->{-src}->($row));
        my $reimage = eval {
                ($row->{source} // '') ne ($replace->{source} // '') or return;
-               # copy changed remote url to local file
-               unlink $imgpath if -e $imgpath;
-               my $download = $row->{source} or return 1;
-               require LWP::UserAgent;
-               my $ua = LWP::UserAgent->new;
-               $ua->agent('/');
-               my $status = $ua->mirror($download, $imgpath);
-               $status->is_success
-                       or die "Download from <q>$download</q> failed: ".$status->status_line."\n";
+               $image->download($row->{source});
        };
        !$@ or Alert(["Source image not found", $@]);
 
        $reimage ||= $row->{thumb} ~~ $replace->{thumb};  # different convert
        $reimage ||= $row->{cover} ~~ $replace->{cover};  # resize
        $reimage++ if $fields{rethumb};  # force refresh
-
        if ($reimage) {
-               my $thumbpath = $wordcol{thumb}->{-src}->($row);
-               if (-e $imgpath) {
-                       my $xyres = $row->{cover} ? '600x400' : '300x200';
-                       my @cmds = @{ $row->{thumb} // [] };
-                       if (my ($cmdarg) = grep { $cmds[$_] eq '-area' } 0 .. $#cmds) {
-                               # replace option by permillage crop
-                               my @dim = map { $_ / 1000 } split /\D/, $cmds[$cmdarg + 1];
-                               splice @cmds, $cmdarg, 2, (
-                                       -set => 'option:distort:viewport' => sprintf(
-                                               '%%[fx:w*%s]x%%[fx:h*%s]+%%[fx:w*%s]+%%[fx:h*%s]',
-                                               ($dim[2] || 1) - $dim[0], # width  = x2 - x1
-                                               ($dim[3] || 1) - $dim[1], # height = y2 - y1
-                                               @dim[0, 1]                # offset = x1,y1
-                                       ),
-                                       -distort => SRT => 0, # noop transform to apply viewport
-                               );
-                       }
-                       @cmds = (
-                               'convert',
-                               $imgpath,
-                               -delete => '1--1', -background => 'white',
-                               -gravity => defined $row->{thumb} ? 'northwest' : 'center',
-                               @cmds,
-                               -resize => "$xyres^", -extent => $xyres,
-                               '-strip', -quality => '60%', -interlace => 'plane',
-                               $thumbpath
-                       );
-                       eval {
-                               require IPC::Run;
-                               my $output;
-                               IPC::Run::run(\@cmds, '<' => \undef, '>&' => \$output)
-                                       or die $output ||
-                                               ($? & 127 ? "signal $?" : "error code ".($? >> 8))."\n";
-                       } or Alert([
-                               "Thumbnail image not generated",
-                               "Failed to convert source image.",
-                       ], "@cmds\n$@");
-               }
-               else {
-                       unlink $thumbpath;
-               }
+               eval {
+                       $image->convert($wordcol{thumb}->{-src}->($row), $row->{thumb});
+               } or Alert([ "Thumbnail image not generated", $@->[0] ], $@->[1]);
        }
 }}
 else {