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 =cut
  89
  90 sub SearchInTable{
  91     my ($tablename,$filters,$orderby, $limit, $columns_out, $filter_columns,$searchtype) = @_;
  92         $searchtype||="exact";
  93     my $dbh      = C4::Context->dbh;
  94         $columns_out||=["*"];
  95     my $sql      = do { local $"=', ';
  96                 qq{ SELECT @$columns_out from $tablename}
  97                };
  98     my $row;
  99     my $sth;
 100     my ($keys,$values)=_filter_fields($tablename,$filters,$searchtype,$filter_columns);
 101         if ($keys){
 102                 my @criteria=grep{defined($_) && $_ !~/^\W$/ }@$keys;
 103                 if (@criteria) {
 104                         $sql.= do { local $"=') AND (';
 105                                         qq{ WHERE (@criteria) }
 106                                    };
 107                 }
 108         }
 109     if ($orderby){
 110                 #Order by desc by default
 111                 my @orders;
 112                 foreach my $order (@$orderby){
 113                         push @orders,map{ "$_".($order->{$_}? " DESC " : "") } keys %$order;
 114                 }
 115                 $sql.= do { local $"=', ';
 116                                 qq{ ORDER BY @orders}
 117         };
 118     }
 119         if ($limit){
 120                 $sql.=qq{ LIMIT }.join(",",@$limit);
 121         }
 122
 123     $debug && $values && warn $sql," ",join(",",@$values);
 124     $sth = $dbh->prepare_cached($sql);
 125     eval{$sth->execute(@$values)};
 126         warn $@ if ($@ && $debug);
 127     my $results = $sth->fetchall_arrayref( {} );
 128     return $results;
 129 }
 130
 131 =head2 InsertInTable
 132
 133   $data_id_in_table = &InsertInTable($tablename,$data_hashref,$withprimarykeys);
 134
 135 Insert Data in table and returns the id of the row inserted
 136
 137 =cut
 138
 139 sub InsertInTable{
 140     my ($tablename,$data,$withprimarykeys) = @_;
 141     my $dbh      = C4::Context->dbh;
 142     my ($keys,$values)=_filter_hash($tablename,$data,($withprimarykeys?"exact":0));
 143     my $query = qq{ INSERT INTO $tablename SET  }.join(", ",@$keys);
 144
 145         $debug && warn $query, join(",",@$values);
 146     my $sth = $dbh->prepare_cached($query);
 147     eval{$sth->execute(@$values)};
 148         warn $@ if ($@ && $debug);
 149
 150         return $dbh->last_insert_id(undef, undef, $tablename, undef);
 151 }
 152
 153 =head2 UpdateInTable
 154
 155   $status = &UpdateInTable($tablename,$data_hashref);
 156
 157 Update Data in table and returns the status of the operation
 158
 159 =cut
 160
 161 sub UpdateInTable{
 162     my ($tablename,$data) = @_;
 163         my @field_ids=GetPrimaryKeys($tablename);
 164     my @ids=@$data{@field_ids};
 165     my $dbh      = C4::Context->dbh;
 166     my ($keys,$values)=_filter_hash($tablename,$data,0);
 167     my $query =
 168     qq{     UPDATE $tablename
 169             SET  }.join(",",@$keys).qq{
 170             WHERE }.join (" AND ",map{ "$_=?" }@field_ids);
 171         $debug && warn $query, join(",",@$values,@ids);
 172
 173     my $sth = $dbh->prepare_cached($query);
 174         my $result;
 175     eval{$result=$sth->execute(@$values,@ids)};
 176         warn $@ if ($@ && $debug);
 177     return $result;
 178 }
 179
 180 =head2 DeleteInTable
 181
 182   $status = &DeleteInTable($tablename,$data_hashref);
 183
 184 Delete Data in table and returns the status of the operation
 185
 186 =cut
 187
 188 sub DeleteInTable{
 189     my ($tablename,$data) = @_;
 190     my $dbh      = C4::Context->dbh;
 191     my ($keys,$values)=_filter_fields($tablename,$data,1);
 192         if ($keys){
 193                 my $query = do { local $"=') AND (';
 194                 qq{ DELETE FROM $tablename WHERE (@$keys)};
 195                 };
 196                 $debug && warn $query, join(",",@$values);
 197                 my $sth = $dbh->prepare_cached($query);
 198                 my $result;
 199         eval{$result=$sth->execute(@$values)};
 200                 warn $@ if ($@ && $debug);
 201         return $result;
 202         }
 203 }
 204
 205 =head2 GetPrimaryKeys
 206
 207   @primarykeys = &GetPrimaryKeys($tablename)
 208
 209 Get the Primary Key field names of the table
 210
 211 =cut
 212
 213 sub GetPrimaryKeys($) {
 214         my $tablename=shift;
 215         my $hash_columns=_get_columns($tablename);
 216         return  grep { $hash_columns->{$_}->{'Key'} =~/PRI/i}  keys %$hash_columns;
 217 }
 218
 219 =head2 _get_columns
 220
 221     _get_columns($tablename)
 222
 223 Given a tablename
 224 Returns a hashref of all the fieldnames of the table
 225 With
 226         Key
 227         Type
 228         Default
 229
 230 =cut
 231
 232 sub _get_columns($) {
 233         my ($tablename)=@_;
 234         my $dbh=C4::Context->dbh;
 235         my $sth=$dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename });
 236         $sth->execute;
 237     my $columns= $sth->fetchall_hashref(qw(Field));
 238 }
 239
 240 =head2 _filter_columns
 241
 242     _filter_columns($tablename,$research, $filtercolumns)
 243
 244 Given
 245         - a tablename
 246         - indicator on purpose whether all fields should be returned or only non Primary keys
 247         - array_ref to columns to limit to
 248
 249 Returns an array of all the fieldnames of the table
 250 If it is not for research purpose, filter primary keys
 251
 252 =cut
 253
 254 sub _filter_columns ($$;$) {
 255         my ($tablename,$research, $filtercolumns)=@_;
 256         if ($filtercolumns){
 257                 return (@$filtercolumns);
 258         }
 259         else {
 260                 my $columns=_get_columns($tablename);
 261                 if ($research){
 262                         return keys %$columns;
 263                 }
 264                 else {
 265                         return grep {my $column=$_; any {$_ ne $column }GetPrimaryKeys($tablename) } keys %$columns;
 266                 }
 267         }
 268 }
 269 =head2 _filter_fields
 270
 271   _filter_fields
 272
 273 Given
 274         - a tablename
 275         - a string or a hashref (containing, fieldnames and datatofilter) or an arrayref to one of those elements
 276         - an indicator of operation whether it is a wide research or a narrow one
 277         - an array ref to columns to restrict string filter to.
 278
 279 Returns a ref of key array to use in SQL functions
 280 and a ref to value array
 281
 282 =cut
 283
 284 sub _filter_fields{
 285         my ($tablename,$filter_input,$searchtype,$filtercolumns)=@_;
 286     my @keys;
 287         my @values;
 288         if (ref($filter_input) eq "HASH"){
 289                 my ($keys, $values) = _filter_hash($tablename,$filter_input, $searchtype);
 290                 if ($keys){
 291                 my $stringkey="(".join (") AND (",@$keys).")";
 292                 return [$stringkey],$values;
 293                 }
 294                 else {
 295                 return ();
 296                 }
 297         } elsif (ref($filter_input) eq "ARRAY"){
 298                 foreach my $element_data (@$filter_input){
 299                         my ($localkeys,$localvalues)=_filter_fields($tablename,$element_data,$searchtype,$filtercolumns);
 300                         if ($localkeys){
 301                                 @$localkeys=grep{defined($_) && $_ !~/^\W*$/}@$localkeys;
 302                                 my $string=do{
 303                                                                 local $"=") OR (";
 304                                                                 qq{(@$localkeys)}
 305                                                         };
 306                                 push @keys, $string;
 307                                 push @values, @$localvalues;
 308                         }
 309                 }
 310         }
 311         else{
 312         $debug && warn "filterstring : $filter_input";
 313                 my ($keys, $values) = _filter_string($tablename,$filter_input, $searchtype,$filtercolumns);
 314                 if ($keys){
 315                 my $stringkey="(".join (") AND (",@$keys).")";
 316                 return [$stringkey],$values;
 317                 }
 318                 else {
 319                 return ();
 320                 }
 321         }
 322
 323         return (\@keys,\@values);
 324 }
 325
 326 sub _filter_hash{
 327         my ($tablename,$filter_input, $searchtype)=@_;
 328         my (@values, @keys);
 329         my $columns= _get_columns($tablename);
 330         my @columns_filtered= _filter_columns($tablename,$searchtype);
 331
 332         #Filter Primary Keys of table
 333     my $elements=join "|",@columns_filtered;
 334         foreach my $field (grep {/\b($elements)\b/} keys %$filter_input){
 335                 ## supposed to be a hash of simple values, hashes of arrays could be implemented
 336                 $filter_input->{$field}=format_date_in_iso($filter_input->{$field}) if ($columns->{$field}{Type}=~/date/ && $filter_input->{$field} !~C4::Dates->regexp("iso"));
 337                 my ($tmpkeys, $localvalues)=_Process_Operands($filter_input->{$field},"$tablename.$field",$searchtype,$columns);
 338                 if (@$tmpkeys){
 339                         push @values, @$localvalues;
 340                         push @keys, @$tmpkeys;
 341                 }
 342         }
 343         if (@keys){
 344                 return (\@keys,\@values);
 345         }
 346         else {
 347                 return ();
 348         }
 349 }
 350
 351 sub _filter_string{
 352         my ($tablename,$filter_input, $searchtype,$filtercolumns)=@_;
 353         return () unless($filter_input);
 354         my @operands=split / /,$filter_input;
 355         my @columns_filtered= _filter_columns($tablename,$searchtype,$filtercolumns);
 356         my $columns= _get_columns($tablename);
 357         my (@values,@keys);
 358         foreach my $operand (@operands){
 359                 my @localkeys;
 360                 foreach my $field (@columns_filtered){
 361                         my ($tmpkeys, $localvalues)=_Process_Operands($operand,"$tablename.$field",$searchtype,$columns);
 362                         if ($tmpkeys){
 363                                 push @values,@$localvalues;
 364                                 push @localkeys,@$tmpkeys;
 365                         }
 366                 }
 367                 my $sql= join (' OR ', @localkeys);
 368                 push @keys, $sql;
 369         }
 370
 371         if (@keys){
 372                 return (\@keys,\@values);
 373         }
 374         else {
 375                 return ();
 376         }
 377 }
 378 sub _Process_Operands{
 379         my ($operand, $field, $searchtype,$columns)=@_;
 380         my @values;
 381         my @tmpkeys;
 382         my @localkeys;
 383         push @tmpkeys, " $field = ? ";
 384         push @values, $operand;
 385         #By default, exact search
 386         if (!$searchtype ||$searchtype eq "exact"){
 387                 return \@tmpkeys,\@values;
 388         }
 389         my $col_field=(index($field,".")>0?substr($field, index($field,".")+1):$field);
 390         if ($field=~/(?<!zip)code|(?<!card)number/ && $searchtype ne "exact"){
 391                 push @tmpkeys,(" $field= '' ","$field IS NULL");
 392         }
 393         if ($columns->{$col_field}->{Type}=~/varchar|text/i){
 394                 my @localvaluesextended;
 395                 if ($searchtype eq "contain"){
 396                         push @tmpkeys,(" $field LIKE ? ");
 397                         push @localvaluesextended,("\%$operand\%") ;
 398                 }
 399                 if ($searchtype eq "field_start_with"){
 400                         push @tmpkeys,("$field LIKE ?");
 401                         push @localvaluesextended, ("$operand\%") ;
 402                 }
 403                 if ($searchtype eq "start_with"){
 404                         push @tmpkeys,("$field LIKE ?","$field LIKE ?");
 405                         push @localvaluesextended, ("$operand\%", " $operand\%") ;
 406                 }
 407                 push @values,@localvaluesextended;
 408         }
 409         push @localkeys,qq{ (}.join(" OR ",@tmpkeys).qq{) };
 410         return (\@localkeys,\@values);
 411 }
 412 1;
 413