GNOME.org
 

[gimp-perl] Make Gimp::Extension, first cut.

commit e9b05704e7c69bca5506b09a165457adcff3e37b
Author: Ed J <edj src gnome org>
Date:   Sat May 3 12:04:44 2014 +0100

    Make Gimp::Extension, first cut.

 Gimp/Extension.pm    |  129 ++++++++++++++++++++++++++++++++++++++++++++++++++
 MANIFEST             |    2 +
 Net/Net.pm           |    7 +--
 TODO                 |    3 +-
 examples/Perl-Server |   46 ++++++++++--------
 examples/blowinout   |    2 +-
 t/extension.t        |   67 ++++++++++++++++++++++++++
 7 files changed, 227 insertions(+), 29 deletions(-)
---
diff --git a/Gimp/Extension.pm b/Gimp/Extension.pm
new file mode 100644
index 0000000..a941eca
--- /dev/null
+++ b/Gimp/Extension.pm
@@ -0,0 +1,129 @@
+package Gimp::Extension;
+
+use strict;
+use Carp qw(croak carp);
+use base 'Exporter';
+use Filter::Simple;
+use Gimp::Pod;
+
+# manual import
+sub __ ($) { goto &Gimp::__ }
+sub main { goto &Gimp::main; }
+
+my $podreg_re = qr/(\bpodregister\s*{)/;
+FILTER {
+   return unless /$podreg_re/;
+   my $myline = make_arg_line(fixup_args(('') x 9, 1));
+   s/$podreg_re/$1\n$myline/;
+   warn __PACKAGE__."::FILTER: found: '$1'" if $Gimp::verbose;
+};
+
+our @EXPORT = qw(podregister main);
+
+my @register_params;
+Gimp::on_query {
+   Gimp->install_procedure(@register_params);
+};
+
+sub podregister (&) {
+   no strict 'refs';
+   my ($function, $blurb, $help, $author, $copyright, $date, $menupath,
+       $imagetypes, $params, $results, $code) = fixup_args(('')x9, @_);
+   for my $p (@$params,@$results) {
+      next unless ref $p;
+      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_]+$/;
+   }
+   Gimp::register_callback $function => sub {
+      warn "$$-Gimp::Extension sub: $function(@_)" if $Gimp::verbose;
+      Gimp::gtk_init;
+      Gimp->extension_ack;
+      Gimp->extension_enable;
+      goto &$code;
+   };
+   @register_params = (
+      $function, $blurb, $help, $author, $copyright, $date, $menupath,
+      $imagetypes, Gimp::EXTENSION, $params, $results
+   );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Gimp::Extension - Easy framework for Gimp-Perl extensions
+
+=head1 SYNOPSIS
+
+  use Gimp;
+  use Gimp::Extension;
+  podregister {
+    # your code
+  };
+  exit main;
+  __END__
+  =head1 NAME
+
+  function_name - Short description of the function
+
+  =head1 SYNOPSIS
+
+  <Image>/Filters/Menu/Location...
+
+  =head1 DESCRIPTION
+
+  Longer description of the function...
+
+=head1 DESCRIPTION
+
+This module provides all the infrastructure you need to write Gimp-Perl
+extensions.
+
+Your main interface for using C<Gimp::Extension> is the C<podregister>
+function. This works in exactly the same way as L<Gimp::Fu/PODREGISTER>,
+including declaring/receiving your variables for you.
+
+It is different in that parameters and return values are not added
+for you, and your function name will not be changed but passed to GIMP
+verbatim.
+
+Another difference is that the C<run_mode> is passed on to your function,
+rather than being stripped off as with Gimp::Fu.
+
+Finally, before control is passed to your function, these procedures are called:
+
+  Gimp::gtk_init; # sets up Gtk2, ready for event loop
+  Gimp->extension_ack; # GIMP hangs till this is called
+  Gimp->extension_enable; # adds an event handler in Glib mainloop for
+                         # GIMP messages
+
+Your function will then either proceed as if it were a plugin, or call
+the Glib/Gtk2 mainloop:
+
+  Gtk2->main;
+
+Values returned by your function will still be returned to a caller,
+as with a plugin.
+
+One benefit of being an extension vs a plugin is that you can keep
+running, installing temporary procedures which are called by the user.
+When they are called, the procedure you have registered will be
+called, possibly accessing your persistent data or at least benefiting
+from the fact that you have already started up.
+
+Another benefit is that you can respond to events outside of GIMP,
+such as network connections (this is how the Perl-Server is implemented).
+
+Additionally, if no parameters are specified, then the extension will
+be started as soon as GIMP starts up.
+
+=head1 AUTHOR
+
+Ed J
+
+=head1 SEE ALSO
+
+perl(1), L<Gimp>, L<Gimp::Fu>.
diff --git a/MANIFEST b/MANIFEST
index 965c0b7..01f5b69 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -15,6 +15,7 @@ Gimp/ColorDB.pm
 Gimp/Config.pm.in
 Gimp/Constant.pm
 Gimp/Data.pm
+Gimp/Extension.pm
 Gimp/Fu.pm
 Gimp/Lib.pm
 Gimp/Lib.xs
@@ -136,6 +137,7 @@ po/zh_CN.po
 po/zh_TW.po
 pxgettext
 t/examples-api.pl
+t/extension.t
 t/gimppod.t
 t/gimpsetup.pl
 t/import.t
diff --git a/Net/Net.pm b/Net/Net.pm
index c321318..2b4cae7 100644
--- a/Net/Net.pm
+++ b/Net/Net.pm
@@ -125,9 +125,7 @@ sub set_trace {
    $old_level;
 }
 
-our $PERLSERVERPROC = 'extension_perl_server';
-(my $PROC_SF = $PERLSERVERPROC) =~ s#_#-#g;
-our $PERLSERVERTYPE = Gimp::EXTENSION; # Gimp::PLUGIN
+my $PROC_SF = 'extension-perl-server';
 
 sub start_server {
    my $opt = shift;
@@ -429,9 +427,6 @@ sub setup_listen_tcp {
 
 sub perl_server_run {
   (my $run_mode, $ps_flags, my $extra, $Gimp::verbose) = @_;
-  Gimp::gtk_init;
-  Gimp->extension_ack;
-  Gimp->extension_enable;
   warn "$$-".__PACKAGE__."::perl_server_run(@_)\n" if $Gimp::verbose;
   if ($run_mode == &Gimp::RUN_NONINTERACTIVE) {
      if ($ps_flags & PS_FLAG_BATCH) {
diff --git a/TODO b/TODO
index 74324ef..ed843d5 100644
--- a/TODO
+++ b/TODO
@@ -1,9 +1,10 @@
 Items as of 2014-04-29 (by Ed J)
 * possible killer app: https://mail.gnome.org/archives/gimp-developer-list/2014-April/msg00017.html
-* plugin refresh: load is
+* gimp-plugins-refresh: load is
   app/plug-in/gimppluginmanager.c:gimp_plug_in_manager_query_new, closedown
   is ./app/plug-in/gimppluginmanager.c:gimp_plug_in_manager_exit
   - issue with removing menus, probably stored in _plug_in data
+  PDB call added in tools/pdbgen/pdb/gimp.pdb
 * <Load> and <Save> need any registration as such done in Gimp::Fu - see pod and e/dataurl
 * Gimp::Fu no -o needs give warning
 * Gimp::UI PF_IMAGE needs "open" button
diff --git a/examples/Perl-Server b/examples/Perl-Server
index 93e1c62..3aa4aef 100755
--- a/examples/Perl-Server
+++ b/examples/Perl-Server
@@ -4,46 +4,31 @@ use strict;
 #BEGIN { $Gimp::verbose = 1; }
 use Gimp qw(__ N_);
 use Gimp::Net ();
+use Gimp::Extension;
 
 N_"/Xtns/Perl"; # workaround for i18n weirdnesses
 
 Gimp::set_trace(\$Gimp::Net::trace_res);
 Gimp::ignore_functions(qw(gimp_progress_init gimp_progress_update));
 
-Gimp::on_run \&Gimp::Net::perl_server_run;
 Gimp::on_quit \&Gimp::Net::perl_server_quit;
-
-Gimp::on_query {
-   Gimp->install_procedure(
-      $Gimp::Net::PERLSERVERPROC, "Gimp-Perl scripts net server",
-      "Allow scripting GIMP with Perl providing Gimp::Net server",
-      "Marc Lehmann <pcg\ goof com>", "Marc Lehmann", "1999-12-02",
-      N_"<Image>/Filters/Languages/_Perl/_Server", undef,
-      $Gimp::Net::PERLSERVERTYPE,
-      [
-       [&Gimp::PDB_INT32, "run_mode", "Interactive, [non-interactive]"],
-       [&Gimp::PDB_INT32, "flags", "internal flags (must be 0)"],
-       [&Gimp::PDB_INT32, "extra", "multi-purpose"],
-       [&Gimp::PDB_INT32, "verbose", "Gimp verbose var"],
-      ],
-      [],
-   );
-};
+podregister \&Gimp::Net::perl_server_run;
 
 exit Gimp::main;
 __END__
 
 =head1 NAME
 
-Perl-Server - Enable Gimp-Perl scripts to access running GIMP instance
-via Gimp::Net
+extension_perl_server - Gimp-Perl scripts net server
 
 =head1 SYNOPSIS
 
-<Image>/Filters/Languages/Perl/Server
+<Image>/Filters/Languages/_Perl/_Server
 
 =head1 DESCRIPTION
 
+Allow scripting GIMP with Perl providing Gimp::Net server.
+
 If activated by the user, allows Gimp-Perl scripts to connect to the
 running GIMP instance. Also provides a working example of a GIMP extension
 in Gimp-Perl.
@@ -52,6 +37,25 @@ There is a security advisory about GIMP scripting servers. This program
 will only allow TCP connections if a password is specified (the "auth"
 option), thereby eliminating any network-related security risk.
 
+=head1 PARAMETERS
+
+ [&Gimp::PDB_INT32, "run_mode", "Interactive:0=yes,1=no"],
+ [&Gimp::PDB_INT32, "flags", "internal flags (must be 0)"],
+ [&Gimp::PDB_INT32, "extra", "multi-purpose"],
+ [&Gimp::PDB_INT32, "verbose", "Gimp verbose var"],
+
+=head1 AUTHOR
+
+Marc Lehmann <pcg goof com>
+
+=head1 DATE
+
+1999-12-02
+
+=head1 LICENSE
+
+Same terms as Gimp-Perl.
+
 =head1 SEE ALSO
 
 L<Gimp::Net>
diff --git a/examples/blowinout b/examples/blowinout
index 371db57..1831f0e 100755
--- a/examples/blowinout
+++ b/examples/blowinout
@@ -1,9 +1,9 @@
 #!/usr/bin/perl -w
 
+#BEGIN { $Gimp::verbose = 1; }
 use Gimp;
 use Gimp::Fu;
 use strict;
-
 # Gimp::set_trace(TRACE_CALL);
 
 podregister {
diff --git a/t/extension.t b/t/extension.t
new file mode 100644
index 0000000..1b3c354
--- /dev/null
+++ b/t/extension.t
@@ -0,0 +1,67 @@
+use strict;
+use Test::More;
+our ($dir, $DEBUG);
+my $tpf_name;
+BEGIN {
+#  $Gimp::verbose = 1;
+  $DEBUG = 0;
+  require 't/gimpsetup.pl';
+  use Config;
+  $tpf_name = "test_perl_extension";
+  write_plugin($DEBUG, $tpf_name, $Config{startperl}.
+    "\nBEGIN { \$Gimp::verbose = ".int($Gimp::verbose||0).'; }'.<<'EOF');
+
+use strict;
+use Gimp qw(:auto __ N_);
+use Gimp::Extension;
+
+podregister {
+  $num + 1;
+};
+
+exit main;
+__END__
+
+=head1 NAME
+
+extension_test - test Gimp::Extension
+
+=head1 SYNOPSIS
+
+<Image>/Filters/Languages/Perl/Test
+
+=head1 DESCRIPTION
+
+Description.
+
+=head1 PARAMETERS
+
+ [&Gimp::PDB_INT32, "run_mode", "Interactive:0=yes,1=no"],
+ [&Gimp::PDB_INT32, "num", "internal flags (must be 0)"],
+
+=head1 RETURN VALUES
+
+ [&Gimp::PDB_INT32, "retnum", "Number returned"],
+
+=head1 AUTHOR
+
+Author.
+
+=head1 DATE
+
+1999-12-02
+
+=head1 LICENSE
+
+Same terms as Gimp-Perl.
+EOF
+}
+use Gimp qw(:auto), "net_init=spawn/";
+#Gimp::set_trace(TRACE_ALL);
+
+is(Gimp::Plugin->extension_test(Gimp::RUN_NONINTERACTIVE, 7), 8, 'return val');
+
+Gimp::Net::server_quit;
+Gimp::Net::server_wait;
+
+done_testing;
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]