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 like
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 { trim($_[0]) . '%' },
352 end => sub { '%' . trim($_[0]) },
353 substr => sub { like($_[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);
392 return "%" . SL::Util::trim($string // '') . "%";
404 SL::DBUTils.pm: All about database connections in kivitendo
410 conv_i($str, $default)
415 do_query($form, $dbh, $query)
416 do_statement($form, $sth, $query)
418 dump_query($level, $msg, $query)
419 prepare_execute_query($form, $dbh, $query)
421 my $all_results_ref = selectall_hashref_query($form, $dbh, $query)
422 my $first_result_hash_ref = selectfirst_hashref_query($form, $dbh, $query);
424 my @first_result = selectfirst_array_query($form, $dbh, $query); # ==
425 my @first_result = selectrow_query($form, $dbh, $query);
427 my %sort_spec = create_sort_spec(%params);
431 DBUtils provides wrapper functions for low level database retrieval. It saves
432 you the trouble of mucking around with statement handles for small databse
433 queries and does exception handling in the common cases for you.
435 Query and retrieval function share the parameter scheme:
437 query_or_retrieval(C<FORM, DBH, QUERY[, BINDVALUES]>)
443 C<FORM> is used for error handling only. It can be omitted in theory, but should
444 not. In most cases you will call it with C<$::form>.
448 C<DBH> is a handle to the database, as returned by the C<DBI::connect> routine.
449 If you don't have an active connection, you can use
450 C<<$::form->get_standard_dbh>> to get a generic no_auto connection or get a
451 C<Rose::DB::Object> handle from any RDBO class with
452 C<<SL::DB::Part->new->db->dbh>>. The former will be without autocommit, the
453 latter with autocommit.
455 See C<PITFALLS AND CAVEATS> for common errors.
459 C<QUERY> must be exactly one query. You don't need to include the terminal
460 C<;>. There must be no tainted data interpolated into the string. Instead use
461 the DBI placeholder syntax.
465 All additional parameters will be used as C<BINDVALUES> for the query. Note
466 that DBI can't bind arrays to a C<id IN (?)>, so you will need to generate a
467 statement with exactly one C<?> for each bind value. DBI can however bind
468 DateTime objects, and you should always pass these for date selections.
472 =head1 PITFALLS AND CAVEATS
476 As mentioned above, there are two sources of database handles in the program:
477 C<<$::form->get_standard_dbh>> and C<<SL::DB::Object->new->db->dbh>>. It's easy
478 to produce deadlocks when using both of them. To reduce the likelyhood of
479 locks, try to obey these rules:
485 In a controller that uses Rose objects, never use C<get_standard_dbh>.
489 In backend code, that has no preference, always accept the database handle as a
490 parameter from the controller.
496 C<DBUtils> is one of the last modules in the program to use C<@EXPORT> instead
497 of C<@EXPORT_OK>. This means it will flood your namespace with its functions,
498 causing potential clashes. When writing new code, always either export nothing
502 DBUtils::selectall_hashref_query(...)
504 or export only what you need:
506 use SL::DBUtils qw(selectall_hashref_query);
507 selectall_hashref_query(...)
512 Since it is really easy to write something like
514 my $all_parts = selectall_hashref_query($::form, $dbh, 'SELECT * FROM parts');
516 people do so from time to time. When writing code, consider this a ticking
517 timebomb. Someone out there has a database with 1mio parts in it, and this
518 statement just shovelled ate 2GB of memory and timeouted the request.
520 Parts may be the obvious example, but the same applies to customer, vendors,
521 records, projects or custom variables.
524 =head1 QUOTING FUNCTIONS
530 =item conv_i STR,DEFAULT
532 Converts STR to an integer. If STR is empty, returns DEFAULT. If no DEFAULT is
533 given, returns undef.
537 Converts STR to a date string. If STR is emptry, returns undef.
541 Database version of conv_date. Quotes STR before returning. Returns 'NULL' if
544 =item quote_db_date STR
546 Treats STR as a database date, quoting it. If STR equals current_date returns
547 an escaped version which is treated as the current date by Postgres.
549 Returns C<'NULL'> if STR is empty.
553 Turns C<STR> into an argument suitable for SQL's C<LIKE> and C<ILIKE>
554 operators by Trimming the string C<STR> (removes leading and trailing
555 whitespaces) and prepending and appending C<%>.
559 =head1 QUERY FUNCTIONS
563 =item do_query FORM,DBH,QUERY,ARRAY
565 Uses DBI::do to execute QUERY on DBH using ARRAY for binding values. FORM is
566 only needed for error handling, but should always be passed nevertheless. Use
567 this for insertions or updates that don't need to be prepared.
569 Returns the result of DBI::do which is -1 in case of an error and the number of
570 affected rows otherwise.
572 =item do_statement FORM,STH,QUERY,ARRAY
574 Uses DBI::execute to execute QUERY on DBH using ARRAY for binding values. As
575 with do_query, FORM is only used for error handling. If you are unsure what to
576 use, refer to the documentation of DBI::do and DBI::execute.
578 Returns the result of DBI::execute which is -1 in case of an error and the
579 number of affected rows otherwise.
581 =item prepare_execute_query FORM,DBH,QUERY,ARRAY
583 Prepares and executes QUERY on DBH using DBI::prepare and DBI::execute. ARRAY
584 is passed as binding values to execute.
588 =head1 RETRIEVAL FUNCTIONS
592 =item selectfirst_array_query FORM,DBH,QUERY,ARRAY
594 =item selectrow_query FORM,DBH,QUERY,ARRAY
596 Prepares and executes a query using DBUtils functions, retireves the first row
597 from the database, and returns it as an arrayref of the first row.
599 =item selectfirst_hashref_query FORM,DBH,QUERY,ARRAY
601 Prepares and executes a query using DBUtils functions, retireves the first row
602 from the database, and returns it as a hashref of the first row.
604 =item selectall_hashref_query FORM,DBH,QUERY,ARRAY
606 Prepares and executes a query using DBUtils functions, retireves all data from
607 the database, and returns it in hashref mode. This is slightly confusing, as
608 the data structure will actually be a reference to an array, containing
609 hashrefs for each row.
611 =item selectall_as_map FORM,DBH,QUERY,KEY_COL,VALUE_COL,ARRAY
613 Prepares and executes a query using DBUtils functions, retireves all data from
614 the database, and creates a hash from the results using KEY_COL as the column
615 for the hash keys and VALUE_COL for its values.
619 =head1 UTILITY FUNCTIONS
623 =item create_sort_spec
626 defs => { }, # mandatory
627 default => 'name', # mandatory
637 This function simplifies the creation of SQL code for sorting
638 columns. It uses a hashref of valid column names, the column name and
639 direction requested by the user, the application defaults for the
640 column name and the direction and returns the actual column name,
641 direction and SQL code that can be used directly in a query.
643 The parameter 'defs' is a hash reference. The keys are the column
644 names as they may come from the application. The values are either
645 scalars with SQL code or array references of SQL code. Example:
648 customername => 'lower(customer.name)',
649 address => [ 'lower(customer.city)', 'lower(customer.street)' ],
652 'default' is the default column name to sort by. It must be a key of
653 'defs' and should not be come from user input.
655 The 'column' parameter is the column name as requested by the
656 application (e.g. if the user clicked on a column header in a
657 report). If it is invalid then the 'default' parameter will be used
660 'default_dir' is the default sort direction. A true value means 'sort
661 ascending', a false one 'sort descending'. 'default_dir' defaults to
664 The 'dir' parameter is the sort direction as requested by the
665 application (e.g. if the user clicked on a column header in a
666 report). If it is undefined then the 'default_dir' parameter will be
671 =head1 DEBUG FUNCTIONS
675 =item dump_query LEVEL,MSG,QUERY,ARRAY
677 Dumps a query using LXDebug->message, using LEVEL for the debug-level of
678 LXDebug. If MSG is given, it preceeds the QUERY dump in the logfiles. ARRAY is
679 used to interpolate the '?' placeholders in QUERY, the resulting QUERY can be
680 copy-pasted into a database frontend for debugging. Note that this method is
681 also automatically called by each of the other QUERY FUNCTIONS, so there is in
682 general little need to invoke it manually.
690 =item Retrieving a whole table:
692 $query = qq|SELECT id, pricegroup FROM pricegroup|;
693 $form->{PRICEGROUPS} = selectall_hashref_query($form, $dbh, $query);
695 =item Retrieving a single value:
697 $query = qq|SELECT nextval('glid')|;
698 ($new_id) = selectrow_query($form, $dbh, $query);
700 =item Using binding values:
702 $query = qq|UPDATE ar SET paid = amount + paid, storno = 't' WHERE id = ?|;
703 do_query($form, $dbh, $query, $id);
705 =item A more complicated example, using dynamic binding values:
709 if ($form->{language_values} ne "") {
711 SELECT l.id, l.description, tr.translation, tr.longdescription
713 LEFT JOIN translation tr ON (tr.language_id = l.id AND tr.parts_id = ?)
715 @values = (conv_i($form->{id}));
717 $query = qq|SELECT id, description FROM language|;
720 my $languages = selectall_hashref_query($form, $dbh, $query, @values);
724 =head1 MODULE AUTHORS
726 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
727 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
729 =head1 DOCUMENTATION AUTHORS
731 Udo Spallek E<lt>udono@gmx.netE<gt>
732 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
734 =head1 COPYRIGHT AND LICENSE
736 Copyright 2007 by kivitendo Community
738 This program is free software; you can redistribute it and/or modify
739 it under the terms of the GNU General Public License as published by
740 the Free Software Foundation; either version 2 of the License, or
741 (at your option) any later version.
743 This program is distributed in the hope that it will be useful,
744 but WITHOUT ANY WARRANTY; without even the implied warranty of
745 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
746 GNU General Public License for more details.
747 You should have received a copy of the GNU General Public License
748 along with this program; if not, write to the Free Software
749 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.