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