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