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