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