|
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 |
|