[gimp-perl] Plugins return values; some tidying. Bug #726387
- From: Kevin Cozens <kcozens src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [gimp-perl] Plugins return values; some tidying. Bug #726387
- Date: Wed, 26 Mar 2014 18:40:19 +0000 (UTC)
commit 796fda86e101f00302fabd8bad0100478ec1ace9
Author: Ed J <m8r-35s8eo mailinator com>
Date: Sat Mar 15 03:01:24 2014 +0000
Plugins return values; some tidying. Bug #726387
Gimp.pm | 173 ++++++++---------
Gimp/Fu.pm | 66 ++++---
Gimp/Lib.pm | 2 +-
Gimp/Lib.xs | 602 +++++++++++++++++++++++++++++---------------------------
Net/Net.pm | 19 +--
t/perlplugin.t | 61 ++++++-
6 files changed, 485 insertions(+), 438 deletions(-)
---
diff --git a/Gimp.pm b/Gimp.pm
index 523d5ce..e00313f 100644
--- a/Gimp.pm
+++ b/Gimp.pm
@@ -441,62 +441,47 @@ unless($no_SIG) {
my %callback;
-sub cbchain($) {
- my $cb = shift;
- $callback{$cb} ? @{$callback{$cb}} : ();
+sub cbchain {
+ map { $callback{$_} ? @{$callback{$_}} : (); } @_;
}
sub callback {
- my $type = shift;
- my @cb;
- if ($type eq "-run") {
- local $function = shift;
- local $in_run = 1;
- _initialized_callback;
- {
- local $^W = 0;
- @cb = (
- @{$callback{run}},
- @{$callback{lib}},
- @{$callback{$function}},
- );
- }
- die_msg __"required callback 'run' not found\n" unless @cb;
- for (@cb) { &$_ }
- } elsif ($type eq "-net") {
- local $in_net = 1;
- _initialized_callback;
- {
- local $^W = 0;
- @cb = (
- @{$callback{run}},
- @{$callback{net}},
- @{$callback{$function}},
- );
- }
- die_msg __"required callback 'net' not found\n" unless @cb;
- for (@cb) { &$_ }
- } elsif ($type eq "-query") {
- local $in_query = 1;
- _initialized_callback;
- {
- local $^W = 0;
- @cb = (
- @{$callback{query}},
- );
- }
- die_msg __"required callback 'query' not found\n" unless @cb;
- for (@cb) { &$_ }
- } elsif ($type eq "-quit") {
- local $in_quit = 1;
- {
- local $^W = 0;
- @cb = (
- @{$callback{quit}},
- );
- }
- for (@cb) { &$_ }
- }
+ my $type = shift;
+ my @cb;
+ if ($type eq "-run") {
+ local $function = shift;
+ local $in_run = 1;
+ _initialized_callback;
+ @cb = cbchain(qw(run lib), $function);
+ die_msg __"required callback 'run' not found\n" unless @cb;
+ # returning list of last func's return values
+ my @retvals;
+ for (@cb) {
+ @retvals = &$_;
+ }
+ @retvals;
+ } elsif ($type eq "-net") {
+ local $in_net = 1;
+ _initialized_callback;
+ @cb = cbchain(qw(run net), $function);
+ die_msg __"required callback 'net' not found\n" unless @cb;
+ # returning list of last func's return values
+ my @retvals;
+ for (@cb) {
+ @retvals = &$_;
+ }
+ @retvals;
+ } elsif ($type eq "-query") {
+ local $in_query = 1;
+ _initialized_callback;
+ @cb = cbchain(qw(query));
+ die_msg __"required callback 'query' not found\n" unless @cb;
+ for (@cb) { &$_ }
+ } elsif ($type eq "-quit") {
+ local $in_quit = 1;
+ @cb = cbchain(qw(quit));
+ for (@cb) { &$_ }
+ }
}
sub register_callback($$) {
@@ -562,42 +547,42 @@ sub recroak($) {
}
sub AUTOLOAD {
- my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
- for(@{"$class\::PREFIXES"}) {
- my $sub = $_.$name;
- if (exists $ignore_function{$sub}) {
- *{$AUTOLOAD} = sub { () };
- goto &$AUTOLOAD;
- } elsif (UNIVERSAL::can(Gimp::Util,$sub)) {
- my $ref = \&{"Gimp::Util::$sub"};
- *{$AUTOLOAD} = sub {
- shift unless ref $_[0];
- #goto &$ref; # does not work, PERLBUG! #FIXME
- my @r = eval { &$ref };
- recroak $@ if $@; wantarray ? @r : $r[0];
- };
- goto &$AUTOLOAD;
- } elsif (UNIVERSAL::can($interface_pkg,$sub)) {
- my $ref = \&{"$interface_pkg\::$sub"};
- *{$AUTOLOAD} = sub {
- shift unless ref $_[0];
- #goto &$ref; # does not work, PERLBUG! #FIXME
- my @r = eval { &$ref };
- recroak $@ if $@; wantarray ? @r : $r[0];
- };
- goto &$AUTOLOAD;
- } elsif (gimp_procedural_db_proc_exists($sub)) {
- *{$AUTOLOAD} = sub {
- shift unless ref $_[0];
- unshift @_, $sub;
- #goto &gimp_call_procedure; # does not work, PERLBUG! #FIXME
- my @r = eval { gimp_call_procedure (@_) };
- recroak $@ if $@; wantarray ? @r : $r[0];
- };
- goto &$AUTOLOAD;
- }
- }
- croak __"function/macro \"$name\" not found in $class";
+ my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
+ for(@{"$class\::PREFIXES"}) {
+ my $sub = $_.$name;
+ if (exists $ignore_function{$sub}) {
+ *{$AUTOLOAD} = sub { () };
+ goto &$AUTOLOAD;
+ } elsif (UNIVERSAL::can(Gimp::Util,$sub)) {
+ my $ref = \&{"Gimp::Util::$sub"};
+ *{$AUTOLOAD} = sub {
+ shift unless ref $_[0];
+ #goto &$ref; # does not work, PERLBUG! #FIXME
+ my @r = eval { &$ref };
+ recroak $@ if $@; wantarray ? @r : $r[0];
+ };
+ goto &$AUTOLOAD;
+ } elsif (UNIVERSAL::can($interface_pkg,$sub)) {
+ my $ref = \&{"$interface_pkg\::$sub"};
+ *{$AUTOLOAD} = sub {
+ shift unless ref $_[0];
+ #goto &$ref; # does not work, PERLBUG! #FIXME
+ my @r = eval { &$ref };
+ recroak $@ if $@; wantarray ? @r : $r[0];
+ };
+ goto &$AUTOLOAD;
+ } elsif (gimp_procedural_db_proc_exists($sub)) {
+ *{$AUTOLOAD} = sub {
+ shift unless ref $_[0];
+ unshift @_, $sub;
+ #goto &gimp_call_procedure; # does not work, PERLBUG! #FIXME
+ my @r = eval { gimp_call_procedure (@_) };
+ recroak $@ if $@; wantarray ? @r : $r[0];
+ };
+ goto &$AUTOLOAD;
+ }
+ }
+ croak __"function/macro \"$name\" not found in $class";
}
sub _pseudoclass {
@@ -610,14 +595,14 @@ sub _pseudoclass {
}
_pseudoclass qw(Item gimp_item_);
-_pseudoclass qw(Layer gimp_item_ gimp_layer_ gimp_floating_sel_ gimp_image_ gimp_ plug_in_
perl_fu_);
-_pseudoclass qw(Image gimp_image_ gimp_item_ gimp_ plug_in_ perl_fu_);
-_pseudoclass qw(Drawable gimp_item_ gimp_layer_ gimp_channel_ gimp_image_ gimp_ plug_in_ perl_fu_);
+_pseudoclass qw(Layer gimp_layer_ gimp_drawable_ gimp_item_ gimp_floating_sel_ gimp_image_ gimp_
plug_in_ perl_fu_ gimp_drawable_);
+_pseudoclass qw(Image gimp_image_ gimp_ plug_in_ perl_fu_);
+_pseudoclass qw(Drawable gimp_drawable_ gimp_item_ gimp_channel_ gimp_image_ gimp_ plug_in_ perl_fu_);
_pseudoclass qw(Selection gimp_selection_);
_pseudoclass qw(Vectors gimp_vectors_);
-_pseudoclass qw(Channel gimp_channel_ gimp_item_ gimp_selection_ gimp_image_ gimp_ plug_in_
perl_fu_);
+_pseudoclass qw(Channel gimp_channel_ gimp_drawable_ gimp_item_ gimp_selection_ gimp_image_
gimp_ plug_in_ perl_fu_);
_pseudoclass qw(Display gimp_display_ gimp_);
-_pseudoclass qw(Plugin plug_in_);
+_pseudoclass qw(Plugin plug_in_ perl_fu_);
_pseudoclass qw(Gradient gimp_gradient_);
_pseudoclass qw(Gradients gimp_gradients_);
_pseudoclass qw(Edit gimp_edit_);
diff --git a/Gimp/Fu.pm b/Gimp/Fu.pm
index 2e93a86..a1005b6 100644
--- a/Gimp/Fu.pm
+++ b/Gimp/Fu.pm
@@ -362,11 +362,22 @@ Gimp::on_query {
undef $menupath unless Gimp::Feature::present('gtk');
}
- Gimp->gimp_install_procedure($function,$blurb,$help,$author,$copyright,$date,
- $menupath,$imagetypes,$type,
- [[Gimp::PDB_INT32,"run_mode","Interactive, [non-interactive]"],
- @$params],
- $results);
+ Gimp->install_procedure(
+ $function,
+ $blurb,
+ $help,
+ $author,
+ $copyright,
+ $date,
+ $menupath,
+ $imagetypes,
+ $type,
+ [
+ [Gimp::PDB_INT32, "run_mode", "Interactive, [non-interactive]"],
+ @$params,
+ ],
+ $results,
+ );
Gimp::logger(message => 'OK', function => $function, fatal => 0);
}
@@ -452,7 +463,8 @@ the parameter definitions used for C<gimp_install_procedure> but include an
additional B<default> value used when the caller doesn't supply one, and
optional extra arguments describing some types like C<PF_SLIDER>.
-Each array element has the form C<[type, name, description, default_value, extra_args]>.
+Each array element has the form C<[type, name, description, default_value,
+extra_args]>.
<Image>-type plugins get two additional parameters, image (C<PF_IMAGE>) and
drawable (C<PF_DRAWABLE>). Do not specify these yourself. Also, the
@@ -465,13 +477,8 @@ See the section PARAMETER TYPES for the supported types.
=item the return values
This is just like the parameter array except that it describes the return
-values. Of course, default values and the enhanced Gimp::Fu parameter
-types don't make much sense here. (Even if they did, it's not implemented
-anyway..). This argument is optional.
-
-If you supply a parameter type (e.g. C<PF_IMAGE>) instead of a full
-specification (C<[PF_IMAGE, ...]>), Gimp::Fu might supply some default
-values. This is only implemented for C<PF_IMAGE> at the moment.
+values. Specify the type and variable name only. This argument is optional
+- if unspecified, assumes return of an image.
=item the features requirements
@@ -544,7 +551,7 @@ to an array filled with C<Option-Name => Option-Value> pairs. Gimp::Fu
will then generate a horizontal frame with radio buttons, one for each
alternative. For example:
- [PF_RADIO, "direction", "the direction to move to", 5, [Left => 5, Right => 7]]]
+ [PF_RADIO, "direction", "direction to move to", 5, [Left => 5, Right => 7]]]
draws two buttons, when the first (the default, "Left") is activated, 5
will be returned. If the second is activated, 7 is returned.
@@ -613,9 +620,8 @@ documentation. If the named section is not found (or is empty, as in
"=pod()"), the full pod documentation is embedded.
Most of the mentioned arguments have default values (see THE REGISTER
-FUNCTION) that are used when the arguments are either undefined or empty
-strings, making the register call itself much shorter and, IMHO, more
-readable.
+FUNCTION) that are used when the arguments are undefined, making the
+register call itself much shorter.
=cut
@@ -659,8 +665,10 @@ sub register($$$$$$$$$;@) {
for my $p (@$params,@$results) {
next unless ref $p;
- int($p->[0]) eq $p->[0] or croak __"$function: argument/return value '$p->[1]' has illegal type
'$p->[0]'";
- $p->[1]=~/^[0-9a-z_]+$/ or carp __"$function: argument name '$p->[1]' contains illegal characters,
only 0-9, a-z and _ allowed";
+ croak __"$function: argument/return value '$p->[1]' has illegal type '$p->[0]'"
+ unless int($p->[0]) eq $p->[0];
+ carp __"$function: argument name '$p->[1]' contains illegal characters, only 0-9, a-z and _ allowed"
+ unless $p->[1]=~/^[0-9a-z_]+$/;
}
$function="perl_fu_".$function unless $function =~ /^(?:perl_fu_|extension_|plug_in_|file_)/ || $function
=~ s/^\+//;
@@ -675,13 +683,7 @@ sub register($$$$$$$$$;@) {
$run_mode = shift; # global!
my(@pre,@defaults,@lastvals,$input_image);
- if (@defaults) {
- for (0..$#{$params}) {
- $params->[$_]->[3]=$defaults[$_];
- }
- }
-
- # supplement default arguments
+ # set default arguments
for (0..$#{$params}) {
$_[$_]=$params->[$_]->[3] unless defined($_[$_]);
}
@@ -742,18 +744,18 @@ sub register($$$$$$$$$;@) {
print $function,"(",join(",",(@pre,@_)),")\n" if $Gimp::verbose;
Gimp::set_trace ($old_trace);
- my @imgs = &$code(@pre,@_);
+ my @retvals = $code->(@pre,@_);
$old_trace = Gimp::set_trace (0);
if ($menupath !~ /^<Load>\//) {
- if (@imgs) {
- for my $i (0..$#imgs) {
- my $img = $imgs[$i];
+ if (@retvals) {
+ for my $i (0..$#retvals) {
+ my $img = $retvals[$i];
next unless defined $img;
if (ref $img eq "Gimp::Image") {
if ($outputfile) {
my $path = sprintf $outputfile,$i;
- if ($#imgs and $path eq $outputfile) {
+ if ($#retvals and $path eq $outputfile) {
$path=~s/\.(?=[^.]*$)/$i./; # insert image number before last dot
}
print "saving image $path\n" if $Gimp::verbose;
@@ -771,7 +773,7 @@ sub register($$$$$$$$$;@) {
}
Gimp::set_trace ($old_trace);
- wantarray ? @imgs : $imgs[0];
+ wantarray ? @retvals : $retvals[0];
};
Gimp::register_callback($function,$perl_sub);
diff --git a/Gimp/Lib.pm b/Gimp/Lib.pm
index 9c28e4c..e4bcc27 100644
--- a/Gimp/Lib.pm
+++ b/Gimp/Lib.pm
@@ -61,7 +61,7 @@ sub _gimp_append_data($$) {
}
# convenience functions
-sub gimp_drawable_pixel_rgn($$$$$$) {
+sub gimp_gdrawable_pixel_rgn($$$$$$$) {
Gimp::gimp_pixel_rgn_init(@_);
}
diff --git a/Gimp/Lib.xs b/Gimp/Lib.xs
index 5ebd50e..8a378af 100644
--- a/Gimp/Lib.xs
+++ b/Gimp/Lib.xs
@@ -537,58 +537,50 @@ convert_array2paramdef (AV *av, GimpParamDef **res)
GimpParamDef *def = 0;
if (av_len (av) >= 0)
- for(;;)
- {
- int idx;
-
- for (idx = 0; idx <= av_len (av); idx++)
- {
- SV *sv = *av_fetch (av, idx, 0);
- SV *type = 0;
- SV *name = 0;
- SV *help = 0;
+ for(;;) {
+ int idx;
- if (SvROK (sv) && SvTYPE (SvRV (sv)) == SVt_PVAV)
- {
- AV *av = (AV *)SvRV(sv);
- SV **x;
+ for (idx = 0; idx <= av_len (av); idx++) {
+ SV *sv = *av_fetch (av, idx, 0);
+ SV *type = 0;
+ SV *name = 0;
+ SV *help = 0;
- if ((x = av_fetch (av, 0, 0))) type = *x;
- if ((x = av_fetch (av, 1, 0))) name = *x;
- if ((x = av_fetch (av, 2, 0))) help = *x;
- }
- else if (SvIOK(sv))
- type = sv;
+ if (SvROK (sv) && SvTYPE (SvRV (sv)) == SVt_PVAV) {
+ AV *av = (AV *)SvRV(sv);
+ SV **x;
+
+ if ((x = av_fetch (av, 0, 0))) type = *x;
+ if ((x = av_fetch (av, 1, 0))) name = *x;
+ if ((x = av_fetch (av, 2, 0))) help = *x;
+ } else if (SvIOK(sv))
+ type = sv;
+
+ if (type) {
+ if (def) {
+ if (is_array (SvIV (type))) {
+ def->type = GIMP_PDB_INT32;
+ def->name = "array_size";
+ def->description = "the size of the following array";
+ def++;
+ }
- if (type)
- {
- if (def)
- {
- if (is_array (SvIV (type)))
- {
- def->type = GIMP_PDB_INT32;
- def->name = "array_size";
- def->description = "the size of the following array";
- def++;
- }
-
- def->type = SvIV (type);
- def->name = name ? SvPV_nolen (name) : 0;
- def->description = help ? SvPV_nolen (help) : 0;
- def++;
- }
- else
- count += 1 + !!is_array (SvIV (type));
- }
- else
- croak (__("malformed paramdef, expected [PARAM_TYPE,\"NAME\",\"DESCRIPTION\"] or PARAM_TYPE"));
+ def->type = SvIV (type);
+ def->name = name ? SvPV_nolen (name) : 0;
+ def->description = help ? SvPV_nolen (help) : 0;
+ def++;
}
+ else
+ count += 1 + !!is_array (SvIV (type));
+ } else
+ croak (__("malformed paramdef, expected [PARAM_TYPE,\"NAME\",\"DESCRIPTION\"] or PARAM_TYPE"));
+ }
- if (def)
- break;
+ if (def)
+ break;
- *res = def = g_new (GimpParamDef, count);
- }
+ *res = def = g_new (GimpParamDef, count);
+ }
else
*res = 0;
@@ -717,27 +709,23 @@ canonicalize_colour (char *err, SV *sv, GimpRGB *c)
SPAGAIN;
sv = POPs;
- if (SvROK(sv))
- {
- if (SvTYPE(SvRV(sv)) == SVt_PVAV)
- {
- AV *av = (AV *)SvRV(sv);
-
- c->r = SvNV (*av_fetch (av, 0, 0));
- c->g = SvNV (*av_fetch (av, 1, 0));
- c->b = SvNV (*av_fetch (av, 2, 0));
-
- if (av_len(av) == 2)
- c->a = 1.0;
- else if (av_len(av) == 3)
- c->a = SvNV (*av_fetch (av, 3, 0));
- else
- sprintf (err, __("a color must have three (RGB) or four (RGBA) components (array elements)"));
- }
+ if (SvROK(sv)) {
+ if (SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ AV *av = (AV *)SvRV(sv);
+
+ c->r = SvNV (*av_fetch (av, 0, 0));
+ c->g = SvNV (*av_fetch (av, 1, 0));
+ c->b = SvNV (*av_fetch (av, 2, 0));
+
+ if (av_len(av) == 2)
+ c->a = 1.0;
+ else if (av_len(av) == 3)
+ c->a = SvNV (*av_fetch (av, 3, 0));
else
- sprintf (err, __("illegal type for colour specification"));
- }
- else
+ sprintf (err, __("a color must have three (RGB) or four (RGBA) components (array elements)"));
+ } else
+ sprintf (err, __("illegal type for colour specification"));
+ } else
sprintf (err, __("unable to grok colour specification"));
PUTBACK;
@@ -1146,119 +1134,119 @@ static void pii_run(const gchar *name,
GimpParamDef *params;
GimpParamDef *return_defs;
- if (return_vals) /* the libgimp is soooooooo braindamaged. */
- {
- destroy_params (return_vals, nreturn_vals);
- return_vals = 0;
- }
-
- if (gimp_procedural_db_proc_info (name, &proc_blurb, &proc_help, &proc_author,
- &proc_copyright, &proc_date, &proc_type, &_nparams, &nreturn_vals,
- ¶ms, &return_defs) == TRUE)
- {
- g_free (proc_blurb);
- g_free (proc_help);
- g_free (proc_author);
- g_free (proc_copyright);
- g_free (proc_date);
- gimp_destroy_paramdefs (params, _nparams);
-
- PUSHMARK(SP);
-
- EXTEND (SP, 3);
- PUSHs (sv_2mortal (newSVpv ("-run", 4)));
- PUSHs (sv_2mortal (newSVpv (name, 0)));
+ /* the libgimp is soooooooo braindamaged. */
+ if (return_vals) {
+ destroy_params (return_vals, nreturn_vals);
+ return_vals = 0;
+ }
- if (nparams)
- {
- EXTEND (SP, perl_param_count (param, nparams));
- PUTBACK;
- for (i = 0; i < nparams; i++)
- {
- if (i < nparams-1 && is_array (param[i+1].type))
- i++;
+ if (
+ gimp_procedural_db_proc_info (
+ name, &proc_blurb, &proc_help, &proc_author,
+ &proc_copyright, &proc_date, &proc_type, &_nparams, &nreturn_vals,
+ ¶ms, &return_defs
+ ) != TRUE
+ ) {
+ err_msg = g_strdup_printf (__("being called as '%s', but '%s' not registered in the pdb"), name, name);
+ goto error;
+ }
- push_gimp_sv (param+i, nparams > 2);
- }
+ g_free (proc_blurb);
+ g_free (proc_help);
+ g_free (proc_author);
+ g_free (proc_copyright);
+ g_free (proc_date);
+ gimp_destroy_paramdefs (params, _nparams);
- SPAGAIN;
- }
- else
- PUTBACK;
+ PUSHMARK(SP);
- count = perl_call_pv ("Gimp::callback", G_EVAL
- | (nreturn_vals == 0 ? G_VOID : nreturn_vals == 1 ? G_SCALAR : G_ARRAY));
- SPAGAIN;
+ EXTEND (SP, 3);
+ PUSHs (sv_2mortal (newSVpv ("-run", 4)));
+ PUSHs (sv_2mortal (newSVpv (name, 0)));
- if (SvTRUE (ERRSV))
- {
- if (strEQ ("IGNORE THIS MESSAGE\n", SvPV_nolen (ERRSV)))
- {
- nreturn_vals = 0;
- return_vals = g_new (GimpParam, 1);
- return_vals->type = GIMP_PDB_STATUS;
- return_vals->data.d_status = GIMP_PDB_SUCCESS;
- *xnreturn_vals = nreturn_vals+1;
- *xreturn_vals = return_vals;
- }
- else
- err_msg = g_strdup (SvPV_nolen (ERRSV));
- }
- else
- {
- int i;
- char errmsg [MAX_STRING];
- errmsg [0] = 0;
-
- return_vals = (GimpParam *) g_new0 (GimpParam, nreturn_vals+1);
- return_vals->type = GIMP_PDB_STATUS;
- return_vals->data.d_status = GIMP_PDB_SUCCESS;
- *xnreturn_vals = nreturn_vals+1;
- *xreturn_vals = return_vals++;
-
- for (i = nreturn_vals; i-- && count; )
- {
- return_vals[i].type = return_defs[i].type;
- if ((i >= nreturn_vals-1 || !is_array (return_defs[i+1].type))
- && convert_sv2gimp (errmsg, &return_vals[i], TOPs))
- {
- --count;
- (void) POPs;
- }
-
- if (errmsg [0])
- {
- err_msg = g_strdup (errmsg);
- break;
- }
- }
-
- if (count && !err_msg)
- err_msg = g_strdup_printf (__("plug-in returned %d more values than expected"), count);
- }
-
- gimp_destroy_paramdefs (return_defs, nreturn_vals);
+ if (nparams) {
+ EXTEND (SP, perl_param_count (param, nparams));
+ PUTBACK;
+ for (i = 0; i < nparams; i++) {
+ if (i < nparams-1 && is_array (param[i+1].type))
+ i++;
- PUTBACK;
+ push_gimp_sv (param+i, nparams > 2);
}
- else
- err_msg = g_strdup_printf (__("being called as '%s', but '%s' not registered in the pdb"), name, name);
- if (err_msg)
- {
- gimp_die_msg (err_msg);
- g_free (err_msg);
+ SPAGAIN;
+ } else
+ PUTBACK;
- if (return_vals)
- destroy_params (*xreturn_vals, nreturn_vals+1);
+ count = perl_call_pv (
+ "Gimp::callback",
+ G_EVAL | G_ARRAY
+ );
+ SPAGAIN;
+ if (SvTRUE (ERRSV)) {
+ if (strEQ ("IGNORE THIS MESSAGE\n", SvPV_nolen (ERRSV))) {
nreturn_vals = 0;
return_vals = g_new (GimpParam, 1);
return_vals->type = GIMP_PDB_STATUS;
- return_vals->data.d_status = GIMP_PDB_EXECUTION_ERROR;
+ return_vals->data.d_status = GIMP_PDB_SUCCESS;
*xnreturn_vals = nreturn_vals+1;
*xreturn_vals = return_vals;
+ } else
+ err_msg = g_strdup (SvPV_nolen (ERRSV));
+ } else {
+ int i;
+ char errmsg [MAX_STRING];
+ errmsg [0] = 0;
+
+ return_vals = (GimpParam *) g_new0 (GimpParam, nreturn_vals+1);
+ return_vals->type = GIMP_PDB_STATUS;
+ return_vals->data.d_status = GIMP_PDB_SUCCESS;
+ *xnreturn_vals = nreturn_vals+1;
+ *xreturn_vals = return_vals++;
+
+ for (i = nreturn_vals; i-- && count; ) {
+ return_vals[i].type = return_defs[i].type;
+ if (
+ (i >= nreturn_vals-1 || !is_array (return_defs[i+1].type)) &&
+ convert_sv2gimp (errmsg, &return_vals[i], TOPs)
+ ) {
+ --count;
+ (void) POPs;
+ }
+
+ if (errmsg [0]) {
+ err_msg = g_strdup (errmsg);
+ break;
+ }
}
+
+ /* shouldn't be fatal
+ if (count && !err_msg)
+ err_msg = g_strdup_printf (__("plug-in returned %d more values than expected"), count);
+ */
+ }
+
+ gimp_destroy_paramdefs (return_defs, nreturn_vals);
+
+ PUTBACK;
+
+ if (!err_msg)
+ return;
+
+ error:
+ gimp_die_msg (err_msg);
+ g_free (err_msg);
+
+ if (return_vals)
+ destroy_params (*xreturn_vals, nreturn_vals+1);
+
+ nreturn_vals = 0;
+ return_vals = g_new (GimpParam, 1);
+ return_vals->type = GIMP_PDB_STATUS;
+ return_vals->data.d_status = GIMP_PDB_EXECUTION_ERROR;
+ *xnreturn_vals = nreturn_vals+1;
+ *xreturn_vals = return_vals;
}
#define pii_init 0 /* init gets called on every startup, so disable it for the time being. */
@@ -1453,7 +1441,7 @@ PPCODE:
int nvalues;
GimpParamDef *params;
GimpParamDef *return_vals;
- int i=0, j=0; /* work around bogus warning. */
+ int i=0, j=0;
if (!gimp_is_initialized)
croak (__("gimp_call_procedure(%s,...) called without an active connection"), proc_name);
@@ -1469,162 +1457,188 @@ PPCODE:
proc_name, &proc_blurb, &proc_help, &proc_author,
&proc_copyright, &proc_date, &proc_type, &nparams, &nreturn_vals,
¶ms, &return_vals
- ) == TRUE
- ) {
- int runmode = nparams
- && params[0].type == GIMP_PDB_INT32
- && ( !strcmp (params[0].name, "run_mode") || !strcmp (params[0].name, "run-mode"));
- g_free (proc_blurb);
- g_free (proc_help);
- g_free (proc_author);
- g_free (proc_copyright);
- g_free (proc_date);
+ ) != TRUE
+ )
+ croak (__("gimp procedure '%s' not found"), proc_name);
- if (nparams)
- args = (GimpParam *) g_new0 (GimpParam, nparams);
-
- for (i = 0, j = 1; i < nparams && j < items; i++) {
- args[i].type = params[i].type;
- if (i == 0 && runmode) {
- /* If it's a valid value for the run mode, and # of parameters
- are correct we assume the user explicitly included the run
- mode parameter */
- if (
- nparams==(items-1) &&
- (SvIV(ST(j))==GIMP_RUN_INTERACTIVE || SvIV(ST(j))==GIMP_RUN_NONINTERACTIVE)
- ) {
- args->data.d_int32 = SvIV(ST(j));
- j++;
- } else {
- args->data.d_int32 = GIMP_RUN_NONINTERACTIVE;
- }
- } else if (
- (!SvROK(ST(j)) || i >= nparams-1 || !is_array (params[i+1].type)) &&
- convert_sv2gimp (croak_str, &args[i], ST(j))
+ int runmode = nparams
+ && params[0].type == GIMP_PDB_INT32
+ && ( !strcmp (params[0].name, "run_mode") || !strcmp (params[0].name, "run-mode"));
+ g_free (proc_blurb);
+ g_free (proc_help);
+ g_free (proc_author);
+ g_free (proc_copyright);
+ g_free (proc_date);
+
+ if (nparams)
+ args = (GimpParam *) g_new0 (GimpParam, nparams);
+
+ for (i = 0, j = 1; i < nparams && j < items; i++) {
+ args[i].type = params[i].type;
+ if (i == 0 && runmode) {
+ /* If it's a valid value for the run mode, and # of parameters
+ are correct we assume the user explicitly included the run
+ mode parameter */
+ if (
+ nparams==(items-1) &&
+ (SvIV(ST(j))==GIMP_RUN_INTERACTIVE || SvIV(ST(j))==GIMP_RUN_NONINTERACTIVE)
) {
+ args->data.d_int32 = SvIV(ST(j));
j++;
+ } else {
+ args->data.d_int32 = GIMP_RUN_NONINTERACTIVE;
}
+ } else if (
+ (!SvROK(ST(j)) || i >= nparams-1 || !is_array (params[i+1].type))
+ ) {
+ convert_sv2gimp(croak_str, &args[i], ST(j)) && j++;
+ }
- if (croak_str [0]) {
- if (trace & TRACE_CALL) {
- dump_params (i, args, params);
- trace_printf (__(" = [argument error]\n"));
- }
-
- goto error;
+ if (croak_str [0]) {
+ if (trace & TRACE_CALL) {
+ dump_params (i, args, params);
+ trace_printf (__(" = [argument error]\n"));
}
- }
- if (trace & TRACE_CALL) {
- dump_params (i, args, params);
- trace_printf (" = ");
+ goto error;
}
+ }
- if (i < nparams || j < items) {
- if (trace & TRACE_CALL)
- trace_printf (__("[unfinished]\n"));
+ if (trace & TRACE_CALL) {
+ dump_params (i, args, params);
+ trace_printf (" = ");
+ }
- sprintf(
- croak_str,
- __("%s arguments for function '%s', wanted %d, got %d"),
- i < nparams ? __("not enough") : __("too many"),
- proc_name,
- nparams,
- i
- );
+ if (i < nparams || j < items) {
+ if (trace & TRACE_CALL)
+ trace_printf (__("[unfinished]\n"));
- if (nparams)
- destroy_params (args, nparams);
- } else {
- values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
+ sprintf(
+ croak_str,
+ __("%s arguments for function '%s', wanted %d, got %d"),
+ i < nparams ? __("not enough") : __("too many"),
+ proc_name,
+ nparams,
+ i
+ );
- if (nparams)
- destroy_params (args, nparams);
+ if (nparams)
+ destroy_params (args, nparams);
+ } else {
+ values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
- if (trace & TRACE_CALL) {
- dump_params (nvalues-1, values+1, return_vals);
- trace_printf ("\n");
- }
+ if (nparams)
+ destroy_params (args, nparams);
- if (values && values[0].type == GIMP_PDB_STATUS) {
- if (values[0].data.d_status == GIMP_PDB_EXECUTION_ERROR)
- sprintf (croak_str, __("%s: procedural database execution failed"), proc_name);
- else if (values[0].data.d_status == GIMP_PDB_CALLING_ERROR)
- sprintf (croak_str, __("%s: procedural database execution failed on invalid input arguments"),
proc_name);
- else if (values[0].data.d_status == GIMP_PDB_SUCCESS) {
- EXTEND(SP, perl_paramdef_count (return_vals, nvalues-1));
- PUTBACK;
- for (i = 0; i < nvalues-1; i++) {
- if (i < nvalues-2 && is_array (values[i+2].type))
- i++;
-
- push_gimp_sv (values+i+1, nvalues > 2+1);
- }
+ if (trace & TRACE_CALL) {
+ dump_params (nvalues-1, values+1, return_vals);
+ trace_printf ("\n");
+ }
- SPAGAIN;
- } else
- sprintf (croak_str, __("unsupported status code: %d, fatal error\n"), values[0].data.d_status);
+ if (values && values[0].type == GIMP_PDB_STATUS) {
+ if (
+ values[0].data.d_status == GIMP_PDB_EXECUTION_ERROR ||
+ values[0].data.d_status == GIMP_PDB_CALLING_ERROR
+ )
+ sprintf (croak_str, __("%s: %s"), proc_name, gimp_get_pdb_error ());
+ else if (values[0].data.d_status == GIMP_PDB_SUCCESS) {
+ EXTEND(SP, perl_paramdef_count (return_vals, nvalues-1));
+ PUTBACK;
+ for (i = 0; i < nvalues-1; i++) {
+ if (i < nvalues-2 && is_array (values[i+2].type))
+ i++;
+
+ push_gimp_sv (values+i+1, nvalues > 2+1);
+ }
+
+ SPAGAIN;
} else
- sprintf (croak_str, __("gimp didn't return an execution status, fatal error"));
+ sprintf (croak_str, __("unsupported status code: %d, fatal error\n"), values[0].data.d_status);
+ } else
+ sprintf (croak_str, __("gimp didn't return an execution status, fatal error"));
- }
+ }
- error:
+ error:
- if (values)
- gimp_destroy_params (values, nreturn_vals);
+ if (values)
+ gimp_destroy_params (values, nreturn_vals);
- gimp_destroy_paramdefs (params, nparams);
- gimp_destroy_paramdefs (return_vals, nreturn_vals);
+ gimp_destroy_paramdefs (params, nparams);
+ gimp_destroy_paramdefs (return_vals, nreturn_vals);
- if (croak_str[0])
- croak (croak_str);
- } else
- croak (__("gimp procedure '%s' not found"), proc_name);
+ if (croak_str[0])
+ croak (croak_str);
}
void
gimp_install_procedure(name, blurb, help, author, copyright, date, menu_path, image_types, type, params,
return_vals)
- utf8_str name
- utf8_str blurb
- utf8_str help
- utf8_str author
- utf8_str copyright
- utf8_str date
- SV * menu_path
- SV * image_types
- int type
- SV * params
- SV * return_vals
- ALIAS:
- gimp_install_temp_proc = 1
- CODE:
- if (SvROK(params) && SvTYPE(SvRV(params)) == SVt_PVAV
- && SvROK(return_vals) && SvTYPE(SvRV(return_vals)) == SVt_PVAV)
- {
- GimpParamDef *apd; int nparams;
- GimpParamDef *rpd; int nreturn_vals;
-
- nparams = convert_array2paramdef ((AV *)SvRV(params) , &apd);
- nreturn_vals = convert_array2paramdef ((AV *)SvRV(return_vals), &rpd);
-
- if (ix)
- gimp_install_temp_proc(name,blurb,help,author,copyright,date,SvPv(menu_path),SvPv(image_types),
- type,nparams,nreturn_vals,apd,rpd,pii_run);
- else
- {
- gimp_plugin_domain_register ("gimp-perl", datadir "/locale");
-
-
gimp_install_procedure(name,blurb,help,author,copyright,date,SvPv(menu_path),SvPv(image_types),
- type,nparams,nreturn_vals,apd,rpd);
- }
-
- g_free (rpd);
- g_free (apd);
- }
- else
- croak (__("params and return_vals must be array refs (even if empty)!"));
+ utf8_str name
+ utf8_str blurb
+ utf8_str help
+ utf8_str author
+ utf8_str copyright
+ utf8_str date
+ SV * menu_path
+ SV * image_types
+ int type
+ SV * params
+ SV * return_vals
+ALIAS:
+ gimp_install_temp_proc = 1
+CODE:
+ if (
+ !(
+ SvROK(params) &&
+ SvTYPE(SvRV(params)) == SVt_PVAV &&
+ SvROK(return_vals) &&
+ SvTYPE(SvRV(return_vals)) == SVt_PVAV
+ )
+ )
+ croak (__("params and return_vals must be array refs (even if empty)!"));
+
+ GimpParamDef *apd; int nparams;
+ GimpParamDef *rpd; int nreturn_vals;
+ nparams = convert_array2paramdef ((AV *)SvRV(params) , &apd);
+ nreturn_vals = convert_array2paramdef ((AV *)SvRV(return_vals), &rpd);
+ if (ix)
+ gimp_install_temp_proc(
+ name,
+ blurb,
+ help,
+ author,
+ copyright,
+ date,
+ SvPv(menu_path),
+ SvPv(image_types),
+ type,
+ nparams,
+ nreturn_vals,
+ apd,
+ rpd,
+ pii_run
+ );
+ else {
+ gimp_plugin_domain_register ("gimp-perl", datadir "/locale");
+ gimp_install_procedure(
+ name,
+ blurb,
+ help,
+ author,
+ copyright,
+ date,
+ SvPv(menu_path),
+ SvPv(image_types),
+ type,
+ nparams,
+ nreturn_vals,
+ apd,
+ rpd
+ );
+ }
+ g_free (rpd);
+ g_free (apd);
void
gimp_uninstall_temp_proc(name)
diff --git a/Net/Net.pm b/Net/Net.pm
index fc9c76c..1abbec0 100644
--- a/Net/Net.pm
+++ b/Net/Net.pm
@@ -308,14 +308,14 @@ Gimp::Net - Communication module for the gimp-perl server.
=head1 DESCRIPTION
-For Gimp::Net (and thus commandline and remote scripts) to work, you first have to
-install the "Perl-Server" extension somewhere where Gimp can find it (e.g in
-your .gimp/plug-ins/ directory). Usually this is done automatically while installing
-the Gimp extension. If you have a menu entry C<<Xtns>/Perl-Server>
-then it is probably installed.
+For Gimp::Net (and thus commandline and remote scripts) to work, you
+first have to install the "Perl-Server" extension somewhere where Gimp
+can find it (e.g in your .gimp/plug-ins/ directory). Usually this is
+done automatically while installing the Gimp extension. If you have a
+menu entry C<<Xtns>/Perl-Server> then it is probably installed.
-The Perl-Server can either be started from the C<<Xtns>> menu in Gimp, or automatically
-when a perl script can't find a running Perl-Server.
+The Perl-Server can either be started from the C<<Xtns>> menu in Gimp,
+or automatically when a perl script can't find a running Perl-Server.
When started from within The Gimp, the Perl-Server will create a unix
domain socket to which local clients can connect. If an authorization
@@ -378,11 +378,6 @@ connection id as returned by get_connection().
=back
-=head1 BUGS
-
-(Ver 0.04) This module is much faster than it ought to be... Silly that I wondered
-wether I should implement it in perl or C, since perl is soo fast.
-
=head1 AUTHOR
Marc Lehmann <pcg goof com>
diff --git a/t/perlplugin.t b/t/perlplugin.t
index c34ffb5..185c0c3 100644
--- a/t/perlplugin.t
+++ b/t/perlplugin.t
@@ -1,5 +1,5 @@
use strict;
-use Test::More tests => 7;
+use Test::More;
#BEGIN { $Gimp::verbose = 1; }
use Gimp qw(:auto);
use Config;
@@ -14,14 +14,59 @@ die "write $plugin: $!" unless io($plugin)->print($Config{startperl}.<<'EOF');
use Gimp qw(:auto __ N_);
use Gimp::Fu;
+sub test_return_text {
+ my ($text) = @_;
+ return $text;
+}
+
+sub test_return_colour {
+ my ($colour) = @_;
+ return $colour;
+}
+
+# returns a value despite such not being declared
+# previously, excess returns were a fatal error, but none were ever returned
+# now not an error
sub test_perl_filter {
my ($i, $drawable, $text) = @_;
my $tl = $i->text_layer_new("hi", "Arial", 8, 3);
$i->insert_layer($tl, 0, 0);
- $tl->set_name('text layer');
+ $tl->set_name($text);
return $image;
}
+register "test_return_text",
+ "exercise gimp-perl filter returning text",
+ "exercise gimp-perl filter returning text",
+ "boilerplate id",
+ "boilerplate id",
+ "20140310",
+ N_"<None>",
+ "*",
+ [
+ [PF_STRING, "text", "Input text", 'default' ],
+ ],
+ [
+ [PF_STRING, "text", "Output text", ],
+ ],
+ \&test_return_text;
+
+register "test_return_colour",
+ "exercise gimp-perl filter returning color",
+ "exercise gimp-perl filter returning color",
+ "boilerplate id",
+ "boilerplate id",
+ "20140310",
+ N_"<None>",
+ "*",
+ [
+ [PF_COLOR, "colour", "Input colour", [ 5, 5, 5 ], ],
+ ],
+ [
+ [PF_COLOR, "colour", "Output colour", ],
+ ],
+ \&test_return_colour;
+
register "test_perl_filter",
"exercise gimp-perl for a filter",
"exercise gimp-perl for a filter",
@@ -31,7 +76,7 @@ register "test_perl_filter",
N_"<Image>/Filters",
"*",
[
- [PF_STRING, "text", "Text to put in layer", "hello"],
+ [PF_STRING, "text", "Text to name layer", "hello"],
],
\&test_perl_filter;
@@ -39,6 +84,7 @@ exit main;
EOF
die "chmod $plugin: $!" unless chmod 0700, $plugin;
+#Gimp::set_trace(TRACE_ALL);
Gimp::init("spawn/");
ok((my $i = Gimp::Image->new(10,10,RGB)), 'new image');
@@ -47,8 +93,13 @@ ok(
'make layer',
);
ok(!$i->insert_layer($l0,0,0), 'insert layer');
-ok(!$i->test_perl_filter(undef, 'text value'), 'call filter'); # 1st param drawable
+ok(!$i->test_perl_filter(undef, 'value'), 'call filter'); # 1st param drawable
my ($tl) = $i->get_layers;
-is('text layer', $tl->get_name, 'layer name');
+is('value', $tl->get_name, 'layer name');
+is(Gimp::Plugin->test_return_text('text'), 'text', 'call return text');
+is(Gimp::Plugin->test_return_text(undef), 'default', 'test default on plugin');
+ok((my $c = Gimp::Plugin->test_return_colour([6, 6, 6])), 'return colour');
ok(!$i->delete, 'remove image');
+
+done_testing;
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
