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