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