Lines 1-506
Link Here
|
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 |
8 |
# under the terms of the GNU General Public License as published by |
9 |
# the Free Software Foundation; either version 3 of the License, or |
10 |
# (at your option) any later version. |
11 |
# |
12 |
# Koha is distributed in the hope that it will be useful, but |
13 |
# WITHOUT ANY WARRANTY; without even the implied warranty of |
14 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
15 |
# GNU General Public License for more details. |
16 |
# |
17 |
# You should have received a copy of the GNU General Public License |
18 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
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 |
if ( $columns->{$field}{Type}=~/date/ ) { |
408 |
if ( defined $filter_input->{$field} ) { |
409 |
if ( $filter_input->{$field} eq q{} ) { |
410 |
$filter_input->{$field} = undef; |
411 |
} elsif ( $filter_input->{$field} !~ C4::Dates->regexp("iso") ) { |
412 |
$filter_input->{$field} = format_date_in_iso($filter_input->{$field}); |
413 |
} |
414 |
} |
415 |
} |
416 |
my ($tmpkeys, $localvalues)=_Process_Operands($filter_input->{$field},"$tablename.$field",$searchtype,$columns); |
417 |
if (@$tmpkeys){ |
418 |
push @values, @$localvalues; |
419 |
push @keys, @$tmpkeys; |
420 |
} |
421 |
} |
422 |
if (@keys){ |
423 |
return (\@keys,\@values); |
424 |
} |
425 |
else { |
426 |
return (); |
427 |
} |
428 |
} |
429 |
|
430 |
sub _filter_string{ |
431 |
my ($tablename,$filter_input, $searchtype,$filtercolumns)=@_; |
432 |
return () unless($filter_input); |
433 |
my @operands=split /\s+/,$filter_input; |
434 |
|
435 |
# An act of desperation |
436 |
$searchtype = 'contain' if @operands > 1 && $searchtype =~ /start_with/o; |
437 |
|
438 |
my @columns_filtered= _filter_columns($tablename,$searchtype,$filtercolumns); |
439 |
my $columns= _get_columns($tablename); |
440 |
my (@values,@keys); |
441 |
foreach my $operand (@operands){ |
442 |
my @localkeys; |
443 |
foreach my $field (@columns_filtered){ |
444 |
my ($tmpkeys, $localvalues)=_Process_Operands($operand,"$tablename.$field",$searchtype,$columns); |
445 |
if ($tmpkeys){ |
446 |
push @values,@$localvalues; |
447 |
push @localkeys,@$tmpkeys; |
448 |
} |
449 |
} |
450 |
my $sql= join (' OR ', @localkeys); |
451 |
push @keys, $sql; |
452 |
} |
453 |
|
454 |
if (@keys){ |
455 |
return (\@keys,\@values); |
456 |
} |
457 |
else { |
458 |
return (); |
459 |
} |
460 |
} |
461 |
sub _Process_Operands{ |
462 |
my ($operand, $field, $searchtype,$columns)=@_; |
463 |
my @values; |
464 |
my @tmpkeys; |
465 |
my @localkeys; |
466 |
|
467 |
$operand = [$operand] unless ref $operand eq 'ARRAY'; |
468 |
foreach (@$operand) { |
469 |
push @tmpkeys, " $field = ? "; |
470 |
push @values, $_; |
471 |
} |
472 |
#By default, exact search |
473 |
if (!$searchtype ||$searchtype eq "exact"){ |
474 |
return \@tmpkeys,\@values; |
475 |
} |
476 |
my $col_field=(index($field,".")>0?substr($field, index($field,".")+1):$field); |
477 |
if ($field=~/(?<!zip)code|(?<!card)number/ && $searchtype ne "exact"){ |
478 |
push @tmpkeys,(" $field= '' ","$field IS NULL"); |
479 |
} |
480 |
if ($columns->{$col_field}->{Type}=~/varchar|text/i){ |
481 |
my @localvaluesextended; |
482 |
if ($searchtype eq "contain"){ |
483 |
foreach (@$operand) { |
484 |
push @tmpkeys,(" $field LIKE ? "); |
485 |
push @localvaluesextended,("\%$_\%") ; |
486 |
} |
487 |
} |
488 |
if ($searchtype eq "field_start_with"){ |
489 |
foreach (@$operand) { |
490 |
push @tmpkeys,("$field LIKE ?"); |
491 |
push @localvaluesextended, ("$_\%") ; |
492 |
} |
493 |
} |
494 |
if ($searchtype eq "start_with"){ |
495 |
foreach (@$operand) { |
496 |
push @tmpkeys,("$field LIKE ?","$field LIKE ?"); |
497 |
push @localvaluesextended, ("$_\%", " $_\%") ; |
498 |
} |
499 |
} |
500 |
push @values,@localvaluesextended; |
501 |
} |
502 |
push @localkeys,qq{ (}.join(" OR ",@tmpkeys).qq{) }; |
503 |
return (\@localkeys,\@values); |
504 |
} |
505 |
1; |
506 |
|