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