File Coverage

File:C4/SQLHelper.pm
Coverage:9.3%

linestmtbrancondsubtimecode
1package 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
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
21
30
30
30
391
223
1165
use strict;
22
30
30
30
521
224
1600
use warnings;
23
30
30
30
2730
14732
2253
use List::MoreUtils qw(first_value any);
24
30
30
30
533
222
504
use C4::Context;
25
30
30
30
591
153
1842
use C4::Dates qw(format_date_in_iso);
26
30
30
30
242
87
2985
use C4::Debug;
27require Exporter;
28
30
30
30
180
81
7201
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
29
30eval {
31    my $servers = C4::Context->config('memcached_servers');
32    if ($servers) {
33        require Memoize::Memcached;
34        import Memoize::Memcached qw(memoize_memcached);
35
36        my $memcached = {
37            servers => [$servers],
38            key_prefix => C4::Context->config('memcached_namespace') || 'koha',
39            expire_time => 600
40        }; # cache for 10 mins
41
42        memoize_memcached( '_get_columns', memcached => $memcached );
43        memoize_memcached( 'GetPrimaryKeys', memcached => $memcached );
44    }
45};
46
47BEGIN {
48        # set the version for version checking
49
30
99
        $VERSION = 0.5;
50
30
169
        require Exporter;
51
30
592
        @ISA = qw(Exporter);
52
30
297
@EXPORT_OK=qw(
53        InsertInTable
54        DeleteInTable
55        SearchInTable
56        UpdateInTable
57        GetPrimaryKeys
58        clear_columns_cache
59);
60
30
87816
        %EXPORT_TAGS = ( all =>[qw( InsertInTable DeleteInTable SearchInTable UpdateInTable GetPrimaryKeys)]
61                                );
62}
63
64my $tablename;
65my $hashref;
66
67 - 121
=head1 NAME

C4::SQLHelper - Perl Module containing convenience functions for SQL Handling

=head1 SYNOPSIS

use C4::SQLHelper;

=head1 DESCRIPTION

This module contains routines for adding, modifying and Searching Data in MysqlDB 

=head1 FUNCTIONS

=head2 SearchInTable

  $hashref = &SearchInTable($tablename,$data, $orderby, $limit, 
                      $columns_out, $filtercolumns, $searchtype);


$tablename Name of the table (string)

$data may contain 
	- string

	- data_hashref : will be considered as an AND of all the data searched

	- data_array_ref on hashrefs : Will be considered as an OR of Datahasref elements

$orderby is an arrayref of hashref with fieldnames as key and 0 or 1 as values (ASCENDING or DESCENDING order)

$limit is an array ref on 2 values in order to limit results to MIN..MAX

$columns_out is an array ref on field names is used to limit results on those fields (* by default)

$filtercolums is an array ref on field names : is used to limit expansion of research for strings

$searchtype is string Can be "start_with" or "exact" 

This query builder is very limited, it should be replaced with DBIx::Class
or similar  very soon
Meanwhile adding support for special key '' in case of a data_hashref to
support filters of type

  ( f1 = a OR f2 = a ) AND fx = b AND fy = c

Call for the query above is:

  SearchInTable($tablename, {'' => a, fx => b, fy => c}, $orderby, $limit,
                $columns_out, [f1, f2], 'exact');

NOTE: Current implementation may remove parts of the iinput hashrefs. If that is a problem
a copy needs to be created in _filter_fields() below

=cut
122
123sub SearchInTable{
124
0
    my ($tablename,$filters,$orderby, $limit, $columns_out, $filter_columns,$searchtype) = @_;
125
0
        $searchtype||="exact";
126
0
    my $dbh = C4::Context->dbh;
127
0
        $columns_out||=["*"];
128
0
0
    my $sql = do { local $"=', ';
129
0
                qq{ SELECT @$columns_out from $tablename}
130               };
131
0
    my $row;
132
0
    my $sth;
133
0
    my ($keys,$values)=_filter_fields($tablename,$filters,$searchtype,$filter_columns);
134
0
        if ($keys){
135
0
0
                my @criteria=grep{defined($_) && $_ !~/^\W$/ }@$keys;
136
0
                if (@criteria) {
137
0
0
                        $sql.= do { local $"=') OR (';
138
0
                                        qq{ WHERE (@criteria) }
139                                   };
140                }
141        }
142
0
    if ($orderby){
143                #Order by desc by default
144
0
                my @orders;
145
0
                foreach my $order ( ref($orderby) ? @$orderby : $orderby ){
146
0
            if (ref $order) {
147
0
0
                            push @orders,map{ "$_".($order->{$_}? " DESC " : "") } keys %$order;
148            } else {
149
0
                            push @orders,$order;
150            }
151                }
152
0
0
                $sql.= do { local $"=', ';
153
0
                                qq{ ORDER BY @orders}
154        };
155    }
156
0
        if ($limit){
157
0
                $sql.=qq{ LIMIT }.join(",",@$limit);
158        }
159
160
0
    $debug && $values && warn $sql," ",join(",",@$values);
161
0
    $sth = $dbh->prepare_cached($sql);
162
0
0
    eval{$sth->execute(@$values)};
163
0
        warn $@ if ($@ && $debug);
164
0
    my $results = $sth->fetchall_arrayref( {} );
165
0
    return $results;
166}
167
168 - 174
=head2 InsertInTable

  $data_id_in_table = &InsertInTable($tablename,$data_hashref,$withprimarykeys);

Insert Data in table and returns the id of the row inserted

=cut
175
176sub InsertInTable{
177
0
    my ($tablename,$data,$withprimarykeys) = @_;
178
0
    my $dbh = C4::Context->dbh;
179
0
    my ($keys,$values)=_filter_hash($tablename,$data,($withprimarykeys?"exact":0));
180
0
    my $query = qq{ INSERT INTO $tablename SET }.join(", ",@$keys);
181
182
0
        $debug && warn $query, join(",",@$values);
183
0
    my $sth = $dbh->prepare_cached($query);
184
0
0
    eval{$sth->execute(@$values)};
185
0
        warn $@ if ($@ && $debug);
186
187
0
        return $dbh->last_insert_id(undef, undef, $tablename, undef);
188}
189
190 - 196
=head2 UpdateInTable

  $status = &UpdateInTable($tablename,$data_hashref);

Update Data in table and returns the status of the operation

=cut
197
198sub UpdateInTable{
199
0
    my ($tablename,$data) = @_;
200
0
        my @field_ids=GetPrimaryKeys($tablename);
201
0
    my @ids=@$data{@field_ids};
202
0
    my $dbh = C4::Context->dbh;
203
0
    my ($keys,$values)=_filter_hash($tablename,$data,0);
204
0
    return unless ($keys);
205
0
    my $query =
206    qq{ UPDATE $tablename
207            SET }.join(",",@$keys).qq{
208
0
            WHERE }.join (" AND ",map{ "$_=?" }@field_ids);
209
0
        $debug && warn $query, join(",",@$values,@ids);
210
211
0
    my $sth = $dbh->prepare_cached($query);
212
0
        my $result;
213
0
0
    eval{$result=$sth->execute(@$values,@ids)};
214
0
        warn $@ if ($@ && $debug);
215
0
    return $result;
216}
217
218 - 224
=head2 DeleteInTable

  $status = &DeleteInTable($tablename,$data_hashref);

Delete Data in table and returns the status of the operation

=cut
225
226sub DeleteInTable{
227
0
    my ($tablename,$data) = @_;
228
0
    my $dbh = C4::Context->dbh;
229
0
    my ($keys,$values)=_filter_fields($tablename,$data,1);
230
0
        if ($keys){
231
0
0
                my $query = do { local $"=') AND (';
232
0
                qq{ DELETE FROM $tablename WHERE (@$keys)};
233                };
234
0
                $debug && warn $query, join(",",@$values);
235
0
                my $sth = $dbh->prepare_cached($query);
236
0
     my $result;
237
0
0
     eval{$result=$sth->execute(@$values)};
238
0
                warn $@ if ($@ && $debug);
239
0
     return $result;
240        }
241}
242
243 - 249
=head2 GetPrimaryKeys

  @primarykeys = &GetPrimaryKeys($tablename)

Get the Primary Key field names of the table

=cut
250
251sub GetPrimaryKeys($) {
252
0
        my $tablename=shift;
253
0
        my $hash_columns=_get_columns($tablename);
254
0
0
        return grep { $hash_columns->{$_}->{'Key'} =~/PRI/i} keys %$hash_columns;
255}
256
257
258 - 266
=head2 clear_columns_cache

  C4::SQLHelper->clear_columns_cache();

cleans the internal cache of sysprefs. Please call this method if
you update a tables structure. Otherwise, your new changes
will not be seen by this process.

=cut
267
268sub clear_columns_cache {
269
0
    %$hashref = ();
270}
271
272
273
274 - 285
=head2 _get_columns

    _get_columns($tablename)

Given a tablename 
Returns a hashref of all the fieldnames of the table
With 
	Key
	Type
	Default

=cut
286
287sub _get_columns($) {
288
0
    my ($tablename) = @_;
289
0
    unless ( exists( $hashref->{$tablename} ) ) {
290
0
        my $dbh = C4::Context->dbh;
291
0
        my $sth = $dbh->prepare_cached(qq{SHOW COLUMNS FROM $tablename });
292
0
        $sth->execute;
293
0
        my $columns = $sth->fetchall_hashref(qw(Field));
294
0
        $hashref->{$tablename} = $columns;
295    }
296
0
    return $hashref->{$tablename};
297}
298
299 - 315
=head2 _filter_columns

=over 4

_filter_columns($tablename,$research, $filtercolumns)

=back

Given 
	- a tablename 
	- indicator on purpose whether all fields should be returned or only non Primary keys
	- array_ref to columns to limit to

Returns an array of all the fieldnames of the table
If it is not for research purpose, filter primary keys

=cut
316
317sub _filter_columns ($$;$) {
318
0
        my ($tablename,$research, $filtercolumns)=@_;
319
0
        if ($filtercolumns){
320
0
                return (@$filtercolumns);
321        }
322        else {
323
0
                my $columns=_get_columns($tablename);
324
0
                if ($research){
325
0
                        return keys %$columns;
326                }
327                else {
328
0
0
0
0
                        return grep {my $column=$_; any {$_ ne $column }GetPrimaryKeys($tablename) } keys %$columns;
329                }
330        }
331}
332 - 345
=head2 _filter_fields

  _filter_fields

Given 
	- a tablename
	- a string or a hashref (containing, fieldnames and datatofilter) or an arrayref to one of those elements
	- an indicator of operation whether it is a wide research or a narrow one
	- an array ref to columns to restrict string filter to.

Returns a ref of key array to use in SQL functions
and a ref to value array

=cut
346
347sub _filter_fields{
348
0
        my ($tablename,$filter_input,$searchtype,$filtercolumns)=@_;
349
0
    my @keys;
350
0
        my @values;
351
0
        if (ref($filter_input) eq "HASH"){
352
0
                my ($keys, $values);
353
0
        if (my $special = delete $filter_input->{''}) { # XXX destroyes '' key
354
0
                    ($keys, $values) = _filter_fields($tablename,$special, $searchtype,$filtercolumns);
355        }
356
0
                my ($hkeys, $hvalues) = _filter_hash($tablename,$filter_input, $searchtype);
357
0
                if ($hkeys){
358
0
            push @$keys, @$hkeys;
359
0
            push @$values, @$hvalues;
360        }
361
0
                if ($keys){
362
0
                    my $stringkey="(".join (") AND (",@$keys).")";
363
0
                    return [$stringkey],$values;
364                }
365                else {
366
0
                    return ();
367                }
368        } elsif (ref($filter_input) eq "ARRAY"){
369
0
                foreach my $element_data (@$filter_input){
370
0
                        my ($localkeys,$localvalues)=_filter_fields($tablename,$element_data,$searchtype,$filtercolumns);
371
0
                        if ($localkeys){
372
0
0
                                @$localkeys=grep{defined($_) && $_ !~/^\W*$/}@$localkeys;
373
0
                                my $string=do{
374
0
                                                                local $"=") OR (";
375
0
                                                                qq{(@$localkeys)}
376                                                        };
377
0
                                push @keys, $string;
378
0
                                push @values, @$localvalues;
379                        }
380                }
381        }
382        else{
383
0
        $debug && warn "filterstring : $filter_input";
384
0
                my ($keys, $values) = _filter_string($tablename,$filter_input, $searchtype,$filtercolumns);
385
0
                if ($keys){
386
0
                my $stringkey="(".join (") AND (",@$keys).")";
387
0
                return [$stringkey],$values;
388                }
389                else {
390
0
                return ();
391                }
392        }
393
394
0
        return (\@keys,\@values);
395}
396
397sub _filter_hash{
398
0
        my ($tablename,$filter_input, $searchtype)=@_;
399
0
        my (@values, @keys);
400
0
        my $columns= _get_columns($tablename);
401
0
        my @columns_filtered= _filter_columns($tablename,$searchtype);
402
403        #Filter Primary Keys of table
404
0
    my $elements=join "|",@columns_filtered;
405
0
0
        foreach my $field (grep {/\b($elements)\b/} keys %$filter_input){
406                ## supposed to be a hash of simple values, hashes of arrays could be implemented
407
0
                $filter_input->{$field}=format_date_in_iso($filter_input->{$field})
408          if $columns->{$field}{Type}=~/date/ &&
409             $filter_input->{$field} !~C4::Dates->regexp("iso");
410
0
                my ($tmpkeys, $localvalues)=_Process_Operands($filter_input->{$field},"$tablename.$field",$searchtype,$columns);
411
0
                if (@$tmpkeys){
412
0
                        push @values, @$localvalues;
413
0
                        push @keys, @$tmpkeys;
414                }
415        }
416
0
        if (@keys){
417
0
                return (\@keys,\@values);
418        }
419        else {
420
0
                return ();
421        }
422}
423
424sub _filter_string{
425
0
        my ($tablename,$filter_input, $searchtype,$filtercolumns)=@_;
426
0
        return () unless($filter_input);
427
0
        my @operands=split /\s+/,$filter_input;
428
429    # An act of desperation
430
0
    $searchtype = 'contain' if @operands > 1 && $searchtype =~ /start_with/o;
431
432
0
        my @columns_filtered= _filter_columns($tablename,$searchtype,$filtercolumns);
433
0
        my $columns= _get_columns($tablename);
434
0
        my (@values,@keys);
435
0
        foreach my $operand (@operands){
436
0
                my @localkeys;
437
0
                foreach my $field (@columns_filtered){
438
0
                        my ($tmpkeys, $localvalues)=_Process_Operands($operand,"$tablename.$field",$searchtype,$columns);
439
0
                        if ($tmpkeys){
440
0
                                push @values,@$localvalues;
441
0
                                push @localkeys,@$tmpkeys;
442                        }
443                }
444
0
                my $sql= join (' OR ', @localkeys);
445
0
                push @keys, $sql;
446        }
447
448
0
        if (@keys){
449
0
                return (\@keys,\@values);
450        }
451        else {
452
0
                return ();
453        }
454}
455sub _Process_Operands{
456
0
        my ($operand, $field, $searchtype,$columns)=@_;
457
0
        my @values;
458
0
        my @tmpkeys;
459
0
        my @localkeys;
460
461
0
    $operand = [$operand] unless ref $operand eq 'ARRAY';
462
0
    foreach (@$operand) {
463
0
            push @tmpkeys, " $field = ? ";
464
0
            push @values, $_;
465    }
466        #By default, exact search
467
0
        if (!$searchtype ||$searchtype eq "exact"){
468
0
                return \@tmpkeys,\@values;
469        }
470
0
        my $col_field=(index($field,".")>0?substr($field, index($field,".")+1):$field);
471
0
        if ($field=~/(?<!zip)code|(?<!card)number/ && $searchtype ne "exact"){
472
0
                push @tmpkeys,(" $field= '' ","$field IS NULL");
473        }
474
0
        if ($columns->{$col_field}->{Type}=~/varchar|text/i){
475
0
                my @localvaluesextended;
476
0
                if ($searchtype eq "contain"){
477
0
            foreach (@$operand) {
478
0
                            push @tmpkeys,(" $field LIKE ? ");
479
0
                            push @localvaluesextended,("\%$_\%") ;
480            }
481                }
482
0
                if ($searchtype eq "field_start_with"){
483
0
            foreach (@$operand) {
484
0
                            push @tmpkeys,("$field LIKE ?");
485
0
                            push @localvaluesextended, ("$_\%") ;
486            }
487                }
488
0
                if ($searchtype eq "start_with"){
489
0
            foreach (@$operand) {
490
0
                            push @tmpkeys,("$field LIKE ?","$field LIKE ?");
491
0
                            push @localvaluesextended, ("$_\%", " $_\%") ;
492            }
493                }
494
0
                push @values,@localvaluesextended;
495        }
496
0
        push @localkeys,qq{ (}.join(" OR ",@tmpkeys).qq{) };
497
0
        return (\@localkeys,\@values);
498}
4991;
500