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
  13 sub conv_i {
  14   my ($value, $default) = @_;
  15   return (defined($value) && "$value" ne "") ? $value * 1 : $default;
  16 }
  17
  18 sub conv_date {
  19   my ($value) = @_;
  20   return (defined($value) && "$value" ne "") ? $value : undef;
  21 }
  22
  23 sub conv_dateq {
  24   my ($value) = @_;
  25   if (defined($value) && "$value" ne "") {
  26     $value =~ s/\'/\'\'/g;
  27     return "'$value'";
  28   }
  29   return "NULL";
  30 }
  31
  32 sub do_query {
  33   $main::lxdebug->enter_sub(2);
  34
  35   my ($form, $dbh, $query) = splice(@_, 0, 3);
  36
  37   dump_query(LXDebug::QUERY, '', $query, @_);
  38
  39   if (0 == scalar(@_)) {
  40     $dbh->do($query) || $form->dberror($query);
  41   } else {
  42     $dbh->do($query, undef, @_) ||
  43       $form->dberror($query . " (" . join(", ", @_) . ")");
  44   }
  45
  46   $main::lxdebug->leave_sub(2);
  47 }
  48
  49 sub selectrow_query { &selectfirst_array_query }
  50
  51 sub do_statement {
  52   $main::lxdebug->enter_sub(2);
  53
  54   my ($form, $sth, $query) = splice(@_, 0, 3);
  55
  56   dump_query(LXDebug::QUERY, '', $query, @_);
  57
  58   if (0 == scalar(@_)) {
  59     $sth->execute() || $form->dberror($query);
  60   } else {
  61     $sth->execute(@_) ||
  62       $form->dberror($query . " (" . join(", ", @_) . ")");
  63   }
  64
  65   $main::lxdebug->leave_sub(2);
  66 }
  67
  68 sub dump_query {
  69   my ($level, $msg, $query) = splice(@_, 0, 3);
  70
  71   my $filename = $self_filename = 'SL/DBUtils.pm';
  72   my $caller_level;
  73   while ($filename eq $self_filename) {
  74     (undef, $filename, $line, $subroutine) = caller $caller_level++;
  75   }
  76
  77   while ($query =~ /\?/) {
  78     my $value = shift(@_);
  79     $value =~ s/\'/\\\'/g;
  80     $value = "'${value}'";
  81     $query =~ s/\?/$value/;
  82   }
  83
  84   $query =~ s/[\n\s]+/ /g;
  85
  86   $msg .= " " if ($msg);
  87
  88   my $info = "$subroutine called from $filename:$line\n";
  89
  90   $main::lxdebug->message($level, $info . $msg . $query);
  91 }
  92
  93 sub quote_db_date {
  94   my ($str) = @_;
  95
  96   return "NULL" unless defined $str;
  97   return "current_date" if $str =~ /current_date/;
  98
  99   $str =~ s/\'/\'\'/g;
 100   return "'$str'";
 101 }
 102
 103 sub prepare_query {
 104   $main::lxdebug->enter_sub(2);
 105
 106   my ($form, $dbh, $query) = splice(@_, 0, 3);
 107
 108   dump_query(LXDebug::QUERY, '', $query, @_);
 109
 110   my $sth = $dbh->prepare($query) || $form->dberror($query);
 111
 112   $main::lxdebug->leave_sub(2);
 113
 114   return $sth;
 115 }
 116
 117 sub prepare_execute_query {
 118   $main::lxdebug->enter_sub(2);
 119
 120   my ($form, $dbh, $query) = splice(@_, 0, 3);
 121
 122   dump_query(LXDebug::QUERY, '', $query, @_);
 123
 124   my $sth = $dbh->prepare($query) || $form->dberror($query);
 125   if (scalar(@_) != 0) {
 126     $sth->execute(@_) || $form->dberror($query . " (" . join(", ", @_) . ")");
 127   } else {
 128     $sth->execute() || $form->dberror($query);
 129   }
 130
 131   $main::lxdebug->leave_sub(2);
 132
 133   return $sth;
 134 }
 135
 136 sub selectall_hashref_query {
 137   $main::lxdebug->enter_sub(2);
 138
 139   my ($form, $dbh, $query) = splice(@_, 0, 3);
 140
 141   my $sth = prepare_execute_query($form, $dbh, $query, @_);
 142   my $result = [];
 143   while (my $ref = $sth->fetchrow_hashref()) {
 144     push(@{ $result }, $ref);
 145   }
 146   $sth->finish();
 147
 148   $main::lxdebug->leave_sub(2);
 149
 150   return wantarray ? @{ $result } : $result;
 151 }
 152
 153 sub selectall_array_query {
 154   $main::lxdebug->enter_sub(2);
 155
 156   my ($form, $dbh, $query) = splice(@_, 0, 3);
 157
 158   my $sth = prepare_execute_query($form, $dbh, $query, @_);
 159   my @result;
 160   while (my ($value) = $sth->fetchrow_array()) {
 161     push(@result, $value);
 162   }
 163   $sth->finish();
 164
 165   $main::lxdebug->leave_sub(2);
 166
 167   return @result;
 168 }
 169
 170 sub selectfirst_hashref_query {
 171   $main::lxdebug->enter_sub(2);
 172
 173   my ($form, $dbh, $query) = splice(@_, 0, 3);
 174
 175   my $sth = prepare_execute_query($form, $dbh, $query, @_);
 176   my $ref = $sth->fetchrow_hashref();
 177   $sth->finish();
 178
 179   $main::lxdebug->leave_sub(2);
 180
 181   return $ref;
 182 }
 183
 184 sub selectfirst_array_query {
 185   $main::lxdebug->enter_sub(2);
 186
 187   my ($form, $dbh, $query) = splice(@_, 0, 3);
 188
 189   my $sth = prepare_execute_query($form, $dbh, $query, @_);
 190   my @ret = $sth->fetchrow_array();
 191   $sth->finish();
 192
 193   $main::lxdebug->leave_sub(2);
 194
 195   return @ret;
 196 }
 197
 198 sub selectall_as_map {
 199   $main::lxdebug->enter_sub(2);
 200
 201   my ($form, $dbh, $query, $key_col, $value_col) = splice(@_, 0, 5);
 202
 203   my $sth = prepare_execute_query($form, $dbh, $query, @_);
 204
 205   my %hash;
 206   if ('' eq ref $value_col) {
 207     while (my $ref = $sth->fetchrow_hashref()) {
 208       $hash{$ref->{$key_col}} = $ref->{$value_col};
 209     }
 210   } else {
 211     while (my $ref = $sth->fetchrow_hashref()) {
 212       $hash{$ref->{$key_col}} = { map { $_ => $ref->{$_} } @{ $value_col } };
 213     }
 214   }
 215
 216   $sth->finish();
 217
 218   $main::lxdebug->leave_sub(2);
 219
 220   return %hash;
 221 }
 222
 223 1;
 224
 225
 226 __END__
 227
 228 =head1 NAME
 229
 230 SL::DBUTils.pm: All about Databaseconections in Lx
 231
 232 =head1 SYNOPSIS
 233
 234   use DBUtils;
 235
 236   conv_i($str, $default)
 237   conv_date($str)
 238   conv_dateq($str)
 239   quote_db_date($date)
 240
 241   do_query($form, $dbh, $query)
 242   do_statement($form, $sth, $query)
 243
 244   dump_query($level, $msg, $query)
 245   prepare_execute_query($form, $dbh, $query)
 246
 247   my $all_results_ref       = selectall_hashref_query($form, $dbh, $query)
 248   my $first_result_hash_ref = selectfirst_hashref_query($form, $dbh, $query);
 249
 250   my @first_result =  selectfirst_array_query($form, $dbh, $query);  # ==
 251   my @first_result =  selectrow_query($form, $dbh, $query);
 252
 253
 254 =head1 DESCRIPTION
 255
 256 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.
 257
 258 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.
 259
 260 DBUtils relies heavily on two parameters which have to be passed to almost every function: $form and $dbh.
 261   - $form is used for error handling only. It can be omitted in theory, but should not.
 262   - $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!
 263
 264
 265 Every function here should accomplish the follwing things:
 266   - Easy debugging. Every handled query gets dumped via LXDebug, if specified there.
 267   - Safe value binding. Although DBI is far from perfect in terms of binding, the rest of the bindings should happen here.
 268   - Error handling. Should a query fail, an error message will be generated here instead of in the backend code invoking DBUtils.
 269
 270 Note that binding is not perfect here either...
 271
 272 =head2 QUOTING FUNCTIONS
 273
 274 =over 4
 275
 276 =item conv_i STR
 277
 278 =item conv_i STR,DEFAULT
 279
 280 Converts STR to an integer. If STR is empty, returns DEFAULT. If no DEFAULT is given, returns undef.
 281
 282 =item conv_date STR
 283
 284 Converts STR to a date string. If STR is emptry, returns undef.
 285
 286 =item conv_dateq STR
 287
 288 Database version of conv_date. Quotes STR before returning. Returns 'NULL' if STR is empty.
 289
 290 =item quote_db_date STR
 291
 292 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.
 293 Returns 'NULL' if STR is empty.
 294
 295 =back
 296
 297 =head2 QUERY FUNCTIONS
 298
 299 =over 4
 300
 301 =item do_query FORM,DBH,QUERY,ARRAY
 302
 303 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.
 304
 305 =item do_statement FORM,STH,QUERY,ARRAY
 306
 307 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.
 308
 309 =item prepare_execute_query FORM,DBH,QUERY,ARRAY
 310
 311 Prepares and executes QUERY on DBH using DBI::prepare and DBI::execute. ARRAY is passed as binding values to execute.
 312
 313 =back
 314
 315 =head2 RETRIEVAL FUNCTIONS
 316
 317 =over 4
 318
 319 =item selectfirst_array_query FORM,DBH,QUERY,ARRAY
 320
 321 =item selectrow_query FORM,DBH,QUERY,ARRAY
 322
 323 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.
 324
 325 =item selectfirst_hashref_query FORM,DBH,QUERY,ARRAY
 326
 327 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.
 328
 329 =item selectall_hashref_query FORM,DBH,QUERY,ARRAY
 330
 331 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.
 332
 333 =item selectall_as_map FORM,DBH,QUERY,KEY_COL,VALUE_COL,ARRAY
 334
 335 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.
 336
 337 =back
 338
 339 =head2 DEBUG FUNCTIONS
 340
 341 =over 4
 342
 343 =item dump_query LEVEL,MSG,QUERY,ARRAY
 344
 345 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.
 346
 347 =back
 348
 349 =head1 EXAMPLES
 350
 351 =over 4
 352
 353 =item Retrieving a whole table:
 354
 355   $query = qq|SELECT id, pricegroup FROM pricegroup|;
 356   $form->{PRICEGROUPS} = selectall_hashref_query($form, $dbh, $query);
 357
 358 =item Retrieving a single value:
 359
 360   $query = qq|SELECT nextval('glid')|;
 361   ($new_id) = selectrow_query($form, $dbh, $query);
 362
 363 =item Using binding values:
 364
 365   $query = qq|UPDATE ar SET paid = amount + paid, storno = 't' WHERE id = ?|;
 366   do_query($form, $dbh, $query, $id);
 367
 368 =item A more complicated example, using dynamic binding values:
 369
 370   my @values;
 371
 372   if ($form->{language_values} ne "") {
 373     $query = qq|SELECT l.id, l.description, tr.translation, tr.longdescription
 374                   FROM language l
 375                   LEFT OUTER JOIN translation tr ON (tr.language_id = l.id) AND (tr.parts_id = ?)|;
 376     @values = (conv_i($form->{id}));
 377   } else {
 378     $query = qq|SELECT id, description FROM language|;
 379   }
 380
 381   my $languages = selectall_hashref_query($form, $dbh, $query, @values);
 382
 383 =back
 384
 385 =head1 SEE ALSO
 386
 387 =head1 MODULE AUTHORS
 388
 389 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 390 Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
 391
 392 =head1 DOCUMENTATION AUTHORS
 393
 394 Udo Spallek E<lt>udono@gmx.netE<gt>
 395 Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
 396
 397 =head1 COPYRIGHT AND LICENSE
 398
 399 Copyright 2007 by Lx-Office Community
 400
 401 This program is free software; you can redistribute it and/or modify
 402 it under the terms of the GNU General Public License as published by
 403 the Free Software Foundation; either version 2 of the License, or
 404 (at your option) any later version.
 405
 406 This program is distributed in the hope that it will be useful,
 407 but WITHOUT ANY WARRANTY; without even the implied warranty of
 408 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 409 GNU General Public License for more details.
 410 You should have received a copy of the GNU General Public License
 411 along with this program; if not, write to the Free Software
 412 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 413 =cut