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