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