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