1package Gimp::Extension;
2
3use strict;
4use Carp qw(croak carp);
5use base 'Exporter';
6use Gimp::Pod;
7require Gimp::Fu;
8use autodie;
9use Gtk2;
10
11# manual import
12sub __ ($) { goto &Gimp::__ }
13sub main { goto &Gimp::main; }
14
15our $VERSION = "2.33";
16our @EXPORT = qw(podregister main add_listener register_temp podregister_temp);
17
18# this is to avoid warnings from importing main etc from Gimp::Fu AND here
19sub import {
20   my $p = \%::;
21   $p = $p->{"${_}::"} for split /::/, caller;
22   map { delete $p->{$_} if defined &{caller."::$_"}; } @_ == 1 ? @EXPORT : @_;
23   __PACKAGE__->export_to_level(1, @_);
24}
25
26my $TP = 'TEMPORARY PROCEDURES';
27
28my @register_params;
29my @temp_procs;
30Gimp::on_query {
31   Gimp->install_procedure(Gimp::Fu::procinfo2installable(@register_params));
32};
33
34sub podregister (&) {
35   my @procinfo = fixup_args(('')x9, @_);
36   Gimp::register_callback $procinfo[0] => sub {
37      warn "$$-Gimp::Extension sub: $procinfo[0](@_)" if $Gimp::verbose >= 2;
38      for my $tp (@temp_procs) {
39	 my @tpinfo = (
40	    @{$tp}[0..2],
41	    @procinfo[3..5],
42	    @{$tp}[3,4],
43	    &Gimp::TEMPORARY,
44	    @{$tp}[5..7],
45	 );
46	 Gimp->install_temp_proc(Gimp::Fu::procinfo2installable(@tpinfo[0..10]));
47	 Gimp::register_callback
48	    $tpinfo[0] => Gimp::Fu::make_ui_closure(@tpinfo[0..7,9..11]);
49      }
50      Gimp::gtk_init;
51      Gimp->extension_ack;
52      Gimp->extension_enable;
53      Gimp::Fu::make_ui_closure(@procinfo)->(@_);
54   };
55   @register_params = (@procinfo[0..7], &Gimp::EXTENSION, @procinfo[8,9]);
56}
57
58sub add_listener {
59   my ($listen_socket, $handler, $on_accept) = @_;
60   Glib::IO->add_watch(fileno($listen_socket), 'in', sub {
61      my ($fd, $condition, $fh) = @_;
62      my $h = $fh->accept;
63      $on_accept->($h) if $on_accept;
64      $h->autoflush;
65      Glib::IO->add_watch(fileno($h), 'in', sub {
66	 my ($fd, $condition, $h) = @_;
67	 undef $h if not $handler->(@_);
68	 $h ? &Glib::SOURCE_CONTINUE : &Glib::SOURCE_REMOVE;
69      }, $h);
70      &Glib::SOURCE_CONTINUE;
71   }, $listen_socket);
72}
73
74sub register_temp ($$$$$$$&) { push @temp_procs, [ @_ ]; }
75sub podregister_temp {
76   my ($tfunction, $tcallback) = @_;
77   my $pod = Gimp::Pod->new;
78   my ($t) = grep { /^$tfunction\s*-/ } $pod->sections($TP);
79   croak "No POD found for temporary procedure '$tfunction'" unless $t;
80   my ($tblurb) = $t =~ m#$tfunction\s*-\s*(.*)#;
81   my $thelp = $pod->section($TP, $t);
82   my $tmenupath = $pod->section($TP, $t, 'SYNOPSIS');
83   my $timagetypes = $pod->section($TP, $t, 'IMAGE TYPES');
84   my $tparams =  $pod->section($TP, $t, 'PARAMETERS');
85   my $tretvals =  $pod->section($TP, $t, 'RETURN VALUES');
86   ($tfunction, $tmenupath, $timagetypes, $tparams, $tretvals) = (fixup_args(
87      $tfunction, ('fake') x 5, $tmenupath, $timagetypes,
88      ($tparams || '#'), ($tretvals || '#'), 1
89   ))[0, 6..9];
90   push @temp_procs, [
91      $tfunction, $tblurb, $thelp, $tmenupath, $timagetypes,
92      $tparams, $tretvals, $tcallback,
93   ];
94}
95
961;
97__END__
98
99=head1 NAME
100
101Gimp::Extension - Easy framework for Gimp-Perl extensions
102
103=head1 SYNOPSIS
104
105  use Gimp;
106  use Gimp::Fu; # necessary for variable insertion and param constants
107  use Gimp::Extension;
108  podregister {
109    # your code
110  };
111  exit main;
112  __END__
113  =head1 NAME
114
115  function_name - Short description of the function
116
117  =head1 SYNOPSIS
118
119  <Image>/Filters/Menu/Location...
120
121  =head1 DESCRIPTION
122
123  Longer description of the function...
124
125=head1 DESCRIPTION
126
127This module provides all the infrastructure you need to write Gimp-Perl
128extensions.
129
130Your main interface for using C<Gimp::Extension> is the C<podregister>
131function. This works in exactly the same way as L<Gimp::Fu/PODREGISTER>,
132including declaring/receiving your variables for you.
133
134Before control is passed to your function, these procedures are called:
135
136  Gimp::gtk_init; # sets up Gtk2, ready for event loop
137  Gimp->extension_ack; # GIMP hangs till this is called
138  Gimp->extension_enable; # adds an event handler in Glib mainloop for
139			  # GIMP messages
140
141Your function will then either proceed as if it were a plugin, or call
142the Glib/Gtk2 mainloop:
143
144  Gtk2->main;
145
146Values returned by your function will still be returned to a caller,
147as with a plugin.
148
149One benefit of being an extension vs a plugin is that you can keep
150running, installing temporary procedures which are called by the user.
151When they are called, the perl function you have registered will be
152called, possibly accessing your persistent data or at least benefiting
153from the fact that you have already started up.
154
155Another benefit is that you can respond to events outside of GIMP,
156such as network connections (this is how the Perl-Server is implemented).
157
158Additionally, if no parameters are specified, then the extension will
159be started as soon as GIMP starts up. Make sure you specify menupath
160<None>, so no parameters will be added for you.
161
162If you need to clean up on exit, just register a callback with
163C<Gimp::on_quit>. This is how C<Perl-Server> removes its Unix-domain
164socket on exit.
165
166=head1 FUNCTIONS AVAILABLE TO EXTENSIONS
167
168These are all exported by default.
169
170=head2 podregister
171
172As discussed above.
173
174=head2 add_listener
175
176This is a convenience wrapper around C<Glib::IO-E<gt>add_watch>. It
177takes parameters:
178
179=over 4
180
181=item $listen_socket
182
183This will be an L<IO::Socket> subclass object, a listener socket. When
184it becomes readable, its C<accept> method will be called.
185
186=item \&handler
187
188This mandatory parameter is a function that is installed as the new
189connection's Glib handler. Its parameters are: C<$fd, $condition, $fh> -
190in Glib terms, the file handle will be registered as the "data" parameter.
191When it returns false, the socket will be closed.
192
193=item \&on_accept
194
195This optional parameter will, if defined, be a function that is called
196one time with the new socket as a parameter, possibly logging and/or
197sending an initial message down that socket.
198
199=back
200
201=head2 podregister_temp
202
203  podregister_temp perl_fu_procname => sub {
204    ...
205  };
206
207  =head1 TEMPORARY PROCEDURES
208
209  =head2 procname - blurb
210
211  Longer help text.
212
213  =head3 SYNOPSIS
214
215  <Image>/File/Label...
216
217  =head3 PARAMETERS
218
219    # params...
220
221Registers a temporary procedure, reading from the POD the SYNOPSIS,
222PARAMETERS, RETURN VALUES, IMAGE TYPES, etc, as for L<Gimp::Fu>. As
223you can see above, the temporary procedure's relevant information is in
224similarly-named sections, but at level 2 or 3, not 1, within the
225suitably-named level 2 section. Unlike C<podregister>, it will not
226interpolate variables for you.
227
228=head2 register_temp
229
230This is a convenience wrapper around C<Gimp-E<gt>install_temp_proc>,
231supplying a number of parameters from information in the extension's
232POD. The registration will only happen when the extension's C<on_run>
233callback is called. It takes parameters:
234
235=over 4
236
237=item $proc_name
238
239The name of the new PDB procedure.
240
241=item $blurb
242
243=item $help
244
245=item $menupath
246
247=item $imagetypes
248
249=item $params
250
251=item $retvals
252
253All as per L<Gimp/Gimp-E<gt>install_procedure>.
254
255=item \&callback
256
257=back
258
259=head1 AUTHOR
260
261Ed J
262
263=head1 SEE ALSO
264
265perl(1), L<Gimp>, L<Gimp::Fu>.
266