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