Bug 10480: New module and unit test for framework plugins

This patch introduces the Koha::FrameworkPlugin object to Koha.
This object supports the current "old-style" plugins while adding a new
style based on the concept of two anynomous subroutines for building and
launching.

I will summarize the advantages of this new approach, justifying the
additional lines of code in this patch:

[1] Centralizing the code for building and launching plugins.
[2] Extensive unit testing: this was not possible before.
[3] Simplicity: Only define what you need in the plugin.
    A follow-up patch will delete 1500 lines with *empty* routines.
[4] Make it possible to restore the warnings pragma for all plugins.
    New style plugins do no longer depend on redefinition.
[5] Event binding moved from HTML attributes moved to jQuery code.
    This separates behavior and presentation.
[6] Much more documentation, including EXAMPLE plugin in follow-up.
[7] Improved error handling.
[8] Usability: property noclick tells you if plugin's buttonDot is active.
[9] More events supported: Change, keyboard/mouse events. See EXAMPLE.

NOTE ON EXAMPLE PLUGIN:
The example plugin is added in the third patch of this report. Since
it is new style, it can be used only after we start using this object. It
also contains an example for a keypress and mouseover event.

NOTE ON ITEM PLUGINS:
Old style plugins for items contain an additional parameter in the js
functions for Blur, Focus and Change. This distinction has no actual use
and is resolved for new plugins in the object code. When converting
item plugins, this minor correction will be addressed. In the meantime
old style item plugins behave as expected.

TEST PLAN:
Run the new test t/db_dependent/FrameworkPlugin.t
At this point in time, you do not need to do anything more. Follow-up
patches will incorporate the object in real-life Koha and provide
additional test plans.

Signed-off-by: Brendan Gallagher <brendan@bywatersolutions.com>

Signed-off-by: Jonathan Druart <jonathan.druart@biblibre.com>

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@gmail.com>

Koha/FrameworkPlugin.pm

@@ -0,0 +1,399 @@
+package Koha::FrameworkPlugin;
+
+# Copyright 2014 Rijksmuseum
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 3 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+=head1 NAME
+
+Koha::FrameworkPlugin - Facilitate use of plugins in MARC/items editor
+
+=head1 SYNOPSIS
+
+    use Koha::FrameworkPlugin;
+    my $plugin = Koha::FrameworkPlugin({ name => 'EXAMPLE.pl' });
+    $plugin->build( { id => $id });
+    $template->param(
+        javascript => $plugin->javascript,
+        noclick => $plugin->noclick,
+    );
+
+    use Koha::FrameworkPlugin;
+    my $plugin = Koha::FrameworkPlugin({ name => 'EXAMPLE.pl' });
+    $plugin->launch( { cgi => $query });
+
+=head1 DESCRIPTION
+
+    A framework plugin provides additional functionality to a MARC or item
+    field. It can be attached to a field in the framework structure.
+    The functionality is twofold:
+    - Additional actions on the field via javascript in the editor itself
+      via events as onfocus, onblur, etc.
+      Focus may e.g. fill an empty field, Blur or Change may validate.
+    - Provide an additional form to edit the field value, possibly a
+      combination of various subvalues. Look at e.g. MARC leader.
+      The additional form is a popup on top of the MARC/items editor.
+
+    The plugin code is a perl script (with template for the popup),
+    essentially doing two things:
+    1) Build: The plugin returns javascript to the caller (addbiblio.pl a.o.)
+    2) Launch: The plugin launches the additional form (popup). Launching is
+       centralized via the plugin_launcher.pl script.
+
+    This object support two code styles:
+    - In the new style, the plugin returns a hashref with a builder and a
+      launcher key pointing to two anynomous subroutines.
+    - In the old style, the builder is subroutine plugin_javascript and the
+      launcher is subroutine plugin. For each plugin the routines are
+      redefined.
+
+    In cataloguing/value_builder/EXAMPLE.pl, you can find a detailed example
+    of a new style plugin. As long as we support the old style plugins, the
+    unit test t/db_dependent/FrameworkPlugin.t still contains an example
+    of the old style too.
+
+=head1 METHODS
+
+=head2 new
+
+    Create object (via Class::Accessor).
+
+=head2 build
+
+    Build uses the builder subroutine of the plugin to build javascript
+    for the plugin.
+
+=head2 launch
+
+    Run the popup of the plugin, as defined by the launcher subroutine.
+
+=head1 PROPERTIES
+
+=head2 name
+
+    Filename of the plugin.
+
+=head2 path
+
+    Optional pathname of the plugin.
+    By default plugins are found in cataloguing/value_builder.
+
+=head2 errstr
+
+    Error message.
+    If set, the plugin will no longer build or launch.
+
+=head2 javascript
+
+    Generated javascript for the caller of the plugin (after building).
+
+=head2 noclick
+
+    Tells you (after building) that this plugin has no action connected to
+    to clicking on the buttonDot anchor. (Note that some item plugins
+    redirect click to focus instead of launching a popup.)
+
+=head1 ADDITIONAL COMMENTS
+
+=cut
+
+use Modern::Perl;
+
+use base qw(Class::Accessor);
+
+use C4::Context;
+use C4::Biblio qw/GetMarcFromKohaField/;
+
+__PACKAGE__->mk_ro_accessors( qw|
+    name path errstr javascript noclick
+|);
+
+=head2 new
+
+    Returns new object based on Class::Accessor, loads additional params.
+    The params hash currently supports keys: name, path, item_style.
+    Name is mandatory. Path is used in unit testing.
+    Item_style is used to identify old-style item plugins that still use
+    an additional (irrelevant) first parameter in the javascript event
+    functions.
+
+=cut
+
+sub new {
+    my ( $class, $params ) = @_;
+    my $self = $class->SUPER::new();
+    if( ref($params) eq 'HASH' ) {
+        foreach( 'name', 'path', 'item_style' ) {
+            $self->{$_} = $params->{$_};
+        }
+    }
+    elsif( !ref($params) && $params ) { # use it as plugin name
+        $self->{name} = $params;
+        if( $params =~ /^(.*)\/([^\/]+)$/ ) {
+            $self->{name} = $2;
+            $self->{path} = $1;
+        }
+    }
+    $self->_error( 'Plugin needs a name' ) if !$self->{name};
+    return $self;
+}
+
+=head2 build
+
+    Generate html and javascript by calling the builder sub of the plugin.
+
+    Params is a hashref supporting keys: id (=html id for the input field),
+    record (MARC record or undef), dbh (database handle), tagslib, tabloop.
+    Note that some of these parameters are not used in most (if not all)
+    plugins and may be obsoleted in the future (kept for now to provide
+    backward compatibility).
+    The most important one is id; it is used to construct unique javascript
+    function names.
+
+    Returns success or failure.
+
+=cut
+
+sub build {
+    my ( $self, $params ) = @_;
+    return if $self->{errstr};
+    return 1 if exists $self->{html}; # no rebuild
+
+    $self->_load if !$self->{_loaded};
+    return if $self->{errstr}; # load had error
+    return $self->_generate_js( $params );
+}
+
+=head2 launch
+
+    Launches the popup for this plugin by calling its launcher sub
+    Old style plugins still expect to receive a CGI oject, new style
+    plugins expect a params hashref.
+    Returns undef on failure, otherwise launcher return value (if any).
+
+=cut
+
+sub launch {
+    my ( $self, $params ) = @_;
+    return if $self->{errstr};
+
+    $self->_load if !$self->{_loaded};
+    return if $self->{errstr}; # load had error
+    return 1 if !exists $self->{launcher}; #just ignore this request
+    if( defined( &{$self->{launcher}} ) ) {
+        my $arg= $self->{oldschool}? $params->{cgi}: $params;
+        return &{$self->{launcher}}( $arg );
+    }
+    return $self->_error( 'No launcher sub defined' );
+}
+
+# **************  INTERNAL ROUTINES ********************************************
+
+sub _error {
+    my ( $self, $info ) = @_;
+    $self->{errstr} = 'ERROR: Plugin '. ( $self->{name}//'' ). ': '. $info;
+    return; #always return false
+}
+
+sub _load {
+    my ( $self ) = @_;
+
+    my ( $rv, $file );
+    return $self->_error( 'Plugin needs a name' ) if !$self->{name}; #2chk
+    $self->{path} //= _valuebuilderpath();
+    $file= $self->{path}. '/'. $self->{name};
+    return $self->_error( 'File not found' ) if !-e $file;
+
+    # undefine oldschool subroutines before defining them again
+    undef &plugin_parameters;
+    undef &plugin_javascript;
+    undef &plugin;
+
+    $rv = do( $file );
+    return $self->_error( $@ ) if $@;
+
+    my $type = ref( $rv );
+    if( $type eq 'HASH' ) { # new style
+        $self->{oldschool} = 0;
+        if( exists $rv->{builder} && ref($rv->{builder}) eq 'CODE' ) {
+            $self->{builder} = $rv->{builder};
+        } elsif( exists $rv->{builder} ) {
+            return $self->_error( 'Builder sub is no coderef' );
+        }
+        if( exists $rv->{launcher} && ref($rv->{launcher}) eq 'CODE' ) {
+            $self->{launcher} = $rv->{launcher};
+        } elsif( exists $rv->{launcher} ) {
+            return $self->_error( 'Launcher sub is no coderef' );
+        }
+    } else { # old school
+        $self->{oldschool} = 1;
+        if( defined(&plugin_javascript) ) {
+            $self->{builder} = \&plugin_javascript;
+        }
+        if( defined(&plugin) ) {
+            $self->{launcher} = \&plugin;
+        }
+    }
+    if( !$self->{builder} && !$self->{launcher} ) {
+        return $self->_error( 'Plugin does not contain builder nor launcher' );
+    }
+    $self->{_loaded} = $self->{oldschool}? 0: 1;
+        # old style needs reload due to possible sub redefinition
+    return 1;
+}
+
+sub _valuebuilderpath {
+    return C4::Context->intranetdir . "/cataloguing/value_builder";
+    #Formerly, intranetdir/cgi-bin was tested first.
+    #But the intranetdir from koha-conf already includes cgi-bin for
+    #package installs, single and standard installs.
+}
+
+sub _generate_js {
+    my ( $self, $params ) = @_;
+
+    my $sub = $self->{builder};
+    return 1 if !$sub;
+        #it is safe to assume here that we do have a launcher
+        #we assume that it is launched in an unorthodox fashion
+        #just useless to build, but no problem
+
+    if( !defined(&$sub) ) { # 2chk: if there is something, it should be code
+        return $self->_error( 'Builder sub not defined' );
+    }
+
+    my @params = $self->{oldschool}//0 ?
+        ( $params->{dbh}, $params->{record}, $params->{tagslib},
+            $params->{id}, $params->{tabloop} ):
+        ( $params );
+    my @rv = &$sub( @params );
+    return $self->_error( 'Builder sub failed: ' . $@ ) if $@;
+
+    my $arg= $self->{oldschool}? pop @rv: shift @rv;
+        #oldschool returns functionname and script; we only use the latter
+    if( $arg && $arg=~/^\s*\<script/ ) {
+        $self->_process_javascript( $params, $arg );
+        return 1; #so far, so good
+    }
+    return $self->_error( 'Builder sub returned bad value(s)' );
+}
+
+sub _process_javascript {
+    my ( $self, $params, $script ) = @_;
+
+    #remove the script tags; we add them again later
+    $script =~ s/\<script[^>]*\>\s*(\/\/\<!\[CDATA\[)?\s*//s;
+    $script =~ s/(\/\/\]\]\>\s*)?\<\/script\>//s;
+
+    my $id = $params->{id}//'';
+    my $bind = '';
+    my $clickfound = 0;
+    my @events = qw|click focus blur change mouseover mouseout mousedown
+        mouseup mousemove keydown keypress keyup|;
+    foreach my $ev ( @events ) {
+        my $scan = $ev eq 'click' && $self->{oldschool}? 'clic': $ev;
+        if( $script =~ /function\s+($scan\w+)\s*\(([^\)]*)\)/is ) {
+            my ( $bl, $sl ) = $self->_add_binding( $1, $2, $ev, $id );
+            $script .= $sl;
+            $bind .= $bl;
+            $clickfound = 1 if $ev eq 'click';
+        }
+    }
+    if( !$clickfound ) { # make buttonDot do nothing
+        my ( $bl ) = $self->_add_binding( 'noclick', '', 'click', $id );
+        $bind .= $bl;
+    }
+    $self->{noclick} = !$clickfound;
+    $self->{javascript}= _merge_script( $id, $script, $bind );
+}
+
+sub _add_binding {
+# adds some jQuery code for event binding:
+# $bind contains lines for the actual event binding: .click, .focus, etc.
+# $script contains function definitions (if needed)
+    my ( $self, $fname, $pars, $ev, $id ) = @_;
+    my ( $bind, $script );
+    my $ctl= $ev eq 'click'? 'buttonDot_'.$id: $id;
+        #click event applies to buttonDot
+
+    if( $pars =~ /^(e|ev|event)$/i ) { # new style event handler assumed
+        $bind= qq|    \$("#$ctl").$ev(\{id: '$id'\}, $fname);\n|;
+        $script='';
+    } elsif( $fname eq 'noclick' ) { # no click: return false, no scroll
+        $bind= qq|    \$("#$ctl").$ev(function () { return false; });\n|;
+        $script='';
+    } else { # add real event handler calling the function found
+        $bind=qq|    \$("#$ctl").$ev(\{id: '$id'\}, ${fname}_handler);\n|;
+        $script = $self->_add_handler( $ev, $fname );
+    }
+    return ( $bind, $script );
+}
+
+sub _add_handler {
+# adds a handler with event parameter
+# event.data.id is passed to the plugin function in parameters
+# for the click event we always return false to prevent scrolling
+    my ( $self, $ev, $fname ) = @_;
+    my $first= $self->_first_item_par( $ev );
+    my $prefix= $ev eq 'click'? '': 'return ';
+    my $suffix= $ev eq 'click'? "\n    return false;": '';
+    return <<HERE;
+function ${fname}_handler(event) {
+    $prefix$fname(${first}event.data.id);$suffix
+}
+HERE
+}
+
+sub _first_item_par {
+    my ( $self, $event ) = @_;
+    # needed for backward compatibility
+    # js event functions in old style item plugins have an extra parameter
+    # BUT.. not for all events (exceptions provide employment :)
+    if( $self->{item_style} && $self->{oldschool} &&
+            $event=~/focus|blur|change/ ) {
+        return qq/'0',/;
+    }
+    return '';
+}
+
+sub _merge_script {
+# Combine script and event bindings, enclosed in script tags.
+# The BindEvents function is added to easily repeat event binding;
+# this is used in additem.js for dynamically created item blocks.
+    my ( $id, $script, $bind ) = @_;
+    chomp ($script, $bind);
+    return <<HERE;
+<script type="text/javascript">
+//<![CDATA[
+$script
+function BindEvents$id() {
+$bind
+}
+\$(document).ready(function() {
+    BindEvents$id();
+});
+//]]>
+</script>
+HERE
+}
+
+=head1 AUTHOR
+
+    Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
+
+=cut
+
+1;

t/db_dependent/FrameworkPlugin.t

@@ -0,0 +1,278 @@
+use Modern::Perl;
+
+use C4::Auth;
+use C4::Output;
+use Koha::FrameworkPlugin;
+
+use CGI;
+use File::Temp qw/tempfile/;
+use Getopt::Long;
+use Test::MockModule;
+use Test::More tests => 5;
+
+my @includes;
+GetOptions( 'include=s{,}' => \@includes ); #not used by default !
+
+my $dbh = C4::Context->dbh;
+$dbh->{AutoCommit} = 0;
+$dbh->{RaiseError} = 1;
+
+subtest 'Test01 -- Simple tests for new and name' => sub {
+    plan tests => 7;
+    test01();
+    $dbh->rollback;
+};
+subtest 'Test02 -- test build with old styler and marc21_leader' => sub {
+    plan tests => 5;
+    test02();
+    $dbh->rollback;
+};
+subtest 'Test03 -- tests with bad plugins' => sub {
+    test03();
+    $dbh->rollback;
+};
+subtest 'Test04 -- tests with new style plugin' => sub {
+    plan tests => 5;
+    test04();
+    $dbh->rollback;
+};
+subtest 'Test05 -- tests with build and launch for default plugins' => sub {
+    test05( \@includes );
+    $dbh->rollback;
+};
+$dbh->rollback;
+
+sub test01 {
+    #empty plugin
+    my $plugin= Koha::FrameworkPlugin->new;
+    is( ref($plugin), 'Koha::FrameworkPlugin', 'Got an object' );
+    isnt( $plugin->errstr, undef, 'We should have an error for missing name');
+    is( $plugin->build, undef, 'Build returns undef');
+
+    #tests for name and path, with/without hashref
+    $plugin= Koha::FrameworkPlugin->new( { name => 'marc21_leader.pl' } );
+    is( $plugin->name, 'marc21_leader.pl', 'Check name without path in hash' );
+    $plugin= Koha::FrameworkPlugin->new( 'marc21_leader.pl' );
+    is( $plugin->name, 'marc21_leader.pl', 'Check name without path' );
+    $plugin= Koha::FrameworkPlugin->new( 'cataloguing/value_builder/marc21_leader.pl' );
+    is( $plugin->name, 'marc21_leader.pl', 'Check name with path' );
+    $plugin= Koha::FrameworkPlugin->new({ path => 'cataloguing/value_builder', name => 'marc21_leader.pl' });
+    is( $plugin->name, 'marc21_leader.pl', 'Check name and path in hash' );
+}
+
+sub test02 {
+    # first test an old style item plugin
+    my $old = old01(); # plugin filename
+    my $path;
+    if( $old =~ /^(.*)\/([^\/]+)$/ ) { # extract path
+        $path = $1;
+        $old = $2;
+    }
+    my $plugin= Koha::FrameworkPlugin->new({
+        name => $old, path => $path, item_style => 1,
+    });
+    my $pars= { id => '234567' };
+    is( $plugin->build($pars), 1, 'Build oldstyler successful' );
+    is( length($plugin->javascript)>0 && !$plugin->noclick, 1,
+        'Checked javascript and noclick' );
+
+    # now test marc21_leader
+    $plugin= Koha::FrameworkPlugin->new( { name => 'marc21_leader.pl' } );
+    $pars= { dbh => $dbh, id => '123456' };
+    is( $plugin->build($pars), 1, 'Build marc21_leader successful' );
+    is( $plugin->javascript =~ /<script.*function.*\<\/script\>/s, 1,
+        'Javascript looks ok' );
+    is( $plugin->noclick, '', 'marc21_leader should have a popup');
+}
+
+sub test03 {
+    #file not found
+    my $plugin= Koha::FrameworkPlugin->new('file_does_not_exist');
+    $plugin->build;
+    is( $plugin->errstr =~ /not found/i, 1, 'File not found-message');
+
+    #three bad ones: no perl, syntax error, bad return value
+    foreach my $f ( bad01(), bad02(), bad03() ) {
+        next if !$f;
+        $plugin= Koha::FrameworkPlugin->new( $f );
+        $plugin->build({ id => '998877' });
+        is( defined($plugin->errstr), 1,
+            "Saw: ". ( $plugin->errstr//'no error??' ));
+    }
+    done_testing();
+}
+
+sub test04 {
+    #two simple new style plugins
+    my $plugin= Koha::FrameworkPlugin->new( good01() );
+    my $pars= { id => 'example_345' };
+    is( $plugin->build($pars), 1, 'Build 1 ok');
+    isnt( $plugin->javascript, '', 'Checked javascript property' );
+
+    $plugin= Koha::FrameworkPlugin->new( ugly01() );
+    $pars= { id => 'example_456' };
+    is( $plugin->build($pars), 1, 'Build 2 ok');
+    is( $plugin->build($pars), 1, 'Second build 2 ok');
+    is( $plugin->launch($pars), 'abc', 'Launcher returned something' );
+        #note: normally you will not call build and launch like that
+}
+
+sub test05 {
+    my ( $incl ) = @_;
+    #mock to simulate some authorization and eliminate lots of output
+    my $launched = 0;
+    my $mContext = new Test::MockModule('C4::Context');
+    my $mAuth = new Test::MockModule('C4::Auth');
+    my $mOutput = new Test::MockModule('C4::Output');
+    $mContext->mock( 'userenv', \&mock_userenv );
+    $mAuth->mock( 'checkauth', sub { return ( 1, undef, 1, all_perms() ); } );
+    $mOutput->mock('output_html_with_http_headers',  sub { ++$launched; } );
+
+    my $cgi=new CGI;
+    my ( $plugins, $min ) = selected_plugins( $incl );
+
+    # test building them
+    my $objs;
+    foreach my $f ( @$plugins ) {
+        $objs->{$f} = Koha::FrameworkPlugin->new( $f );
+        my $pars= { dbh => $dbh, id => $f };
+        is( $objs->{$f}->build($pars), 1, "Builded ".$objs->{$f}->name );
+    }
+
+    # test launching them (but we cannot verify returned results here)
+    undef $objs;
+    foreach my $f ( @$plugins ) {
+        $objs->{$f} = Koha::FrameworkPlugin->new( $f );
+        my $pars= { dbh => $dbh, id => $f };
+        $objs->{$f}->launch({ cgi => $cgi });
+            # may generate some uninitialized warnings for missing params
+        is( $objs->{$f}->errstr, undef, "Launched ".$objs->{$f}->name );
+    }
+    is( $launched >= $min, 1,
+            "$launched of ". scalar @$plugins.' plugins generated output ');
+    done_testing();
+}
+
+sub selected_plugins {
+    my ( $incl ) = @_;
+    #if you use includes, FIRST assure yourself that you do not
+    #include any destructive perl scripts! You know what you are doing..
+
+    my ( @fi, $min);
+    if( $incl && @$incl ) {
+        @fi = @$incl;
+        $min = 0; #not sure how many will output
+    } else { # some default MARC, UNIMARC and item plugins
+        @fi = qw| barcode.pl dateaccessioned.pl marc21_field_003.pl
+marc21_field_005.pl marc21_field_006.pl marc21_field_007.pl marc21_field_008.pl
+marc21_field_008_authorities.pl marc21_leader.pl marc21_leader_authorities.pl
+unimarc_leader.pl unimarc_field_100.pl unimarc_field_105.pl
+unimarc_field_106.pl unimarc_field_110.pl unimarc_field_120.pl
+unimarc_field_130.pl unimarc_field_140.pl unimarc_field_225a.pl
+unimarc_field_4XX.pl |;
+        $min = 16; # the first four generate no output
+    }
+    @fi = grep
+        { !/ajax|callnumber(-KU)?\.pl|labs_theses/ } # skip these
+        @fi;
+    return ( \@fi, $min);
+}
+
+sub mock_userenv {
+    return { branch => 'CPL', flags => 1, id => 1 };
+}
+
+sub all_perms {
+    my $p = $dbh->selectcol_arrayref("SELECT flag FROM userflags");
+    my $rv= {};
+    foreach my $module ( @$p ) {
+        $rv->{ $module } = 1;
+    }
+    return $rv;
+}
+
+sub mytempfile {
+    my ( $fh, $fn ) = tempfile( SUFFIX => '.plugin', UNLINK => 1 );
+    print $fh $_[0]//'';
+    close $fh;
+    return $fn;
+}
+
+sub old01 {
+# simple old style item plugin: note that Focus has two pars
+# includes a typical empty Clic function and plugin subroutine
+    return mytempfile( <<'HERE'
+sub plugin_javascript {
+    my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
+    my $function_name = $field_number;
+    my $res = "
+<script type=\"text/javascript\">
+//<![CDATA[
+function Focus$function_name(subfield_managed,id) {
+    document.getElementById(id).value='test';
+    return 0;
+}
+function Clic$function_name(subfield_managed) {
+}
+//]]>
+</script>
+";
+    return ($function_name,$res);
+}
+sub plugin {
+    return "";
+}
+HERE
+    );
+}
+
+sub good01 { #very simple new style plugin, no launcher
+    return mytempfile( <<'HERE'
+my $builder = sub {
+    my $params = shift;
+    return qq|
+<script type="text/javascript">
+    function Focus$params->{id}(event) {
+        if( document.getElementById(event.data.id).value == '' ) {
+            document.getElementById(event.data.id).value='EXAMPLE: ';
+        }
+    }
+</script>|;
+};
+return { builder => $builder };
+HERE
+    );
+}
+
+sub bad01 { # this is no plugin
+    return mytempfile( 'Just nonsense' );
+}
+
+sub bad02 { # common syntax error: you forgot the semicolon of sub1 declare
+    return mytempfile( <<'HERE'
+my $sub1= sub {
+    my $params = shift;
+    return qq|<script type="text/javascript">function Change$params->{id}(event) { alert("Changed"); }</script>|;
+}
+return { builder => $sub1 };
+HERE
+    );
+}
+
+sub bad03 { # badscript tag should trigger an error
+    return mytempfile( <<'HERE'
+my $sub1= sub {
+    my $params = shift;
+    return qq|<badscript type="text/javascript">function Click$params->{id} (event) { alert("Hi there"); return false; }</badscript>|;
+};
+return { builder => $sub1 };
+HERE
+    );
+}
+
+sub ugly01 { #works, but not very readable..
+    return mytempfile( <<'HERE'
+return {builder=>sub{return qq|<script type="text/javascript">function Blur$_[0]->{id}(event){alert('Bye');}</script>|;},launcher=>sub{'abc'}};
+HERE
+    );
+}