(I)LIKE-Argumente immer mit Funktion SL::DBUtils::like erstellen
[kivitendo-erp.git] / SL / DBUtils.pm
1 package SL::DBUtils;
2
3 use SL::Util qw(trim);
4
5 require Exporter;
6 our @ISA = qw(Exporter);
7
8 our @EXPORT = qw(conv_i conv_date conv_dateq do_query selectrow_query do_statement
9              dump_query quote_db_date like
10              selectfirst_hashref_query selectfirst_array_query
11              selectall_hashref_query selectall_array_query
12              selectall_as_map
13              selectall_ids
14              prepare_execute_query prepare_query
15              create_sort_spec does_table_exist
16              add_token);
17
18 use strict;
19
20 sub conv_i {
21   my ($value, $default) = @_;
22   return (defined($value) && "$value" ne "") ? $value * 1 : $default;
23 }
24
25 # boolean escape
26 sub conv_b {
27   my ($value, $default) = @_;
28   return !defined $value && defined $default ? $default
29        :          $value                     ? 't'
30        :                                       'f';
31 }
32
33 sub conv_date {
34   my ($value) = @_;
35   return undef if !defined $value;
36   $value = trim($value);
37   return $value eq "" ? undef : $value;
38 }
39
40 sub conv_dateq {
41   my ($value) = @_;
42   if (defined($value) && "$value" ne "") {
43     $value =~ s/\'/\'\'/g;
44     return "'$value'";
45   }
46   return "NULL";
47 }
48
49 sub do_query {
50   $main::lxdebug->enter_sub(2);
51
52   my ($form, $dbh, $query) = splice(@_, 0, 3);
53
54   dump_query(LXDebug->QUERY(), '', $query, @_);
55
56   my $result;
57   if (0 == scalar(@_)) {
58     $result = $dbh->do($query)            || $form->dberror($query);
59   } else {
60     $result = $dbh->do($query, undef, @_) || $form->dberror($query . " (" . join(", ", @_) . ")");
61   }
62
63   $main::lxdebug->leave_sub(2);
64
65   return $result;
66 }
67
68 sub selectrow_query { &selectfirst_array_query }
69
70 sub do_statement {
71   $main::lxdebug->enter_sub(2);
72
73   my ($form, $sth, $query) = splice(@_, 0, 3);
74
75   dump_query(LXDebug->QUERY(), '', $query, @_);
76
77   my $result;
78   if (0 == scalar(@_)) {
79     $result = $sth->execute()   || $form->dberror($query);
80   } else {
81     $result = $sth->execute(@_) || $form->dberror($query . " (" . join(", ", @_) . ")");
82   }
83
84   $main::lxdebug->leave_sub(2);
85
86   return $result;
87 }
88
89 sub dump_query {
90   my ($level, $msg, $query) = splice(@_, 0, 3);
91
92   my $self_filename = 'SL/DBUtils.pm';
93   my $filename      = $self_filename;
94   my ($caller_level, $line, $subroutine);
95   while ($filename eq $self_filename) {
96     (undef, $filename, $line, $subroutine) = caller $caller_level++;
97   }
98
99   while ($query =~ /\?/) {
100     my $value = shift || '';
101     $value =~ s/\'/\\\'/g;
102     $value = "'${value}'";
103     $query =~ s/\?/$value/;
104   }
105
106   $query =~ s/[\n\s]+/ /g;
107
108   $msg .= " " if ($msg);
109
110   my $info = "$subroutine called from $filename:$line\n";
111
112   $main::lxdebug->message($level, $info . $msg . $query);
113 }
114
115 sub quote_db_date {
116   my ($str) = @_;
117
118   return "NULL" unless defined $str;
119   return "current_date" if $str =~ /current_date/;
120
121   $str =~ s/\'/\'\'/g;
122   return "'$str'";
123 }
124
125 sub prepare_query {
126   $main::lxdebug->enter_sub(2);
127
128   my ($form, $dbh, $query) = splice(@_, 0, 3);
129
130   dump_query(LXDebug->QUERY(), '', $query, @_);
131
132   my $sth = $dbh->prepare($query) || $form->dberror($query);
133
134   $main::lxdebug->leave_sub(2);
135
136   return $sth;
137 }
138
139 sub prepare_execute_query {
140   $main::lxdebug->enter_sub(2);
141
142   my ($form, $dbh, $query) = splice(@_, 0, 3);
143
144   dump_query(LXDebug->QUERY(), '', $query, @_);
145
146   my $sth = $dbh->prepare($query) || $form->dberror($query);
147   if (scalar(@_) != 0) {
148     $sth->execute(@_) || $form->dberror($query . " (" . join(", ", @_) . ")");
149   } else {
150     $sth->execute() || $form->dberror($query);
151   }
152
153   $main::lxdebug->leave_sub(2);
154
155   return $sth;
156 }
157
158 sub selectall_hashref_query {
159   $main::lxdebug->enter_sub(2);
160
161   my ($form, $dbh, $query) = splice(@_, 0, 3);
162
163   dump_query(LXDebug->QUERY(), '', $query, @_);
164
165   # this works back 'til at least DBI 1.46 on perl 5.8.4 on Debian Sarge (2004)
166   my $result = $dbh->selectall_arrayref($query, { Slice => {} }, @_)
167     or $form->dberror($query . (@_ ? " (" . join(", ", @_) . ")" : ''));
168
169   $main::lxdebug->leave_sub(2);
170
171   return wantarray ? @{ $result } : $result;
172 }
173
174 sub selectall_array_query {
175   $main::lxdebug->enter_sub(2);
176
177   my ($form, $dbh, $query) = splice(@_, 0, 3);
178
179   my $sth = prepare_execute_query($form, $dbh, $query, @_);
180   my @result;
181   while (my ($value) = $sth->fetchrow_array()) {
182     push(@result, $value);
183   }
184   $sth->finish();
185
186   $main::lxdebug->leave_sub(2);
187
188   return @result;
189 }
190
191 sub selectfirst_hashref_query {
192   $main::lxdebug->enter_sub(2);
193
194   my ($form, $dbh, $query) = splice(@_, 0, 3);
195
196   my $sth = prepare_execute_query($form, $dbh, $query, @_);
197   my $ref = $sth->fetchrow_hashref();
198   $sth->finish();
199
200   $main::lxdebug->leave_sub(2);
201
202   return $ref;
203 }
204
205 sub selectfirst_array_query {
206   $main::lxdebug->enter_sub(2);
207
208   my ($form, $dbh, $query) = splice(@_, 0, 3);
209
210   my $sth = prepare_execute_query($form, $dbh, $query, @_);
211   my @ret = $sth->fetchrow_array();
212   $sth->finish();
213
214   $main::lxdebug->leave_sub(2);
215
216   return @ret;
217 }
218
219 sub selectall_as_map {
220   $main::lxdebug->enter_sub(2);
221
222   my ($form, $dbh, $query, $key_col, $value_col) = splice(@_, 0, 5);
223
224   my $sth = prepare_execute_query($form, $dbh, $query, @_);
225
226   my %hash;
227   if ('' eq ref $value_col) {
228     while (my $ref = $sth->fetchrow_hashref()) {
229       $hash{$ref->{$key_col} // ''} = $ref->{$value_col};
230     }
231   } else {
232     while (my $ref = $sth->fetchrow_hashref()) {
233       $hash{$ref->{$key_col} // ''} = { map { $_ => $ref->{$_} } @{ $value_col } };
234     }
235   }
236
237   $sth->finish();
238
239   $main::lxdebug->leave_sub(2);
240
241   return %hash;
242 }
243
244 sub selectall_ids {
245   $main::lxdebug->enter_sub(2);
246
247   my ($form, $dbh, $query, $key_col) = splice(@_, 0, 4);
248
249   my $sth = prepare_execute_query($form, $dbh, $query, @_);
250
251   my @ids;
252   while (my $ref = $sth->fetchrow_arrayref()) {
253     push @ids, $ref->[$key_col];
254   }
255
256   $sth->finish;
257
258   $main::lxdebug->leave_sub(2);
259
260   return @ids;
261 }
262
263 sub create_sort_spec {
264   $main::lxdebug->enter_sub(2);
265
266   my %params = @_;
267
268   # Safety check:
269   $params{defs}    || die;
270   $params{default} || die;
271
272   # The definition of valid columns to sort by.
273   my $defs        = $params{defs};
274
275   # The column name to sort by. Use the default column name if none was given.
276   my %result      = ( 'column' => $params{column} || $params{default} );
277
278   # Overwrite the column name with the default column name if the other one is not valid.
279   $result{column} = $params{default} unless ($defs->{ $result{column} });
280
281   # The sort direction. true means 'sort ascending', false means 'sort descending'.
282   $result{dir}    = defined $params{dir}         ? $params{dir}
283                   : defined $params{default_dir} ? $params{default_dir}
284                   :                                1;
285   $result{dir}    = $result{dir} ?     1 :      0;
286   my $asc_desc    = $result{dir} ? 'ASC' : 'DESC';
287
288   # Create the SQL code.
289   my $cols        = $defs->{ $result{column} };
290   $result{sql}    = join ', ', map { "${_} ${asc_desc}" } @{ ref $cols eq 'ARRAY' ? $cols : [ $cols ] };
291
292   $main::lxdebug->leave_sub(2);
293
294   return %result;
295 }
296
297 sub does_table_exist {
298   $main::lxdebug->enter_sub(2);
299
300   my $dbh    = shift;
301   my $table  = shift;
302
303   my $result = 0;
304
305   if ($dbh) {
306     my $sth = $dbh->table_info('', '', $table, 'TABLE');
307     if ($sth) {
308       $result = $sth->fetchrow_hashref();
309       $sth->finish();
310     }
311   }
312
313   $main::lxdebug->leave_sub(2);
314
315   return $result;
316 }
317
318 # add token to values.
319 # usage:
320 #  add_token(
321 #    \@where_tokens,
322 #    \@where_values,
323 #    col => 'id',
324 #    val => [ 23, 34, 17 ]
325 #    esc => \&conf_i
326 #  )
327 #  will append to the given arrays:
328 #   -> 'id IN (?, ?, ?)'
329 #   -> (conv_i(23), conv_i(34), conv_i(17))
330 #
331 #  features:
332 #   - don't care if one or multiple values are given. singlewill result in 'col = ?'
333 #   - pass escape routines
334 #   - expand for future method
335 #   - no need to type "push @where_tokens, 'id = ?'" over and over again
336 sub add_token {
337   my $tokens = shift() || [];
338   my $values = shift() || [];
339   my %params = @_;
340   my $col    = $params{col};
341   my $val    = $params{val};
342   my $escape = $params{esc} || sub { $_ };
343   my $method = $params{esc} =~ /^start|end|substr$/ ? 'ILIKE' : $params{method} || '=';
344
345   $val = [ $val ] unless ref $val eq 'ARRAY';
346
347   my %escapes = (
348     id     => \&conv_i,
349     bool   => \&conv_b,
350     date   => \&conv_date,
351     start  => sub { trim($_[0]) . '%' },
352     end    => sub { '%' . trim($_[0]) },
353     substr => sub { like($_[0]) },
354   );
355
356   my $_long_token = sub {
357     my $op = shift;
358     sub {
359       my $col = shift;
360       return scalar @_ ? join ' OR ', ("$col $op ?") x scalar @_,
361            :             undef;
362     }
363   };
364
365   my %methods = (
366     '=' => sub {
367       my $col = shift;
368       return scalar @_ >  1 ? sprintf '%s IN (%s)', $col, join ', ', ("?") x scalar @_
369            : scalar @_ == 1 ? sprintf '%s = ?',     $col
370            :                  undef;
371     },
372     map({ $_ => $_long_token->($_) } qw(LIKE ILIKE >= <= > <)),
373   );
374
375   $method = $methods{$method} || $method;
376   $escape = $escapes{$escape} || $escape;
377
378   my $token = $method->($col, @{ $val });
379   my @vals  = map { $escape->($_) } @{ $val };
380
381   return unless $token;
382
383   push @{ $tokens }, $token;
384   push @{ $values }, @vals;
385
386   return ($token, @vals);
387 }
388
389 sub like {
390   my ($string) = @_;
391
392   return "%" . SL::Util::trim($string // '') . "%";
393 }
394
395 1;
396
397
398 __END__
399
400 =head1 NAME
401
402 SL::DBUTils.pm: All about database connections in kivitendo
403
404 =head1 SYNOPSIS
405
406   use DBUtils;
407
408   conv_i($str, $default)
409   conv_date($str)
410   conv_dateq($str)
411   quote_db_date($date)
412
413   do_query($form, $dbh, $query)
414   do_statement($form, $sth, $query)
415
416   dump_query($level, $msg, $query)
417   prepare_execute_query($form, $dbh, $query)
418
419   my $all_results_ref       = selectall_hashref_query($form, $dbh, $query)
420   my $first_result_hash_ref = selectfirst_hashref_query($form, $dbh, $query);
421
422   my @first_result =  selectfirst_array_query($form, $dbh, $query);  # ==
423   my @first_result =  selectrow_query($form, $dbh, $query);
424
425   my %sort_spec = create_sort_spec(%params);
426
427 =head1 DESCRIPTION
428
429 DBUtils is the attempt to reduce the amount of overhead it takes to retrieve information from the database in kivitendo. Previously it would take about 15 lines of code just to get one single integer out of the database, including failure procedures and importing the necessary packages. Debugging would take even more.
430
431 Using DBUtils most database procedures can be reduced to defining the query, executing it, and retrieving the result. Let DBUtils handle the rest. Whenever there is a database operation not covered in DBUtils, add it here, rather than working around it in the backend code.
432
433 DBUtils relies heavily on two parameters which have to be passed to almost every function: $form and $dbh.
434   - $form is used for error handling only. It can be omitted in theory, but should not.
435   - $dbh is a handle to the database, as returned by the DBI::connect routine. If you don't have an active connection, you can query $form->get_standard_dbh() to get a generic no_auto connection. Don't forget to commit in this case!
436
437
438 Every function here should accomplish the follwing things:
439   - Easy debugging. Every handled query gets dumped via LXDebug, if specified there.
440   - Safe value binding. Although DBI is far from perfect in terms of binding, the rest of the bindings should happen here.
441   - Error handling. Should a query fail, an error message will be generated here instead of in the backend code invoking DBUtils.
442
443 Note that binding is not perfect here either...
444
445 =head2 QUOTING FUNCTIONS
446
447 =over 4
448
449 =item conv_i STR
450
451 =item conv_i STR,DEFAULT
452
453 Converts STR to an integer. If STR is empty, returns DEFAULT. If no DEFAULT is given, returns undef.
454
455 =item conv_date STR
456
457 Converts STR to a date string. If STR is emptry, returns undef.
458
459 =item conv_dateq STR
460
461 Database version of conv_date. Quotes STR before returning. Returns 'NULL' if STR is empty.
462
463 =item quote_db_date STR
464
465 Treats STR as a database date, quoting it. If STR equals current_date returns an escaped version which is treated as the current date by Postgres.
466 Returns 'NULL' if STR is empty.
467
468 =item like STR
469
470 Turns C<STR> into an argument suitable for SQL's C<LIKE> and C<ILIKE>
471 operators by Trimming the string C<STR> (removes leading and trailing
472 whitespaces) and prepending and appending C<%>.
473
474 =back
475
476 =head2 QUERY FUNCTIONS
477
478 =over 4
479
480 =item do_query FORM,DBH,QUERY,ARRAY
481
482 Uses DBI::do to execute QUERY on DBH using ARRAY for binding values. FORM is only needed for error handling, but should always be passed nevertheless. Use this for insertions or updates that don't need to be prepared.
483
484 Returns the result of DBI::do which is -1 in case of an error and the number of affected rows otherwise.
485
486 =item do_statement FORM,STH,QUERY,ARRAY
487
488 Uses DBI::execute to execute QUERY on DBH using ARRAY for binding values. As with do_query, FORM is only used for error handling. If you are unsure what to use, refer to the documentation of DBI::do and DBI::execute.
489
490 Returns the result of DBI::execute which is -1 in case of an error and the number of affected rows otherwise.
491
492 =item prepare_execute_query FORM,DBH,QUERY,ARRAY
493
494 Prepares and executes QUERY on DBH using DBI::prepare and DBI::execute. ARRAY is passed as binding values to execute.
495
496 =back
497
498 =head2 RETRIEVAL FUNCTIONS
499
500 =over 4
501
502 =item selectfirst_array_query FORM,DBH,QUERY,ARRAY
503
504 =item selectrow_query FORM,DBH,QUERY,ARRAY
505
506 Prepares and executes a query using DBUtils functions, retireves the first row from the database, and returns it as an arrayref of the first row.
507
508 =item selectfirst_hashref_query FORM,DBH,QUERY,ARRAY
509
510 Prepares and executes a query using DBUtils functions, retireves the first row from the database, and returns it as a hashref of the first row.
511
512 =item selectall_hashref_query FORM,DBH,QUERY,ARRAY
513
514 Prepares and executes a query using DBUtils functions, retireves all data from the database, and returns it in hashref mode. This is slightly confusing, as the data structure will actually be a reference to an array, containing hashrefs for each row.
515
516 =item selectall_as_map FORM,DBH,QUERY,KEY_COL,VALUE_COL,ARRAY
517
518 Prepares and executes a query using DBUtils functions, retireves all data from the database, and creates a hash from the results using KEY_COL as the column for the hash keys and VALUE_COL for its values.
519
520 =back
521
522 =head2 UTILITY FUNCTIONS
523
524 =over 4
525
526 =item create_sort_spec
527
528   params:
529     defs        => { },         # mandatory
530     default     => 'name',      # mandatory
531     column      => 'name',
532     default_dir => 0|1,
533     dir         => 0|1,
534
535   returns hash:
536     column      => 'name',
537     dir         => 0|1,
538     sql         => 'SQL code',
539
540 This function simplifies the creation of SQL code for sorting
541 columns. It uses a hashref of valid column names, the column name and
542 direction requested by the user, the application defaults for the
543 column name and the direction and returns the actual column name,
544 direction and SQL code that can be used directly in a query.
545
546 The parameter 'defs' is a hash reference. The keys are the column
547 names as they may come from the application. The values are either
548 scalars with SQL code or array references of SQL code. Example:
549
550 'defs' => { 'customername' => 'lower(customer.name)',
551             'address'      => [ 'lower(customer.city)', 'lower(customer.street)' ], }
552
553 'default' is the default column name to sort by. It must be a key of
554 'defs' and should not be come from user input.
555
556 The 'column' parameter is the column name as requested by the
557 application (e.g. if the user clicked on a column header in a
558 report). If it is invalid then the 'default' parameter will be used
559 instead.
560
561 'default_dir' is the default sort direction. A true value means 'sort
562 ascending', a false one 'sort descending'. 'default_dir' defaults to
563 '1' if undefined.
564
565 The 'dir' parameter is the sort direction as requested by the
566 application (e.g. if the user clicked on a column header in a
567 report). If it is undefined then the 'default_dir' parameter will be
568 used instead.
569
570 =back
571
572 =head2 DEBUG FUNCTIONS
573
574 =over 4
575
576 =item dump_query LEVEL,MSG,QUERY,ARRAY
577
578 Dumps a query using LXDebug->message, using LEVEL for the debug-level of LXDebug. If MSG is given, it preceeds the QUERY dump in the logfiles. ARRAY is used to interpolate the '?' placeholders in QUERY, the resulting QUERY can be copy-pasted into a database frontend for debugging. Note that this method is also automatically called by each of the other QUERY FUNCTIONS, so there is in general little need to invoke it manually.
579
580 =back
581
582 =head1 EXAMPLES
583
584 =over 4
585
586 =item Retrieving a whole table:
587
588   $query = qq|SELECT id, pricegroup FROM pricegroup|;
589   $form->{PRICEGROUPS} = selectall_hashref_query($form, $dbh, $query);
590
591 =item Retrieving a single value:
592
593   $query = qq|SELECT nextval('glid')|;
594   ($new_id) = selectrow_query($form, $dbh, $query);
595
596 =item Using binding values:
597
598   $query = qq|UPDATE ar SET paid = amount + paid, storno = 't' WHERE id = ?|;
599   do_query($form, $dbh, $query, $id);
600
601 =item A more complicated example, using dynamic binding values:
602
603   my @values;
604
605   if ($form->{language_values} ne "") {
606     $query = qq|SELECT l.id, l.description, tr.translation, tr.longdescription
607                   FROM language l
608                   LEFT OUTER JOIN translation tr ON (tr.language_id = l.id) AND (tr.parts_id = ?)|;
609     @values = (conv_i($form->{id}));
610   } else {
611     $query = qq|SELECT id, description FROM language|;
612   }
613
614   my $languages = selectall_hashref_query($form, $dbh, $query, @values);
615
616 =back
617
618 =head1 MODULE AUTHORS
619
620 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
621 Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
622
623 =head1 DOCUMENTATION AUTHORS
624
625 Udo Spallek E<lt>udono@gmx.netE<gt>
626 Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
627
628 =head1 COPYRIGHT AND LICENSE
629
630 Copyright 2007 by kivitendo Community
631
632 This program is free software; you can redistribute it and/or modify
633 it under the terms of the GNU General Public License as published by
634 the Free Software Foundation; either version 2 of the License, or
635 (at your option) any later version.
636
637 This program is distributed in the hope that it will be useful,
638 but WITHOUT ANY WARRANTY; without even the implied warranty of
639 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
640 GNU General Public License for more details.
641 You should have received a copy of the GNU General Public License
642 along with this program; if not, write to the Free Software
643 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
644
645 =cut