| File: | C4/SQLHelper.pm |
| Coverage: | 9.3% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 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 | 17 17 17 | 105 98 1212 | use strict; | |||
| 22 | 17 17 17 | 188 108 885 | use warnings; | |||
| 23 | 17 17 17 | 661 3296 1923 | use List::MoreUtils qw(first_value any); | |||
| 24 | 17 17 17 | 398 167 345 | use C4::Context; | |||
| 25 | 17 17 17 | 261 206 915 | use C4::Dates qw(format_date_in_iso); | |||
| 26 | 17 17 17 | 117 57 1685 | use C4::Debug; | |||
| 27 | require Exporter; | |||||
| 28 | 17 17 17 | 112 87 4450 | 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 | 17 | 61 | $VERSION = 0.5; | |||
| 50 | 17 | 139 | require Exporter; | |||
| 51 | 17 | 213 | @ISA = qw(Exporter); | |||
| 52 | 17 | 97 | @EXPORT_OK=qw( | |||
| 53 | InsertInTable | |||||
| 54 | DeleteInTable | |||||
| 55 | SearchInTable | |||||
| 56 | UpdateInTable | |||||
| 57 | GetPrimaryKeys | |||||
| 58 | clear_columns_cache | |||||
| 59 | ); | |||||
| 60 | 17 | 50390 | %EXPORT_TAGS = ( all =>[qw( InsertInTable DeleteInTable SearchInTable UpdateInTable GetPrimaryKeys)] | |||
| 61 | ); | |||||
| 62 | } | |||||
| 63 | ||||||
| 64 | my $tablename; | |||||
| 65 | my $hashref; | |||||
| 66 | ||||||
| 67 - 121 | =head1 NAME
C4::SQLHelper - Perl Module containing convenience functions for SQL Handling
=head1 SYNOPSIS
use C4::SQLHelper;
=head1 DESCRIPTION
This module contains routines for adding, modifying and Searching Data in MysqlDB
=head1 FUNCTIONS
=head2 SearchInTable
$hashref = &SearchInTable($tablename,$data, $orderby, $limit,
$columns_out, $filtercolumns, $searchtype);
$tablename Name of the table (string)
$data may contain
- string
- data_hashref : will be considered as an AND of all the data searched
- data_array_ref on hashrefs : Will be considered as an OR of Datahasref elements
$orderby is an arrayref of hashref with fieldnames as key and 0 or 1 as values (ASCENDING or DESCENDING order)
$limit is an array ref on 2 values in order to limit results to MIN..MAX
$columns_out is an array ref on field names is used to limit results on those fields (* by default)
$filtercolums is an array ref on field names : is used to limit expansion of research for strings
$searchtype is string Can be "start_with" or "exact"
This query builder is very limited, it should be replaced with DBIx::Class
or similar very soon
Meanwhile adding support for special key '' in case of a data_hashref to
support filters of type
( f1 = a OR f2 = a ) AND fx = b AND fy = c
Call for the query above is:
SearchInTable($tablename, {'' => a, fx => b, fy => c}, $orderby, $limit,
$columns_out, [f1, f2], 'exact');
NOTE: Current implementation may remove parts of the iinput hashrefs. If that is a problem
a copy needs to be created in _filter_fields() below
=cut | |||||
| 122 | ||||||
| 123 | sub SearchInTable{ | |||||
| 124 | 0 | my ($tablename,$filters,$orderby, $limit, $columns_out, $filter_columns,$searchtype) = @_; | ||||
| 125 | 0 | $searchtype||="exact"; | ||||
| 126 | 0 | my $dbh = C4::Context->dbh; | ||||
| 127 | 0 | $columns_out||=["*"]; | ||||
| 128 | 0 0 | my $sql = do { local $"=', '; | ||||
| 129 | 0 | qq{ SELECT @$columns_out from $tablename} | ||||
| 130 | }; | |||||
| 131 | 0 | my $row; | ||||
| 132 | 0 | my $sth; | ||||
| 133 | 0 | my ($keys,$values)=_filter_fields($tablename,$filters,$searchtype,$filter_columns); | ||||
| 134 | 0 | if ($keys){ | ||||
| 135 | 0 0 | my @criteria=grep{defined($_) && $_ !~/^\W$/ }@$keys; | ||||
| 136 | 0 | if (@criteria) { | ||||
| 137 | 0 0 | $sql.= do { local $"=') OR ('; | ||||
| 138 | 0 | qq{ WHERE (@criteria) } | ||||
| 139 | }; | |||||
| 140 | } | |||||
| 141 | } | |||||
| 142 | 0 | if ($orderby){ | ||||
| 143 | #Order by desc by default | |||||
| 144 | 0 | my @orders; | ||||
| 145 | 0 | foreach my $order ( ref($orderby) ? @$orderby : $orderby ){ | ||||
| 146 | 0 | if (ref $order) { | ||||
| 147 | 0 0 | push @orders,map{ "$_".($order->{$_}? " DESC " : "") } keys %$order; | ||||
| 148 | } else { | |||||
| 149 | 0 | push @orders,$order; | ||||
| 150 | } | |||||
| 151 | } | |||||
| 152 | 0 0 | $sql.= do { local $"=', '; | ||||
| 153 | 0 | qq{ ORDER BY @orders} | ||||
| 154 | }; | |||||
| 155 | } | |||||
| 156 | 0 | if ($limit){ | ||||
| 157 | 0 | $sql.=qq{ LIMIT }.join(",",@$limit); | ||||
| 158 | } | |||||
| 159 | ||||||
| 160 | 0 | $debug && $values && warn $sql," ",join(",",@$values); | ||||
| 161 | 0 | $sth = $dbh->prepare_cached($sql); | ||||
| 162 | 0 0 | eval{$sth->execute(@$values)}; | ||||
| 163 | 0 | warn $@ if ($@ && $debug); | ||||
| 164 | 0 | my $results = $sth->fetchall_arrayref( {} ); | ||||
| 165 | 0 | return $results; | ||||
| 166 | } | |||||
| 167 | ||||||
| 168 - 174 | =head2 InsertInTable $data_id_in_table = &InsertInTable($tablename,$data_hashref,$withprimarykeys); Insert Data in table and returns the id of the row inserted =cut | |||||
| 175 | ||||||
| 176 | sub InsertInTable{ | |||||
| 177 | 0 | my ($tablename,$data,$withprimarykeys) = @_; | ||||
| 178 | 0 | my $dbh = C4::Context->dbh; | ||||
| 179 | 0 | my ($keys,$values)=_filter_hash($tablename,$data,($withprimarykeys?"exact":0)); | ||||
| 180 | 0 | my $query = qq{ INSERT INTO $tablename SET }.join(", ",@$keys); | ||||
| 181 | ||||||
| 182 | 0 | $debug && warn $query, join(",",@$values); | ||||
| 183 | 0 | my $sth = $dbh->prepare_cached($query); | ||||
| 184 | 0 0 | eval{$sth->execute(@$values)}; | ||||
| 185 | 0 | warn $@ if ($@ && $debug); | ||||
| 186 | ||||||
| 187 | 0 | return $dbh->last_insert_id(undef, undef, $tablename, undef); | ||||
| 188 | } | |||||
| 189 | ||||||
| 190 - 196 | =head2 UpdateInTable $status = &UpdateInTable($tablename,$data_hashref); Update Data in table and returns the status of the operation =cut | |||||
| 197 | ||||||
| 198 | sub UpdateInTable{ | |||||
| 199 | 0 | my ($tablename,$data) = @_; | ||||
| 200 | 0 | my @field_ids=GetPrimaryKeys($tablename); | ||||
| 201 | 0 | my @ids=@$data{@field_ids}; | ||||
| 202 | 0 | my $dbh = C4::Context->dbh; | ||||
| 203 | 0 | my ($keys,$values)=_filter_hash($tablename,$data,0); | ||||
| 204 | 0 | return unless ($keys); | ||||
| 205 | 0 | my $query = | ||||
| 206 | qq{ UPDATE $tablename | |||||
| 207 | SET }.join(",",@$keys).qq{ | |||||
| 208 | 0 | WHERE }.join (" AND ",map{ "$_=?" }@field_ids); | ||||
| 209 | 0 | $debug && warn $query, join(",",@$values,@ids); | ||||
| 210 | ||||||
| 211 | 0 | my $sth = $dbh->prepare_cached($query); | ||||
| 212 | 0 | my $result; | ||||
| 213 | 0 0 | eval{$result=$sth->execute(@$values,@ids)}; | ||||
| 214 | 0 | warn $@ if ($@ && $debug); | ||||
| 215 | 0 | return $result; | ||||
| 216 | } | |||||
| 217 | ||||||
| 218 - 224 | =head2 DeleteInTable $status = &DeleteInTable($tablename,$data_hashref); Delete Data in table and returns the status of the operation =cut | |||||
| 225 | ||||||
| 226 | sub DeleteInTable{ | |||||
| 227 | 0 | my ($tablename,$data) = @_; | ||||
| 228 | 0 | my $dbh = C4::Context->dbh; | ||||
| 229 | 0 | my ($keys,$values)=_filter_fields($tablename,$data,1); | ||||
| 230 | 0 | if ($keys){ | ||||
| 231 | 0 0 | my $query = do { local $"=') AND ('; | ||||
| 232 | 0 | qq{ DELETE FROM $tablename WHERE (@$keys)}; | ||||
| 233 | }; | |||||
| 234 | 0 | $debug && warn $query, join(",",@$values); | ||||
| 235 | 0 | my $sth = $dbh->prepare_cached($query); | ||||
| 236 | 0 | my $result; | ||||
| 237 | 0 0 | eval{$result=$sth->execute(@$values)}; | ||||
| 238 | 0 | warn $@ if ($@ && $debug); | ||||
| 239 | 0 | return $result; | ||||
| 240 | } | |||||
| 241 | } | |||||
| 242 | ||||||
| 243 - 249 | =head2 GetPrimaryKeys @primarykeys = &GetPrimaryKeys($tablename) Get the Primary Key field names of the table =cut | |||||
| 250 | ||||||
| 251 | sub GetPrimaryKeys($) { | |||||
| 252 | 0 | my $tablename=shift; | ||||
| 253 | 0 | my $hash_columns=_get_columns($tablename); | ||||
| 254 | 0 0 | return grep { $hash_columns->{$_}->{'Key'} =~/PRI/i} keys %$hash_columns; | ||||
| 255 | } | |||||
| 256 | ||||||
| 257 | ||||||
| 258 - 266 | =head2 clear_columns_cache C4::SQLHelper->clear_columns_cache(); cleans the internal cache of sysprefs. Please call this method if you update a tables structure. Otherwise, your new changes will not be seen by this process. =cut | |||||
| 267 | ||||||
| 268 | sub clear_columns_cache { | |||||
| 269 | 0 | %$hashref = (); | ||||
| 270 | } | |||||
| 271 | ||||||
| 272 | ||||||
| 273 | ||||||
| 274 - 285 | =head2 _get_columns
_get_columns($tablename)
Given a tablename
Returns a hashref of all the fieldnames of the table
With
Key
Type
Default
=cut | |||||
| 286 | ||||||
| 287 | sub _get_columns($) { | |||||
| 288 | 0 | my ($tablename) = @_; | ||||
| 289 | 0 | unless ( exists( $hashref->{$tablename} ) ) { | ||||
| 290 | 0 | my $dbh = C4::Context->dbh; | ||||
| 291 | 0 | my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename }); | ||||
| 292 | 0 | $sth->execute; | ||||
| 293 | 0 | my $columns = $sth->fetchall_hashref(qw(Field)); | ||||
| 294 | 0 | $hashref->{$tablename} = $columns; | ||||
| 295 | } | |||||
| 296 | 0 | return $hashref->{$tablename}; | ||||
| 297 | } | |||||
| 298 | ||||||
| 299 - 315 | =head2 _filter_columns =over 4 _filter_columns($tablename,$research, $filtercolumns) =back Given - a tablename - indicator on purpose whether all fields should be returned or only non Primary keys - array_ref to columns to limit to Returns an array of all the fieldnames of the table If it is not for research purpose, filter primary keys =cut | |||||
| 316 | ||||||
| 317 | sub _filter_columns ($$;$) { | |||||
| 318 | 0 | my ($tablename,$research, $filtercolumns)=@_; | ||||
| 319 | 0 | if ($filtercolumns){ | ||||
| 320 | 0 | return (@$filtercolumns); | ||||
| 321 | } | |||||
| 322 | else { | |||||
| 323 | 0 | my $columns=_get_columns($tablename); | ||||
| 324 | 0 | if ($research){ | ||||
| 325 | 0 | return keys %$columns; | ||||
| 326 | } | |||||
| 327 | else { | |||||
| 328 | 0 0 0 0 | return grep {my $column=$_; any {$_ ne $column }GetPrimaryKeys($tablename) } keys %$columns; | ||||
| 329 | } | |||||
| 330 | } | |||||
| 331 | } | |||||
| 332 - 345 | =head2 _filter_fields _filter_fields Given - a tablename - a string or a hashref (containing, fieldnames and datatofilter) or an arrayref to one of those elements - an indicator of operation whether it is a wide research or a narrow one - an array ref to columns to restrict string filter to. Returns a ref of key array to use in SQL functions and a ref to value array =cut | |||||
| 346 | ||||||
| 347 | sub _filter_fields{ | |||||
| 348 | 0 | my ($tablename,$filter_input,$searchtype,$filtercolumns)=@_; | ||||
| 349 | 0 | my @keys; | ||||
| 350 | 0 | my @values; | ||||
| 351 | 0 | if (ref($filter_input) eq "HASH"){ | ||||
| 352 | 0 | my ($keys, $values); | ||||
| 353 | 0 | if (my $special = delete $filter_input->{''}) { # XXX destroyes '' key | ||||
| 354 | 0 | ($keys, $values) = _filter_fields($tablename,$special, $searchtype,$filtercolumns); | ||||
| 355 | } | |||||
| 356 | 0 | my ($hkeys, $hvalues) = _filter_hash($tablename,$filter_input, $searchtype); | ||||
| 357 | 0 | if ($hkeys){ | ||||
| 358 | 0 | push @$keys, @$hkeys; | ||||
| 359 | 0 | push @$values, @$hvalues; | ||||
| 360 | } | |||||
| 361 | 0 | if ($keys){ | ||||
| 362 | 0 | my $stringkey="(".join (") AND (",@$keys).")"; | ||||
| 363 | 0 | return [$stringkey],$values; | ||||
| 364 | } | |||||
| 365 | else { | |||||
| 366 | 0 | return (); | ||||
| 367 | } | |||||
| 368 | } elsif (ref($filter_input) eq "ARRAY"){ | |||||
| 369 | 0 | foreach my $element_data (@$filter_input){ | ||||
| 370 | 0 | my ($localkeys,$localvalues)=_filter_fields($tablename,$element_data,$searchtype,$filtercolumns); | ||||
| 371 | 0 | if ($localkeys){ | ||||
| 372 | 0 0 | @$localkeys=grep{defined($_) && $_ !~/^\W*$/}@$localkeys; | ||||
| 373 | 0 | my $string=do{ | ||||
| 374 | 0 | local $"=") OR ("; | ||||
| 375 | 0 | qq{(@$localkeys)} | ||||
| 376 | }; | |||||
| 377 | 0 | push @keys, $string; | ||||
| 378 | 0 | push @values, @$localvalues; | ||||
| 379 | } | |||||
| 380 | } | |||||
| 381 | } | |||||
| 382 | else{ | |||||
| 383 | 0 | $debug && warn "filterstring : $filter_input"; | ||||
| 384 | 0 | my ($keys, $values) = _filter_string($tablename,$filter_input, $searchtype,$filtercolumns); | ||||
| 385 | 0 | if ($keys){ | ||||
| 386 | 0 | my $stringkey="(".join (") AND (",@$keys).")"; | ||||
| 387 | 0 | return [$stringkey],$values; | ||||
| 388 | } | |||||
| 389 | else { | |||||
| 390 | 0 | return (); | ||||
| 391 | } | |||||
| 392 | } | |||||
| 393 | ||||||
| 394 | 0 | return (\@keys,\@values); | ||||
| 395 | } | |||||
| 396 | ||||||
| 397 | sub _filter_hash{ | |||||
| 398 | 0 | my ($tablename,$filter_input, $searchtype)=@_; | ||||
| 399 | 0 | my (@values, @keys); | ||||
| 400 | 0 | my $columns= _get_columns($tablename); | ||||
| 401 | 0 | my @columns_filtered= _filter_columns($tablename,$searchtype); | ||||
| 402 | ||||||
| 403 | #Filter Primary Keys of table | |||||
| 404 | 0 | my $elements=join "|",@columns_filtered; | ||||
| 405 | 0 0 | 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 | 0 | $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 | 0 | my ($tmpkeys, $localvalues)=_Process_Operands($filter_input->{$field},"$tablename.$field",$searchtype,$columns); | ||||
| 411 | 0 | if (@$tmpkeys){ | ||||
| 412 | 0 | push @values, @$localvalues; | ||||
| 413 | 0 | push @keys, @$tmpkeys; | ||||
| 414 | } | |||||
| 415 | } | |||||
| 416 | 0 | if (@keys){ | ||||
| 417 | 0 | return (\@keys,\@values); | ||||
| 418 | } | |||||
| 419 | else { | |||||
| 420 | 0 | return (); | ||||
| 421 | } | |||||
| 422 | } | |||||
| 423 | ||||||
| 424 | sub _filter_string{ | |||||
| 425 | 0 | my ($tablename,$filter_input, $searchtype,$filtercolumns)=@_; | ||||
| 426 | 0 | return () unless($filter_input); | ||||
| 427 | 0 | my @operands=split /\s+/,$filter_input; | ||||
| 428 | ||||||
| 429 | # An act of desperation | |||||
| 430 | 0 | $searchtype = 'contain' if @operands > 1 && $searchtype =~ /start_with/o; | ||||
| 431 | ||||||
| 432 | 0 | my @columns_filtered= _filter_columns($tablename,$searchtype,$filtercolumns); | ||||
| 433 | 0 | my $columns= _get_columns($tablename); | ||||
| 434 | 0 | my (@values,@keys); | ||||
| 435 | 0 | foreach my $operand (@operands){ | ||||
| 436 | 0 | my @localkeys; | ||||
| 437 | 0 | foreach my $field (@columns_filtered){ | ||||
| 438 | 0 | my ($tmpkeys, $localvalues)=_Process_Operands($operand,"$tablename.$field",$searchtype,$columns); | ||||
| 439 | 0 | if ($tmpkeys){ | ||||
| 440 | 0 | push @values,@$localvalues; | ||||
| 441 | 0 | push @localkeys,@$tmpkeys; | ||||
| 442 | } | |||||
| 443 | } | |||||
| 444 | 0 | my $sql= join (' OR ', @localkeys); | ||||
| 445 | 0 | push @keys, $sql; | ||||
| 446 | } | |||||
| 447 | ||||||
| 448 | 0 | if (@keys){ | ||||
| 449 | 0 | return (\@keys,\@values); | ||||
| 450 | } | |||||
| 451 | else { | |||||
| 452 | 0 | return (); | ||||
| 453 | } | |||||
| 454 | } | |||||
| 455 | sub _Process_Operands{ | |||||
| 456 | 0 | my ($operand, $field, $searchtype,$columns)=@_; | ||||
| 457 | 0 | my @values; | ||||
| 458 | 0 | my @tmpkeys; | ||||
| 459 | 0 | my @localkeys; | ||||
| 460 | ||||||
| 461 | 0 | $operand = [$operand] unless ref $operand eq 'ARRAY'; | ||||
| 462 | 0 | foreach (@$operand) { | ||||
| 463 | 0 | push @tmpkeys, " $field = ? "; | ||||
| 464 | 0 | push @values, $_; | ||||
| 465 | } | |||||
| 466 | #By default, exact search | |||||
| 467 | 0 | if (!$searchtype ||$searchtype eq "exact"){ | ||||
| 468 | 0 | return \@tmpkeys,\@values; | ||||
| 469 | } | |||||
| 470 | 0 | my $col_field=(index($field,".")>0?substr($field, index($field,".")+1):$field); | ||||
| 471 | 0 | if ($field=~/(?<!zip)code|(?<!card)number/ && $searchtype ne "exact"){ | ||||
| 472 | 0 | push @tmpkeys,(" $field= '' ","$field IS NULL"); | ||||
| 473 | } | |||||
| 474 | 0 | if ($columns->{$col_field}->{Type}=~/varchar|text/i){ | ||||
| 475 | 0 | my @localvaluesextended; | ||||
| 476 | 0 | if ($searchtype eq "contain"){ | ||||
| 477 | 0 | foreach (@$operand) { | ||||
| 478 | 0 | push @tmpkeys,(" $field LIKE ? "); | ||||
| 479 | 0 | push @localvaluesextended,("\%$_\%") ; | ||||
| 480 | } | |||||
| 481 | } | |||||
| 482 | 0 | if ($searchtype eq "field_start_with"){ | ||||
| 483 | 0 | foreach (@$operand) { | ||||
| 484 | 0 | push @tmpkeys,("$field LIKE ?"); | ||||
| 485 | 0 | push @localvaluesextended, ("$_\%") ; | ||||
| 486 | } | |||||
| 487 | } | |||||
| 488 | 0 | if ($searchtype eq "start_with"){ | ||||
| 489 | 0 | foreach (@$operand) { | ||||
| 490 | 0 | push @tmpkeys,("$field LIKE ?","$field LIKE ?"); | ||||
| 491 | 0 | push @localvaluesextended, ("$_\%", " $_\%") ; | ||||
| 492 | } | |||||
| 493 | } | |||||
| 494 | 0 | push @values,@localvaluesextended; | ||||
| 495 | } | |||||
| 496 | 0 | push @localkeys,qq{ (}.join(" OR ",@tmpkeys).qq{) }; | ||||
| 497 | 0 | return (\@localkeys,\@values); | ||||
| 498 | } | |||||
| 499 | 1; | |||||
| 500 | ||||||