Bug 25898: Prohibit indirect object notation
[koha.git] / t / db_dependent / FrameworkPlugin.t
1 use Modern::Perl;
2
3 use CGI;
4 use File::Temp qw/tempfile/;
5 use Getopt::Long;
6 use Test::MockModule;
7 use Test::More tests => 5;
8
9 use t::lib::TestBuilder;
10
11 use C4::Auth;
12 use C4::Output;
13 use Koha::Database;
14 use Koha::FrameworkPlugin;
15
16 our @includes;
17 GetOptions( 'include=s{,}' => \@includes ); #not used by default !
18
19 my $schema  = Koha::Database->new->schema;
20 $schema->storage->txn_begin;
21 our $dbh = C4::Context->dbh;
22 our $builder = t::lib::TestBuilder->new;
23
24 subtest 'Test01 -- Simple tests for new and name' => sub {
25     plan tests => 7;
26     test01();
27 };
28 subtest 'Test02 -- test build with old styler and marc21_leader' => sub {
29     plan tests => 5;
30     test02();
31 };
32 subtest 'Test03 -- tests with bad plugins' => sub {
33     test03();
34 };
35 subtest 'Test04 -- tests with new style plugin' => sub {
36     plan tests => 5;
37     test04();
38 };
39 subtest 'Test05 -- tests with build and launch for default plugins' => sub {
40     test05( \@includes );
41 };
42 $schema->storage->txn_rollback;
43
44 sub test01 {
45     #empty plugin
46     my $plugin= Koha::FrameworkPlugin->new;
47     is( ref($plugin), 'Koha::FrameworkPlugin', 'Got an object' );
48     isnt( $plugin->errstr, undef, 'We should have an error for missing name');
49     is( $plugin->build, undef, 'Build returns undef');
50
51     #tests for name and path, with/without hashref
52     $plugin= Koha::FrameworkPlugin->new( { name => 'marc21_leader.pl' } );
53     is( $plugin->name, 'marc21_leader.pl', 'Check name without path in hash' );
54     $plugin= Koha::FrameworkPlugin->new( 'marc21_leader.pl' );
55     is( $plugin->name, 'marc21_leader.pl', 'Check name without path' );
56     $plugin= Koha::FrameworkPlugin->new( 'cataloguing/value_builder/marc21_leader.pl' );
57     is( $plugin->name, 'marc21_leader.pl', 'Check name with path' );
58     $plugin= Koha::FrameworkPlugin->new({ path => 'cataloguing/value_builder', name => 'marc21_leader.pl' });
59     is( $plugin->name, 'marc21_leader.pl', 'Check name and path in hash' );
60 }
61
62 sub test02 {
63     # first test an old style item plugin
64     my $old = old01(); # plugin filename
65     my $path;
66     if( $old =~ /^(.*)\/([^\/]+)$/ ) { # extract path
67         $path = $1;
68         $old = $2;
69     }
70     my $plugin= Koha::FrameworkPlugin->new({
71         name => $old, path => $path, item_style => 1,
72     });
73     my $pars= { id => '234567' };
74     is( $plugin->build($pars), 1, 'Build oldstyler successful' );
75     is( length($plugin->javascript)>0 && !$plugin->noclick, 1,
76         'Checked javascript and noclick' );
77
78     # now test marc21_leader
79     $plugin= Koha::FrameworkPlugin->new( { name => 'marc21_leader.pl' } );
80     $pars= { dbh => $dbh, id => '123456' };
81     is( $plugin->build($pars), 1, 'Build marc21_leader successful' );
82     is( $plugin->javascript =~ /<script.*function.*\<\/script\>/s, 1,
83         'Javascript looks ok' );
84     is( $plugin->noclick, '', 'marc21_leader should have a popup');
85 }
86
87 sub test03 {
88     #file not found
89     my $plugin= Koha::FrameworkPlugin->new('file_does_not_exist');
90     $plugin->build;
91     is( $plugin->errstr =~ /not found/i, 1, 'File not found-message');
92
93     #three bad ones: no perl, syntax error, bad return value
94     foreach my $f ( bad01(), bad02(), bad03() ) {
95         next if !$f;
96         $plugin= Koha::FrameworkPlugin->new( $f );
97         $plugin->build({ id => '998877' });
98         is( defined($plugin->errstr), 1,
99             "Saw: ". ( $plugin->errstr//'no error??' ));
100     }
101     done_testing();
102 }
103
104 sub test04 {
105     #two simple new style plugins
106     my $plugin= Koha::FrameworkPlugin->new( good01() );
107     my $pars= { id => 'example_345' };
108     is( $plugin->build($pars), 1, 'Build 1 ok');
109     isnt( $plugin->javascript, '', 'Checked javascript property' );
110
111     $plugin= Koha::FrameworkPlugin->new( ugly01() );
112     $pars= { id => 'example_456' };
113     is( $plugin->build($pars), 1, 'Build 2 ok');
114     is( $plugin->build($pars), 1, 'Second build 2 ok');
115     is( $plugin->launch($pars), 'abc', 'Launcher returned something' );
116         #note: normally you will not call build and launch like that
117 }
118
119 sub test05 {
120     my ( $incl ) = @_;
121     #mock to simulate some authorization and eliminate lots of output
122     my $launched = 0;
123     my $mContext = Test::MockModule->new('C4::Context');
124     my $mAuth = Test::MockModule->new('C4::Auth');
125     my $mOutput = Test::MockModule->new('C4::Output');
126     $mContext->mock( 'userenv', \&mock_userenv );
127     $mAuth->mock( 'checkauth', sub { return ( 1, undef, 1, all_perms() ); } );
128     $mOutput->mock('output_html_with_http_headers',  sub { ++$launched; } );
129
130     my $cgi=CGI->new;
131     my ( $plugins, $min ) = selected_plugins( $incl );
132
133     # test building them
134     my $objs;
135     foreach my $f ( @$plugins ) {
136         $objs->{$f} = Koha::FrameworkPlugin->new( $f );
137         my $pars= { dbh => $dbh, id => $f };
138         is( $objs->{$f}->build($pars), 1, "Builded ".$objs->{$f}->name );
139     }
140
141     # test launching them (but we cannot verify returned results here)
142     undef $objs;
143     foreach my $f ( @$plugins ) {
144         $objs->{$f} = Koha::FrameworkPlugin->new( $f );
145         my $pars= { dbh => $dbh, id => $f };
146         $objs->{$f}->launch({ cgi => $cgi });
147             # may generate some uninitialized warnings for missing params
148         is( $objs->{$f}->errstr, undef, "Launched ".$objs->{$f}->name );
149     }
150     is( $launched >= $min, 1,
151             "$launched of ". scalar @$plugins.' plugins generated output ');
152     done_testing();
153 }
154
155 sub selected_plugins {
156     my ( $incl ) = @_;
157     #if you use includes, FIRST assure yourself that you do not
158     #include any destructive perl scripts! You know what you are doing..
159
160     my ( @fi, $min);
161     if( $incl && @$incl ) {
162         @fi = @$incl;
163         $min = 0; #not sure how many will output
164     } else { # some default MARC, UNIMARC and item plugins
165         @fi = qw| barcode.pl dateaccessioned.pl marc21_orgcode.pl
166 marc21_field_005.pl marc21_field_006.pl marc21_field_007.pl marc21_field_008.pl
167 marc21_field_008_authorities.pl marc21_leader.pl marc21_leader_authorities.pl
168 unimarc_leader.pl unimarc_field_100.pl unimarc_field_105.pl
169 unimarc_field_106.pl unimarc_field_110.pl unimarc_field_120.pl
170 unimarc_field_130.pl unimarc_field_140.pl unimarc_field_225a.pl
171 unimarc_field_4XX.pl |;
172         $min = 16; # the first four generate no output
173     }
174     @fi = grep
175         { !/ajax|callnumber(-KU)?\.pl|labs_theses/ } # skip these
176         @fi;
177     return ( \@fi, $min);
178 }
179
180 sub mock_userenv {
181     my $branch = $builder->build({ source => 'Branch' });
182     return { branch => $branch->{branchcode}, flags => 1, id => 1 };
183 }
184
185 sub all_perms {
186     my $p = $dbh->selectcol_arrayref("SELECT flag FROM userflags");
187     my $rv= {};
188     foreach my $module ( @$p ) {
189         $rv->{ $module } = 1;
190     }
191     return $rv;
192 }
193
194 sub mytempfile {
195     my ( $fh, $fn ) = tempfile( SUFFIX => '.plugin', UNLINK => 1 );
196     print $fh $_[0]//'';
197     close $fh;
198     return $fn;
199 }
200
201 sub old01 {
202 # simple old style item plugin: note that Focus has two pars
203 # includes a typical empty Clic function and plugin subroutine
204     return mytempfile( <<'HERE'
205 sub plugin_javascript {
206     my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
207     my $function_name = $field_number;
208     my $res = "
209 <script type=\"text/javascript\">
210 //<![CDATA[
211 function Focus$function_name(subfield_managed,id) {
212     document.getElementById(id).value='test';
213     return 0;
214 }
215 function Clic$function_name(subfield_managed) {
216 }
217 //]]>
218 </script>
219 ";
220     return ($function_name,$res);
221 }
222 sub plugin {
223     return "";
224 }
225 HERE
226     );
227 }
228
229 sub good01 { #very simple new style plugin, no launcher
230     return mytempfile( <<'HERE'
231 my $builder = sub {
232     my $params = shift;
233     return qq|
234 <script type="text/javascript">
235     function Focus$params->{id}(event) {
236         if( document.getElementById(event.data.id).value == '' ) {
237             document.getElementById(event.data.id).value='EXAMPLE: ';
238         }
239     }
240 </script>|;
241 };
242 return { builder => $builder };
243 HERE
244     );
245 }
246
247 sub bad01 { # this is no plugin
248     return mytempfile( 'Just nonsense' );
249 }
250
251 sub bad02 { # common syntax error: you forgot the semicolon of sub1 declare
252     return mytempfile( <<'HERE'
253 my $sub1= sub {
254     my $params = shift;
255     return qq|<script type="text/javascript">function Change$params->{id}(event) { alert("Changed"); }</script>|;
256 }
257 return { builder => $sub1 };
258 HERE
259     );
260 }
261
262 sub bad03 { # badscript tag should trigger an error
263     return mytempfile( <<'HERE'
264 my $sub1= sub {
265     my $params = shift;
266     return qq|<badscript type="text/javascript">function Click$params->{id} (event) { alert("Hi there"); return false; }</badscript>|;
267 };
268 return { builder => $sub1 };
269 HERE
270     );
271 }
272
273 sub ugly01 { #works, but not very readable..
274     return mytempfile( <<'HERE'
275 return {builder=>sub{return qq|<script type="text/javascript">function Blur$_[0]->{id}(event){alert('Bye');}</script>|;},launcher=>sub{'abc'}};
276 HERE
277     );
278 }