Bug 15485: (QA followup) Fix behaviour and default values
[koha.git] / Koha / FrameworkPlugin.pm
1 package Koha::FrameworkPlugin;
2
3 # Copyright 2014 Rijksmuseum
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 3 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 =head1 NAME
21
22 Koha::FrameworkPlugin - Facilitate use of plugins in MARC/items editor
23
24 =head1 SYNOPSIS
25
26     use Koha::FrameworkPlugin;
27     my $plugin = Koha::FrameworkPlugin({ name => 'EXAMPLE.pl' });
28     $plugin->build( { id => $id });
29     $template->param(
30         javascript => $plugin->javascript,
31         noclick => $plugin->noclick,
32     );
33
34     use Koha::FrameworkPlugin;
35     my $plugin = Koha::FrameworkPlugin({ name => 'EXAMPLE.pl' });
36     $plugin->launch( { cgi => $query });
37
38 =head1 DESCRIPTION
39
40     A framework plugin provides additional functionality to a MARC or item
41     field. It can be attached to a field in the framework structure.
42     The functionality is twofold:
43     - Additional actions on the field via javascript in the editor itself
44       via events as onfocus, onblur, etc.
45       Focus may e.g. fill an empty field, Blur or Change may validate.
46     - Provide an additional form to edit the field value, possibly a
47       combination of various subvalues. Look at e.g. MARC leader.
48       The additional form is a popup on top of the MARC/items editor.
49
50     The plugin code is a perl script (with template for the popup),
51     essentially doing two things:
52     1) Build: The plugin returns javascript to the caller (addbiblio.pl a.o.)
53     2) Launch: The plugin launches the additional form (popup). Launching is
54        centralized via the plugin_launcher.pl script.
55
56     This object support two code styles:
57     - In the new style, the plugin returns a hashref with a builder and a
58       launcher key pointing to two anynomous subroutines.
59     - In the old style, the builder is subroutine plugin_javascript and the
60       launcher is subroutine plugin. For each plugin the routines are
61       redefined.
62
63     In cataloguing/value_builder/EXAMPLE.pl, you can find a detailed example
64     of a new style plugin. As long as we support the old style plugins, the
65     unit test t/db_dependent/FrameworkPlugin.t still contains an example
66     of the old style too.
67
68 =head1 METHODS
69
70 =head2 new
71
72     Create object (via Class::Accessor).
73
74 =head2 build
75
76     Build uses the builder subroutine of the plugin to build javascript
77     for the plugin.
78
79 =head2 launch
80
81     Run the popup of the plugin, as defined by the launcher subroutine.
82
83 =head1 PROPERTIES
84
85 =head2 name
86
87     Filename of the plugin.
88
89 =head2 path
90
91     Optional pathname of the plugin.
92     By default plugins are found in cataloguing/value_builder.
93
94 =head2 errstr
95
96     Error message.
97     If set, the plugin will no longer build or launch.
98
99 =head2 javascript
100
101     Generated javascript for the caller of the plugin (after building).
102
103 =head2 noclick
104
105     Tells you (after building) that this plugin has no action connected to
106     to clicking on the buttonDot anchor. (Note that some item plugins
107     redirect click to focus instead of launching a popup.)
108
109 =head1 ADDITIONAL COMMENTS
110
111 =cut
112
113 use Modern::Perl;
114
115 use base qw(Class::Accessor);
116
117 use C4::Context;
118 use C4::Biblio qw/GetMarcFromKohaField/;
119
120 __PACKAGE__->mk_ro_accessors( qw|
121     name path errstr javascript noclick
122 |);
123
124 =head2 new
125
126     Returns new object based on Class::Accessor, loads additional params.
127     The params hash currently supports keys: name, path, item_style.
128     Name is mandatory. Path is used in unit testing.
129     Item_style is used to identify old-style item plugins that still use
130     an additional (irrelevant) first parameter in the javascript event
131     functions.
132
133 =cut
134
135 sub new {
136     my ( $class, $params ) = @_;
137     my $self = $class->SUPER::new();
138     if( ref($params) eq 'HASH' ) {
139         foreach( 'name', 'path', 'item_style' ) {
140             $self->{$_} = $params->{$_};
141         }
142     }
143     elsif( !ref($params) && $params ) { # use it as plugin name
144         $self->{name} = $params;
145         if( $params =~ /^(.*)\/([^\/]+)$/ ) {
146             $self->{name} = $2;
147             $self->{path} = $1;
148         }
149     }
150     $self->_error( 'Plugin needs a name' ) if !$self->{name};
151     return $self;
152 }
153
154 =head2 build
155
156     Generate html and javascript by calling the builder sub of the plugin.
157
158     Params is a hashref supporting keys: id (=html id for the input field),
159     record (MARC record or undef), dbh (database handle), tagslib, tabloop.
160     Note that some of these parameters are not used in most (if not all)
161     plugins and may be obsoleted in the future (kept for now to provide
162     backward compatibility).
163     The most important one is id; it is used to construct unique javascript
164     function names.
165
166     Returns success or failure.
167
168 =cut
169
170 sub build {
171     my ( $self, $params ) = @_;
172     return if $self->{errstr};
173     return 1 if exists $self->{html}; # no rebuild
174
175     $self->_load if !$self->{_loaded};
176     return if $self->{errstr}; # load had error
177     return $self->_generate_js( $params );
178 }
179
180 =head2 launch
181
182     Launches the popup for this plugin by calling its launcher sub
183     Old style plugins still expect to receive a CGI oject, new style
184     plugins expect a params hashref.
185     Returns undef on failure, otherwise launcher return value (if any).
186
187 =cut
188
189 sub launch {
190     my ( $self, $params ) = @_;
191     return if $self->{errstr};
192
193     $self->_load if !$self->{_loaded};
194     return if $self->{errstr}; # load had error
195     return 1 if !exists $self->{launcher}; #just ignore this request
196     if( defined( &{$self->{launcher}} ) ) {
197         my $arg= $self->{oldschool}? $params->{cgi}: $params;
198         return &{$self->{launcher}}( $arg );
199     }
200     return $self->_error( 'No launcher sub defined' );
201 }
202
203 # **************  INTERNAL ROUTINES ********************************************
204
205 sub _error {
206     my ( $self, $info ) = @_;
207     $self->{errstr} = 'ERROR: Plugin '. ( $self->{name}//'' ). ': '. $info;
208     return; #always return false
209 }
210
211 sub _load {
212     my ( $self ) = @_;
213
214     my ( $rv, $file );
215     return $self->_error( 'Plugin needs a name' ) if !$self->{name}; #2chk
216     $self->{path} //= _valuebuilderpath();
217     $file= $self->{path}. '/'. $self->{name};
218     return $self->_error( 'File not found' ) if !-e $file;
219
220     # undefine oldschool subroutines before defining them again
221     undef &plugin_parameters;
222     undef &plugin_javascript;
223     undef &plugin;
224
225     $rv = do( $file );
226     return $self->_error( $@ ) if $@;
227
228     my $type = ref( $rv );
229     if( $type eq 'HASH' ) { # new style
230         $self->{oldschool} = 0;
231         if( exists $rv->{builder} && ref($rv->{builder}) eq 'CODE' ) {
232             $self->{builder} = $rv->{builder};
233         } elsif( exists $rv->{builder} ) {
234             return $self->_error( 'Builder sub is no coderef' );
235         }
236         if( exists $rv->{launcher} && ref($rv->{launcher}) eq 'CODE' ) {
237             $self->{launcher} = $rv->{launcher};
238         } elsif( exists $rv->{launcher} ) {
239             return $self->_error( 'Launcher sub is no coderef' );
240         }
241     } else { # old school
242         $self->{oldschool} = 1;
243         if( defined(&plugin_javascript) ) {
244             $self->{builder} = \&plugin_javascript;
245         }
246         if( defined(&plugin) ) {
247             $self->{launcher} = \&plugin;
248         }
249     }
250     if( !$self->{builder} && !$self->{launcher} ) {
251         return $self->_error( 'Plugin does not contain builder nor launcher' );
252     }
253     $self->{_loaded} = $self->{oldschool}? 0: 1;
254         # old style needs reload due to possible sub redefinition
255     return 1;
256 }
257
258 sub _valuebuilderpath {
259     return C4::Context->config('intranetdir') . "/cataloguing/value_builder";
260     #Formerly, intranetdir/cgi-bin was tested first.
261     #But the intranetdir from koha-conf already includes cgi-bin for
262     #package installs, single and standard installs.
263 }
264
265 sub _generate_js {
266     my ( $self, $params ) = @_;
267
268     my $sub = $self->{builder};
269     return 1 if !$sub;
270         #it is safe to assume here that we do have a launcher
271         #we assume that it is launched in an unorthodox fashion
272         #just useless to build, but no problem
273
274     if( !defined(&$sub) ) { # 2chk: if there is something, it should be code
275         return $self->_error( 'Builder sub not defined' );
276     }
277
278     my @params = $self->{oldschool}//0 ?
279         ( $params->{dbh}, $params->{record}, $params->{tagslib},
280             $params->{id}, $params->{tabloop} ):
281         ( $params );
282     my @rv = &$sub( @params );
283     return $self->_error( 'Builder sub failed: ' . $@ ) if $@;
284
285     my $arg= $self->{oldschool}? pop @rv: shift @rv;
286         #oldschool returns functionname and script; we only use the latter
287     if( $arg && $arg=~/^\s*\<script/ ) {
288         $self->_process_javascript( $params, $arg );
289         return 1; #so far, so good
290     }
291     return $self->_error( 'Builder sub returned bad value(s)' );
292 }
293
294 sub _process_javascript {
295     my ( $self, $params, $script ) = @_;
296
297     #remove the script tags; we add them again later
298     $script =~ s/\<script[^>]*\>\s*(\/\/\<!\[CDATA\[)?\s*//s;
299     $script =~ s/(\/\/\]\]\>\s*)?\<\/script\>//s;
300
301     my $id = $params->{id}//'';
302     my $bind = '';
303     my $clickfound = 0;
304     my @events = qw|click focus blur change mouseover mouseout mousedown
305         mouseup mousemove keydown keypress keyup|;
306     foreach my $ev ( @events ) {
307         my $scan = $ev eq 'click' && $self->{oldschool}? 'clic': $ev;
308         if( $script =~ /function\s+($scan\w+)\s*\(([^\)]*)\)/is ) {
309             my ( $bl, $sl ) = $self->_add_binding( $1, $2, $ev, $id );
310             $script .= $sl;
311             $bind .= $bl;
312             $clickfound = 1 if $ev eq 'click';
313         }
314     }
315     if( !$clickfound ) { # make buttonDot do nothing
316         my ( $bl ) = $self->_add_binding( 'noclick', '', 'click', $id );
317         $bind .= $bl;
318     }
319     $self->{noclick} = !$clickfound;
320     $self->{javascript}= _merge_script( $id, $script, $bind );
321 }
322
323 sub _add_binding {
324 # adds some jQuery code for event binding:
325 # $bind contains lines for the actual event binding: .click, .focus, etc.
326 # $script contains function definitions (if needed)
327     my ( $self, $fname, $pars, $ev, $id ) = @_;
328     my ( $bind, $script );
329     my $ctl= $ev eq 'click'? 'buttonDot_'.$id: $id;
330         #click event applies to buttonDot
331
332     if( $pars =~ /^(e|ev|event)$/i ) { # new style event handler assumed
333         $bind= qq|    \$("#$ctl").$ev(\{id: '$id'\}, $fname);\n|;
334         $script='';
335     } elsif( $fname eq 'noclick' ) { # no click: return false, no scroll
336         $bind= qq|    \$("#$ctl").$ev(function () { return false; });\n|;
337         $script='';
338     } else { # add real event handler calling the function found
339         $bind=qq|    \$("#$ctl").$ev(\{id: '$id'\}, ${fname}_handler);\n|;
340         $script = $self->_add_handler( $ev, $fname );
341     }
342     return ( $bind, $script );
343 }
344
345 sub _add_handler {
346 # adds a handler with event parameter
347 # event.data.id is passed to the plugin function in parameters
348 # for the click event we always return false to prevent scrolling
349     my ( $self, $ev, $fname ) = @_;
350     my $first= $self->_first_item_par( $ev );
351     my $prefix= $ev eq 'click'? '': 'return ';
352     my $suffix= $ev eq 'click'? "\n    return false;": '';
353     return <<HERE;
354 function ${fname}_handler(event) {
355     $prefix$fname(${first}event.data.id);$suffix
356 }
357 HERE
358 }
359
360 sub _first_item_par {
361     my ( $self, $event ) = @_;
362     # needed for backward compatibility
363     # js event functions in old style item plugins have an extra parameter
364     # BUT.. not for all events (exceptions provide employment :)
365     if( $self->{item_style} && $self->{oldschool} &&
366             $event=~/focus|blur|change/ ) {
367         return qq/'0',/;
368     }
369     return '';
370 }
371
372 sub _merge_script {
373 # Combine script and event bindings, enclosed in script tags.
374 # The BindEvents function is added to easily repeat event binding;
375 # this is used in additem.js for dynamically created item blocks.
376     my ( $id, $script, $bind ) = @_;
377     chomp ($script, $bind);
378     return <<HERE;
379 <script type="text/javascript">
380 //<![CDATA[
381 $script
382 function BindEvents$id() {
383 $bind
384 }
385 \$(document).ready(function() {
386     BindEvents$id();
387 });
388 //]]>
389 </script>
390 HERE
391 }
392
393 =head1 AUTHOR
394
395     Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
396
397 =cut
398
399 1;