bug 8215: (followup) make sure C4::CourseReserves doesn't export anything
[koha.git] / C4 / SQLHelper.pm
1 package C4::SQLHelper;
2
3 # Copyright 2009 Biblibre SARL
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 2 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
21 use strict;
22 use warnings;
23 use List::MoreUtils qw(first_value any);
24 use C4::Context;
25 use C4::Dates qw(format_date_in_iso);
26 use C4::Debug;
27 require Exporter;
28 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
29
30 eval {
31     my $servers = C4::Context->config('memcached_servers');
32     if ($servers) {
33         require Memoize::Memcached;
34         import Memoize::Memcached qw(memoize_memcached);
35
36         my $memcached = {
37             servers     => [$servers],
38             key_prefix  => C4::Context->config('memcached_namespace') || 'koha',
39             expire_time => 600
40         };    # cache for 10 mins
41
42         memoize_memcached( '_get_columns',   memcached => $memcached );
43         memoize_memcached( 'GetPrimaryKeys', memcached => $memcached );
44     }
45 };
46
47 BEGIN {
48         # set the version for version checking
49     $VERSION = 3.07.00.049;
50         require Exporter;
51         @ISA    = qw(Exporter);
52 @EXPORT_OK=qw(
53         InsertInTable
54         DeleteInTable
55         SearchInTable
56         UpdateInTable
57         GetPrimaryKeys
58         clear_columns_cache
59 );
60         %EXPORT_TAGS = ( all =>[qw( InsertInTable DeleteInTable SearchInTable UpdateInTable GetPrimaryKeys)]
61                                 );
62 }
63
64 my $tablename;
65 my $hashref;
66
67 =head1 NAME
68
69 C4::SQLHelper - Perl Module containing convenience functions for SQL Handling
70
71 =head1 SYNOPSIS
72
73 use C4::SQLHelper;
74
75 =head1 DESCRIPTION
76
77 This module contains routines for adding, modifying and Searching Data in MysqlDB 
78
79 =head1 FUNCTIONS
80
81 =head2 SearchInTable
82
83   $hashref = &SearchInTable($tablename,$data, $orderby, $limit, 
84                       $columns_out, $filtercolumns, $searchtype);
85
86
87 $tablename Name of the table (string)
88
89 $data may contain 
90         - string
91
92         - data_hashref : will be considered as an AND of all the data searched
93
94         - data_array_ref on hashrefs : Will be considered as an OR of Datahasref elements
95
96 $orderby is an arrayref of hashref with fieldnames as key and 0 or 1 as values (ASCENDING or DESCENDING order)
97
98 $limit is an array ref on 2 values in order to limit results to MIN..MAX
99
100 $columns_out is an array ref on field names is used to limit results on those fields (* by default)
101
102 $filtercolums is an array ref on field names : is used to limit expansion of research for strings
103
104 $searchtype is string Can be "start_with" or "exact" 
105
106 This query builder is very limited, it should be replaced with DBIx::Class
107 or similar  very soon
108 Meanwhile adding support for special key '' in case of a data_hashref to
109 support filters of type
110
111   ( f1 = a OR f2 = a ) AND fx = b AND fy = c
112
113 Call for the query above is:
114
115   SearchInTable($tablename, {'' => a, fx => b, fy => c}, $orderby, $limit,
116                 $columns_out, [f1, f2], 'exact');
117
118 NOTE: Current implementation may remove parts of the iinput hashrefs. If that is a problem
119 a copy needs to be created in _filter_fields() below
120
121 =cut
122
123 sub SearchInTable{
124     my ($tablename,$filters,$orderby, $limit, $columns_out, $filter_columns,$searchtype) = @_; 
125         $searchtype||="exact";
126     my $dbh      = C4::Context->dbh; 
127         $columns_out||=["*"];
128     my $sql      = do { local $"=', '; 
129                 qq{ SELECT @$columns_out from $tablename} 
130                };
131     my $row; 
132     my $sth; 
133     my ($keys,$values)=_filter_fields($tablename,$filters,$searchtype,$filter_columns); 
134         if ($keys){
135                 my @criteria=grep{defined($_) && $_ !~/^\W$/ }@$keys;
136                 if (@criteria) { 
137                         $sql.= do { local $"=') OR ('; 
138                                         qq{ WHERE (@criteria) } 
139                                    }; 
140                 } 
141         }
142     if ($orderby){ 
143                 #Order by desc by default
144                 my @orders;
145                 foreach my $order ( ref($orderby) ? @$orderby : $orderby ){
146             if (ref $order) {
147                             push @orders,map{ "$_".($order->{$_}? " DESC " : "") } keys %$order; 
148             } else {
149                             push @orders,$order; 
150             }
151                 }
152                 $sql.= do { local $"=', '; 
153                                 qq{ ORDER BY @orders} 
154         }; 
155     } 
156         if ($limit){
157                 $sql.=qq{ LIMIT }.join(",",@$limit);
158         }
159      
160     $debug && $values && warn $sql," ",join(",",@$values); 
161     $sth = $dbh->prepare_cached($sql); 
162     eval{$sth->execute(@$values)}; 
163         warn $@ if ($@ && $debug);
164     my $results = $sth->fetchall_arrayref( {} ); 
165     return $results;
166 }
167
168 =head2 InsertInTable
169
170   $data_id_in_table = &InsertInTable($tablename,$data_hashref,$withprimarykeys);
171
172 Insert Data in table and returns the id of the row inserted
173
174 =cut
175
176 sub InsertInTable{
177     my ($tablename,$data,$withprimarykeys) = @_;
178     my $dbh      = C4::Context->dbh;
179     my ($keys,$values)=_filter_hash($tablename,$data,($withprimarykeys?"exact":0));
180     my $query = qq{ INSERT INTO $tablename SET  }.join(", ",@$keys);
181
182         $debug && warn $query, join(",",@$values);
183     my $sth = $dbh->prepare_cached($query);
184     eval{$sth->execute(@$values)}; 
185         warn $@ if ($@ && $debug);
186
187         return $dbh->last_insert_id(undef, undef, $tablename, undef);
188 }
189
190 =head2 UpdateInTable
191
192   $status = &UpdateInTable($tablename,$data_hashref);
193
194 Update Data in table and returns the status of the operation
195
196 =cut
197
198 sub UpdateInTable{
199     my ($tablename,$data) = @_;
200         my @field_ids=GetPrimaryKeys($tablename);
201     my @ids=@$data{@field_ids};
202     my $dbh      = C4::Context->dbh;
203     my ($keys,$values)=_filter_hash($tablename,$data,0);
204     return unless ($keys);
205     my $query = 
206     qq{     UPDATE $tablename
207             SET  }.join(",",@$keys).qq{
208             WHERE }.join (" AND ",map{ "$_=?" }@field_ids);
209         $debug && warn $query, join(",",@$values,@ids);
210
211     my $sth = $dbh->prepare_cached($query);
212         my $result;
213     eval{$result=$sth->execute(@$values,@ids)}; 
214         warn $@ if ($@ && $debug);
215     return $result;
216 }
217
218 =head2 DeleteInTable
219
220   $status = &DeleteInTable($tablename,$data_hashref);
221
222 Delete Data in table and returns the status of the operation
223
224 =cut
225
226 sub DeleteInTable{
227     my ($tablename,$data) = @_;
228     my $dbh      = C4::Context->dbh;
229     my ($keys,$values)=_filter_fields($tablename,$data,1);
230         if ($keys){
231                 my $query = do { local $"=') AND (';
232                 qq{ DELETE FROM $tablename WHERE (@$keys)};
233                 };
234                 $debug && warn $query, join(",",@$values);
235                 my $sth = $dbh->prepare_cached($query);
236                 my $result;
237         eval{$result=$sth->execute(@$values)}; 
238                 warn $@ if ($@ && $debug);
239         return $result;
240         }
241 }
242
243 =head2 GetPrimaryKeys
244
245   @primarykeys = &GetPrimaryKeys($tablename)
246
247 Get the Primary Key field names of the table
248
249 =cut
250
251 sub GetPrimaryKeys {
252         my $tablename=shift;
253         my $hash_columns=_get_columns($tablename);
254         return  grep { $hash_columns->{$_}->{'Key'} =~/PRI/i}  keys %$hash_columns;
255 }
256
257
258 =head2 clear_columns_cache
259
260   C4::SQLHelper->clear_columns_cache();
261
262 cleans the internal cache of sysprefs. Please call this method if
263 you update a tables structure. Otherwise, your new changes
264 will not be seen by this process.
265
266 =cut
267
268 sub clear_columns_cache {
269     %$hashref = ();
270 }
271
272
273
274 =head2 _get_columns
275
276     _get_columns($tablename)
277
278 Given a tablename 
279 Returns a hashref of all the fieldnames of the table
280 With 
281         Key
282         Type
283         Default
284
285 =cut
286
287 sub _get_columns {
288     my ($tablename) = @_;
289     unless ( exists( $hashref->{$tablename} ) ) {
290         my $dbh = C4::Context->dbh;
291         my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename });
292         $sth->execute;
293         my $columns = $sth->fetchall_hashref(qw(Field));
294         $hashref->{$tablename} = $columns;
295     }
296     return $hashref->{$tablename};
297 }
298
299 =head2 _filter_columns
300
301 =over 4
302
303 _filter_columns($tablename,$research, $filtercolumns)
304
305 =back
306
307 Given 
308         - a tablename 
309         - indicator on purpose whether all fields should be returned or only non Primary keys
310         - array_ref to columns to limit to
311
312 Returns an array of all the fieldnames of the table
313 If it is not for research purpose, filter primary keys
314
315 =cut
316
317 sub _filter_columns {
318         my ($tablename,$research, $filtercolumns)=@_;
319         if ($filtercolumns){
320                 return (@$filtercolumns);
321         }
322         else {
323                 my $columns=_get_columns($tablename);
324                 if ($research){
325                         return keys %$columns;
326                 }
327                 else {
328                         return grep {my $column=$_; any {$_ ne $column }GetPrimaryKeys($tablename) } keys %$columns;
329                 }
330         }
331 }
332 =head2 _filter_fields
333
334   _filter_fields
335
336 Given 
337         - a tablename
338         - a string or a hashref (containing, fieldnames and datatofilter) or an arrayref to one of those elements
339         - an indicator of operation whether it is a wide research or a narrow one
340         - an array ref to columns to restrict string filter to.
341
342 Returns a ref of key array to use in SQL functions
343 and a ref to value array
344
345 =cut
346
347 sub _filter_fields{
348         my ($tablename,$filter_input,$searchtype,$filtercolumns)=@_;
349     my @keys; 
350         my @values;
351         if (ref($filter_input) eq "HASH"){
352                 my ($keys, $values);
353         if (my $special = delete $filter_input->{''}) { # XXX destroyes '' key
354                     ($keys, $values) = _filter_fields($tablename,$special, $searchtype,$filtercolumns);
355         }
356                 my ($hkeys, $hvalues) = _filter_hash($tablename,$filter_input, $searchtype);
357                 if ($hkeys){
358             push @$keys, @$hkeys;
359             push @$values, @$hvalues;
360         }
361                 if ($keys){
362                     my $stringkey="(".join (") AND (",@$keys).")";
363                     return [$stringkey],$values;
364                 }
365                 else {
366                     return ();
367                 }
368         } elsif (ref($filter_input) eq "ARRAY"){
369                 foreach my $element_data (@$filter_input){
370                         my ($localkeys,$localvalues)=_filter_fields($tablename,$element_data,$searchtype,$filtercolumns);
371                         if ($localkeys){
372                                 @$localkeys=grep{defined($_) && $_ !~/^\W*$/}@$localkeys;
373                                 my $string=do{ 
374                                                                 local $"=") OR (";
375                                                                 qq{(@$localkeys)}
376                                                         };
377                                 push @keys, $string;
378                                 push @values, @$localvalues;
379                         }
380                 }
381         } 
382         else{
383         $debug && warn "filterstring : $filter_input";
384                 my ($keys, $values) = _filter_string($tablename,$filter_input, $searchtype,$filtercolumns);
385                 if ($keys){
386                 my $stringkey="(".join (") AND (",@$keys).")";
387                 return [$stringkey],$values;
388                 }
389                 else {
390                 return ();
391                 }
392         }
393
394         return (\@keys,\@values);
395 }
396
397 sub _filter_hash{
398         my ($tablename,$filter_input, $searchtype)=@_;
399         my (@values, @keys);
400         my $columns= _get_columns($tablename);
401         my @columns_filtered= _filter_columns($tablename,$searchtype);
402         
403         #Filter Primary Keys of table
404     my $elements=join "|",@columns_filtered;
405         foreach my $field (grep {/\b($elements)\b/} keys %$filter_input){
406                 ## supposed to be a hash of simple values, hashes of arrays could be implemented
407                 $filter_input->{$field}=format_date_in_iso($filter_input->{$field})
408           if $columns->{$field}{Type}=~/date/ &&
409              $filter_input->{$field} !~C4::Dates->regexp("iso");
410                 my ($tmpkeys, $localvalues)=_Process_Operands($filter_input->{$field},"$tablename.$field",$searchtype,$columns);
411                 if (@$tmpkeys){
412                         push @values, @$localvalues;
413                         push @keys, @$tmpkeys;
414                 }
415         }
416         if (@keys){
417                 return (\@keys,\@values);
418         }
419         else {
420                 return ();
421         }
422 }
423
424 sub _filter_string{
425         my ($tablename,$filter_input, $searchtype,$filtercolumns)=@_;
426         return () unless($filter_input);
427         my @operands=split /\s+/,$filter_input;
428
429     # An act of desperation
430     $searchtype = 'contain' if @operands > 1 && $searchtype =~ /start_with/o;
431
432         my @columns_filtered= _filter_columns($tablename,$searchtype,$filtercolumns);
433         my $columns= _get_columns($tablename);
434         my (@values,@keys);
435         foreach my $operand (@operands){
436                 my @localkeys;
437                 foreach my $field (@columns_filtered){
438                         my ($tmpkeys, $localvalues)=_Process_Operands($operand,"$tablename.$field",$searchtype,$columns);
439                         if ($tmpkeys){
440                                 push @values,@$localvalues;
441                                 push @localkeys,@$tmpkeys;
442                         }
443                 }
444                 my $sql= join (' OR ', @localkeys);
445                 push @keys, $sql;
446         }
447
448         if (@keys){
449                 return (\@keys,\@values);
450         }
451         else {
452                 return ();
453         }
454 }
455 sub _Process_Operands{
456         my ($operand, $field, $searchtype,$columns)=@_;
457         my @values;
458         my @tmpkeys;
459         my @localkeys;
460
461     $operand = [$operand] unless ref $operand eq 'ARRAY';
462     foreach (@$operand) {
463             push @tmpkeys, " $field = ? ";
464             push @values, $_;
465     }
466         #By default, exact search
467         if (!$searchtype ||$searchtype eq "exact"){
468                 return \@tmpkeys,\@values;
469         }
470         my $col_field=(index($field,".")>0?substr($field, index($field,".")+1):$field);
471         if ($field=~/(?<!zip)code|(?<!card)number/ && $searchtype ne "exact"){
472                 push @tmpkeys,(" $field= '' ","$field IS NULL");
473         }
474         if ($columns->{$col_field}->{Type}=~/varchar|text/i){
475                 my @localvaluesextended;
476                 if ($searchtype eq "contain"){
477             foreach (@$operand) {
478                             push @tmpkeys,(" $field LIKE ? ");
479                             push @localvaluesextended,("\%$_\%") ;
480             }
481                 }
482                 if ($searchtype eq "field_start_with"){
483             foreach (@$operand) {
484                             push @tmpkeys,("$field LIKE ?");
485                             push @localvaluesextended, ("$_\%") ;
486             }
487                 }
488                 if ($searchtype eq "start_with"){
489             foreach (@$operand) {
490                             push @tmpkeys,("$field LIKE ?","$field LIKE ?");
491                             push @localvaluesextended, ("$_\%", " $_\%") ;
492             }
493                 }
494                 push @values,@localvaluesextended;
495         }
496         push @localkeys,qq{ (}.join(" OR ",@tmpkeys).qq{) };
497         return (\@localkeys,\@values);
498 }
499 1;
500