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