[gimp-perl] Allow (and test) command-line running of multi-proc scripts.

[Ed J <edj src gnome org>]

commit 942acda071220deb29f4210dd102870886d00f18
Author: Ed J <edj src gnome org>
Date:   Thu May 15 07:59:31 2014 +0100

    Allow (and test) command-line running of multi-proc scripts.

 Gimp/Fu.pm    |   31 ++++++++++++++++++++-----------
 t/netplugin.t |   13 +++++++------
 2 files changed, 27 insertions(+), 17 deletions(-)
---
diff --git a/Gimp/Fu.pm b/Gimp/Fu.pm
index a0dc00d..5779ec7 100644
--- a/Gimp/Fu.pm
+++ b/Gimp/Fu.pm
@@ -126,19 +126,17 @@ sub interact {
    goto &Gimp::UI::interact;
 }
 
-sub this_script {
+sub find_script {
    return $scripts[0] if @scripts == 1;
-   # well, not-so-easy-day today
-   require File::Basename;
-   my ($exe) = File::Basename::fileparse($RealScript, qr/\.[^.]*/);
    my @names;
    for my $this (@scripts) {
       my $fun = $this->[0];
       $fun =~ s/^(?:perl_fu|plug_in)_//;
-      return $this if lc($exe) eq lc($fun);
-      push(@names,$fun);
+      return $this if lc($_[0] // '') eq lc($fun);
+      push @names, $fun;
    }
-   die __"function '$exe' not found in this script (must be one of ".join(", ",@names).")\n";
+   die "Must specify proc with -p flag (one of @names)\n" unless defined $_[0];
+   die __"function '$_[0]' not found in this script (must be one of @names)\n";
 }
 
 my ($latest_image, $latest_imagefile);
@@ -203,7 +201,11 @@ sub mangle_key {
 Gimp::on_net {
    *{Gimp::UI::export_image} = sub ($$$$) { &Gimp::EXPORT_IGNORE };
    require Getopt::Long;
-   my $this = this_script;
+   my $proc;
+   Getopt::Long::Configure('pass_through');
+   Getopt::Long::GetOptions('p=s' => \$proc);
+   Getopt::Long::Configure('default');
+   my $this = find_script($proc);
    my(%mangleparam2index,@args);
    my ($interact, $outputfile) = 1;
    my ($function,$blurb,$help,$author,$copyright,$date,
@@ -476,14 +478,21 @@ sub save_image($$) {
 
 sub main {
    return Gimp::main unless $Gimp::help;
-   my $this=this_script;
+   require Getopt::Long;
+   my $proc;
+   Getopt::Long::Configure('pass_through');
+   Getopt::Long::GetOptions('p=s' => \$proc);
+   my $this = defined($proc) ? find_script($proc) : undef;
    print __<<EOF;
        interface-arguments are
            -o | --output <filespec>   write image to disk
            -i | --interact            let the user edit the values first
 EOF
-   print "       script-arguments are\n" if @{$this->[9]};
-   for(@{$this->[9]}) {
+   print "           -p <procedure> (one of @{[
+      map { my $s = $_->[0]; $s =~ s/^(?:perl_fu|plug_in)_//; $s } @scripts
+   ]})\n" if @scripts > 1;
+   print "       script-arguments are\n" if @{($this // [])->[9] // []};
+   for(@{($this // [])->[9] // []}) {
       my $type=$pf2info{$_->[0]}->[0];
       my $key=mangle_key($_->[1]);
       my $default_text = defined $_->[3]
diff --git a/t/netplugin.t b/t/netplugin.t
index e6a75c7..54cac95 100644
--- a/t/netplugin.t
+++ b/t/netplugin.t
@@ -8,7 +8,8 @@ BEGIN {
   # most minimal and elegant would be to symlink sandbox gimp-dir's
   # plug-ins to our blib/plugins dir, but not portable to windows
   my $blibdir = 'blib/plugins';
-  my @plugins = map { "$blibdir/$_" } qw(dots glowing_steel map_to_gradient);
+  my @plugins = map { "$blibdir/$_" }
+    qw(dots glowing_steel map_to_gradient redeye);
   map {
     warn "inst $_\n" if $Gimp::verbose;
     write_plugin($DEBUG, $_, io($_)->all);
@@ -25,11 +26,10 @@ use Symbol 'gensym';
 use IO::Select; # needed because output can be big and it can block!
 #Gimp::set_trace(TRACE_ALL);
 
-our @testbench;
-our %proc2file;
+our (@testbench, %proc2file, %file2procs);
 require 't/examples-api.pl';
 
-my %plug2yes = map { ($_=>1) } qw(dots glowing_steel ); # map_to_gradient redeye
+my %plug2yes = map { ($_=>1) } qw(dots glowing_steel map_to_gradient red_eye);
 @testbench = grep { $plug2yes{$_->[0]} } @testbench;
 my @duptest = @{$testbench[0]};
 $duptest[3] = [ @{$duptest[3]} ]; # don't change original
@@ -49,6 +49,7 @@ for my $test (@testbench) {
   my $output = "$scratchdir/out.xcf";
   unshift @$actualparams, '--output', $output;
   unshift @$actualparams, '-v' if $Gimp::verbose;
+  unshift @$actualparams, '-p', $name if @{$file2procs{$proc2file{$name}}} > 1;
   my @perl = ($^X, '-Mblib');
 #use Data::Dumper;warn Dumper(Gimp->procedural_db_proc_info("perl_fu_$name"));
   my ($wtr, $rdr, $err, @outlines, @errlines) = (undef, undef, gensym);
@@ -66,8 +67,8 @@ for my $test (@testbench) {
       }
     }
   }
-  is(join('', @errlines), '', "$name error empty");
-  is(join('', @outlines), '', "$name output empty");
+  is(join('', @errlines), '', "$name stderr empty");
+  is(join('', @outlines), '', "$name stdout empty");
   waitpid($pid, 0);
   is($? >> 8, 0, "$file exit=0");
   ok(-f $output, "$file output exists");