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