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