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