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