6 our @ISA = qw(Exporter);
8 our @EXPORT = qw(conv_i conv_date conv_dateq do_query selectrow_query do_statement
9 dump_query quote_db_date
10 selectfirst_hashref_query selectfirst_array_query
11 selectall_hashref_query selectall_array_query
14 prepare_execute_query prepare_query
15 create_sort_spec does_table_exist
21 my ($value, $default) = @_;
22 return (defined($value) && "$value" ne "") ? $value * 1 : $default;
27 my ($value, $default) = @_;
28 return !defined $value && defined $default ? $default
35 return undef if !defined $value;
36 $value = trim($value);
37 return $value eq "" ? undef : $value;
42 if (defined($value) && "$value" ne "") {
43 $value =~ s/\'/\'\'/g;
50 $main::lxdebug->enter_sub(2);
52 my ($form, $dbh, $query) = splice(@_, 0, 3);
54 dump_query(LXDebug->QUERY(), '', $query, @_);
57 if (0 == scalar(@_)) {
58 $result = $dbh->do($query) || $form->dberror($query);
60 $result = $dbh->do($query, undef, @_) || $form->dberror($query . " (" . join(", ", @_) . ")");
63 $main::lxdebug->leave_sub(2);
68 sub selectrow_query { &selectfirst_array_query }
71 $main::lxdebug->enter_sub(2);
73 my ($form, $sth, $query) = splice(@_, 0, 3);
75 dump_query(LXDebug->QUERY(), '', $query, @_);
78 if (0 == scalar(@_)) {
79 $result = $sth->execute() || $form->dberror($query);
81 $result = $sth->execute(@_) || $form->dberror($query . " (" . join(", ", @_) . ")");
84 $main::lxdebug->leave_sub(2);
90 my ($level, $msg, $query) = splice(@_, 0, 3);
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++;
99 while ($query =~ /\?/) {
100 my $value = shift || '';
101 $value =~ s/\'/\\\'/g;
102 $value = "'${value}'";
103 $query =~ s/\?/$value/;
106 $query =~ s/[\n\s]+/ /g;
108 $msg .= " " if ($msg);
110 my $info = "$subroutine called from $filename:$line\n";
112 $main::lxdebug->message($level, $info . $msg . $query);
118 return "NULL" unless defined $str;
119 return "current_date" if $str =~ /current_date/;
126 $main::lxdebug->enter_sub(2);
128 my ($form, $dbh, $query) = splice(@_, 0, 3);
130 dump_query(LXDebug->QUERY(), '', $query, @_);
132 my $sth = $dbh->prepare($query) || $form->dberror($query);
134 $main::lxdebug->leave_sub(2);
139 sub prepare_execute_query {
140 $main::lxdebug->enter_sub(2);
142 my ($form, $dbh, $query) = splice(@_, 0, 3);
144 dump_query(LXDebug->QUERY(), '', $query, @_);
146 my $sth = $dbh->prepare($query) || $form->dberror($query);
147 if (scalar(@_) != 0) {
148 $sth->execute(@_) || $form->dberror($query . " (" . join(", ", @_) . ")");
150 $sth->execute() || $form->dberror($query);
153 $main::lxdebug->leave_sub(2);
158 sub selectall_hashref_query {
159 $main::lxdebug->enter_sub(2);
161 my ($form, $dbh, $query) = splice(@_, 0, 3);
163 dump_query(LXDebug->QUERY(), '', $query, @_);
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(", ", @_) . ")" : ''));
169 $main::lxdebug->leave_sub(2);
171 return wantarray ? @{ $result } : $result;
174 sub selectall_array_query {
175 $main::lxdebug->enter_sub(2);
177 my ($form, $dbh, $query) = splice(@_, 0, 3);
179 my $sth = prepare_execute_query($form, $dbh, $query, @_);
181 while (my ($value) = $sth->fetchrow_array()) {
182 push(@result, $value);
186 $main::lxdebug->leave_sub(2);
191 sub selectfirst_hashref_query {
192 $main::lxdebug->enter_sub(2);
194 my ($form, $dbh, $query) = splice(@_, 0, 3);
196 my $sth = prepare_execute_query($form, $dbh, $query, @_);
197 my $ref = $sth->fetchrow_hashref();
200 $main::lxdebug->leave_sub(2);
205 sub selectfirst_array_query {
206 $main::lxdebug->enter_sub(2);
208 my ($form, $dbh, $query) = splice(@_, 0, 3);
210 my $sth = prepare_execute_query($form, $dbh, $query, @_);
211 my @ret = $sth->fetchrow_array();
214 $main::lxdebug->leave_sub(2);
219 sub selectall_as_map {
220 $main::lxdebug->enter_sub(2);
222 my ($form, $dbh, $query, $key_col, $value_col) = splice(@_, 0, 5);
224 my $sth = prepare_execute_query($form, $dbh, $query, @_);
227 if ('' eq ref $value_col) {
228 while (my $ref = $sth->fetchrow_hashref()) {
229 $hash{$ref->{$key_col} // ''} = $ref->{$value_col};
232 while (my $ref = $sth->fetchrow_hashref()) {
233 $hash{$ref->{$key_col} // ''} = { map { $_ => $ref->{$_} } @{ $value_col } };
239 $main::lxdebug->leave_sub(2);
245 $main::lxdebug->enter_sub(2);
247 my ($form, $dbh, $query, $key_col) = splice(@_, 0, 4);
249 my $sth = prepare_execute_query($form, $dbh, $query, @_);
252 while (my $ref = $sth->fetchrow_arrayref()) {
253 push @ids, $ref->[$key_col];
258 $main::lxdebug->leave_sub(2);
263 sub create_sort_spec {
264 $main::lxdebug->enter_sub(2);
269 $params{defs} || die;
270 $params{default} || die;
272 # The definition of valid columns to sort by.
273 my $defs = $params{defs};
275 # The column name to sort by. Use the default column name if none was given.
276 my %result = ( 'column' => $params{column} || $params{default} );
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} });
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}
285 $result{dir} = $result{dir} ? 1 : 0;
286 my $asc_desc = $result{dir} ? 'ASC' : 'DESC';
288 # Create the SQL code.
289 my $cols = $defs->{ $result{column} };
290 $result{sql} = join ', ', map { "${_} ${asc_desc}" } @{ ref $cols eq 'ARRAY' ? $cols : [ $cols ] };
292 $main::lxdebug->leave_sub(2);
297 sub does_table_exist {
298 $main::lxdebug->enter_sub(2);
306 my $sth = $dbh->table_info('', '', $table, 'TABLE');
308 $result = $sth->fetchrow_hashref();
313 $main::lxdebug->leave_sub(2);
318 # add token to values.
324 # val => [ 23, 34, 17 ]
327 # will append to the given arrays:
328 # -> 'id IN (?, ?, ?)'
329 # -> (conv_i(23), conv_i(34), conv_i(17))
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
337 my $tokens = shift() || [];
338 my $values = shift() || [];
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} || '=';
345 $val = [ $val ] unless ref $val eq 'ARRAY';
351 start => sub { $_[0] . '%' },
352 end => sub { '%' . $_[0] },
353 substr => sub { '%' . $_[0] . '%' },
356 my $_long_token = sub {
360 return scalar @_ ? join ' OR ', ("$col $op ?") x scalar @_,
368 return scalar @_ > 1 ? sprintf '%s IN (%s)', $col, join ', ', ("?") x scalar @_
369 : scalar @_ == 1 ? sprintf '%s = ?', $col
372 map({ $_ => $_long_token->($_) } qw(LIKE ILIKE >= <= > <)),
375 $method = $methods{$method} || $method;
376 $escape = $escapes{$escape} || $escape;
378 my $token = $method->($col, @{ $val });
379 my @vals = map { $escape->($_) } @{ $val };
381 return unless $token;
383 push @{ $tokens }, $token;
384 push @{ $values }, @vals;
386 return ($token, @vals);
396 SL::DBUTils.pm: All about database connections in kivitendo
402 conv_i($str, $default)
407 do_query($form, $dbh, $query)
408 do_statement($form, $sth, $query)
410 dump_query($level, $msg, $query)
411 prepare_execute_query($form, $dbh, $query)
413 my $all_results_ref = selectall_hashref_query($form, $dbh, $query)
414 my $first_result_hash_ref = selectfirst_hashref_query($form, $dbh, $query);
416 my @first_result = selectfirst_array_query($form, $dbh, $query); # ==
417 my @first_result = selectrow_query($form, $dbh, $query);
419 my %sort_spec = create_sort_spec(%params);
423 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.
425 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.
427 DBUtils relies heavily on two parameters which have to be passed to almost every function: $form and $dbh.
428 - $form is used for error handling only. It can be omitted in theory, but should not.
429 - $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!
432 Every function here should accomplish the follwing things:
433 - Easy debugging. Every handled query gets dumped via LXDebug, if specified there.
434 - Safe value binding. Although DBI is far from perfect in terms of binding, the rest of the bindings should happen here.
435 - Error handling. Should a query fail, an error message will be generated here instead of in the backend code invoking DBUtils.
437 Note that binding is not perfect here either...
439 =head2 QUOTING FUNCTIONS
445 =item conv_i STR,DEFAULT
447 Converts STR to an integer. If STR is empty, returns DEFAULT. If no DEFAULT is given, returns undef.
451 Converts STR to a date string. If STR is emptry, returns undef.
455 Database version of conv_date. Quotes STR before returning. Returns 'NULL' if STR is empty.
457 =item quote_db_date STR
459 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.
460 Returns 'NULL' if STR is empty.
464 =head2 QUERY FUNCTIONS
468 =item do_query FORM,DBH,QUERY,ARRAY
470 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.
472 Returns the result of DBI::do which is -1 in case of an error and the number of affected rows otherwise.
474 =item do_statement FORM,STH,QUERY,ARRAY
476 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.
478 Returns the result of DBI::execute which is -1 in case of an error and the number of affected rows otherwise.
480 =item prepare_execute_query FORM,DBH,QUERY,ARRAY
482 Prepares and executes QUERY on DBH using DBI::prepare and DBI::execute. ARRAY is passed as binding values to execute.
486 =head2 RETRIEVAL FUNCTIONS
490 =item selectfirst_array_query FORM,DBH,QUERY,ARRAY
492 =item selectrow_query FORM,DBH,QUERY,ARRAY
494 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.
496 =item selectfirst_hashref_query FORM,DBH,QUERY,ARRAY
498 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.
500 =item selectall_hashref_query FORM,DBH,QUERY,ARRAY
502 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.
504 =item selectall_as_map FORM,DBH,QUERY,KEY_COL,VALUE_COL,ARRAY
506 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.
510 =head2 UTILITY FUNCTIONS
514 =item create_sort_spec
517 defs => { }, # mandatory
518 default => 'name', # mandatory
528 This function simplifies the creation of SQL code for sorting
529 columns. It uses a hashref of valid column names, the column name and
530 direction requested by the user, the application defaults for the
531 column name and the direction and returns the actual column name,
532 direction and SQL code that can be used directly in a query.
534 The parameter 'defs' is a hash reference. The keys are the column
535 names as they may come from the application. The values are either
536 scalars with SQL code or array references of SQL code. Example:
538 'defs' => { 'customername' => 'lower(customer.name)',
539 'address' => [ 'lower(customer.city)', 'lower(customer.street)' ], }
541 'default' is the default column name to sort by. It must be a key of
542 'defs' and should not be come from user input.
544 The 'column' parameter is the column name as requested by the
545 application (e.g. if the user clicked on a column header in a
546 report). If it is invalid then the 'default' parameter will be used
549 'default_dir' is the default sort direction. A true value means 'sort
550 ascending', a false one 'sort descending'. 'default_dir' defaults to
553 The 'dir' parameter is the sort direction as requested by the
554 application (e.g. if the user clicked on a column header in a
555 report). If it is undefined then the 'default_dir' parameter will be
560 =head2 DEBUG FUNCTIONS
564 =item dump_query LEVEL,MSG,QUERY,ARRAY
566 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.
574 =item Retrieving a whole table:
576 $query = qq|SELECT id, pricegroup FROM pricegroup|;
577 $form->{PRICEGROUPS} = selectall_hashref_query($form, $dbh, $query);
579 =item Retrieving a single value:
581 $query = qq|SELECT nextval('glid')|;
582 ($new_id) = selectrow_query($form, $dbh, $query);
584 =item Using binding values:
586 $query = qq|UPDATE ar SET paid = amount + paid, storno = 't' WHERE id = ?|;
587 do_query($form, $dbh, $query, $id);
589 =item A more complicated example, using dynamic binding values:
593 if ($form->{language_values} ne "") {
594 $query = qq|SELECT l.id, l.description, tr.translation, tr.longdescription
596 LEFT OUTER JOIN translation tr ON (tr.language_id = l.id) AND (tr.parts_id = ?)|;
597 @values = (conv_i($form->{id}));
599 $query = qq|SELECT id, description FROM language|;
602 my $languages = selectall_hashref_query($form, $dbh, $query, @values);
606 =head1 MODULE AUTHORS
608 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
609 Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
611 =head1 DOCUMENTATION AUTHORS
613 Udo Spallek E<lt>udono@gmx.netE<gt>
614 Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
616 =head1 COPYRIGHT AND LICENSE
618 Copyright 2007 by kivitendo Community
620 This program is free software; you can redistribute it and/or modify
621 it under the terms of the GNU General Public License as published by
622 the Free Software Foundation; either version 2 of the License, or
623 (at your option) any later version.
625 This program is distributed in the hope that it will be useful,
626 but WITHOUT ANY WARRANTY; without even the implied warranty of
627 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
628 GNU General Public License for more details.
629 You should have received a copy of the GNU General Public License
630 along with this program; if not, write to the Free Software
631 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.