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