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   while ($query =~ /\?/) {
  71     my $value = shift(@_);
  72     $value =~ s/\'/\\\'/g;
  73     $value = "'${value}'";
  74     $query =~ s/\?/$value/;
  75   }
  76
  77   $query =~ s/[\n\s]+/ /g;
  78
  79   $msg .= " " if ($msg);
  80
  81   $main::lxdebug->message($level, $msg . $query);
  82 }
  83
  84 sub quote_db_date {
  85   my ($str) = @_;
  86
  87   return "NULL" unless defined $str;
  88   return "current_date" if $str =~ /current_date/;
  89
  90   $str =~ s/'/''/g;
  91   return "'$str'";
  92 }
  93
  94 sub prepare_query {
  95   $main::lxdebug->enter_sub(2);
  96
  97   my ($form, $dbh, $query) = splice(@_, 0, 3);
  98
  99   dump_query(LXDebug::QUERY, '', $query, @_);
 100
 101   my $sth = $dbh->prepare($query) || $form->dberror($query);
 102
 103   $main::lxdebug->leave_sub(2);
 104
 105   return $sth;
 106 }
 107
 108 sub prepare_execute_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   if (scalar(@_) != 0) {
 117     $sth->execute(@_) || $form->dberror($query . " (" . join(", ", @_) . ")");
 118   } else {
 119     $sth->execute() || $form->dberror($query);
 120   }
 121
 122   $main::lxdebug->leave_sub(2);
 123
 124   return $sth;
 125 }
 126
 127 sub selectall_hashref_query {
 128   $main::lxdebug->enter_sub(2);
 129
 130   my ($form, $dbh, $query) = splice(@_, 0, 3);
 131
 132   my $sth = prepare_execute_query($form, $dbh, $query, @_);
 133   my $result = [];
 134   while (my $ref = $sth->fetchrow_hashref()) {
 135     push(@{ $result }, $ref);
 136   }
 137   $sth->finish();
 138
 139   $main::lxdebug->leave_sub(2);
 140
 141   return $result;
 142 }
 143
 144 sub selectall_array_query {
 145   $main::lxdebug->enter_sub(2);
 146
 147   my ($form, $dbh, $query) = splice(@_, 0, 3);
 148
 149   my $sth = prepare_execute_query($form, $dbh, $query, @_);
 150   my @result;
 151   while (my ($value) = $sth->fetchrow_array()) {
 152     push(@result, $value);
 153   }
 154   $sth->finish();
 155
 156   $main::lxdebug->leave_sub(2);
 157
 158   return @result;
 159 }
 160
 161 sub selectfirst_hashref_query {
 162   $main::lxdebug->enter_sub(2);
 163
 164   my ($form, $dbh, $query) = splice(@_, 0, 3);
 165
 166   my $sth = prepare_execute_query($form, $dbh, $query, @_);
 167   my $ref = $sth->fetchrow_hashref();
 168   $sth->finish();
 169
 170   $main::lxdebug->leave_sub(2);
 171
 172   return $ref;
 173 }
 174
 175 sub selectfirst_array_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 @ret = $sth->fetchrow_array();
 182   $sth->finish();
 183
 184   $main::lxdebug->leave_sub(2);
 185
 186   return @ret;
 187 }
 188
 189 1;
 190
 191
 192 __END__
 193
 194 =head1 NAME
 195
 196 SL::DBUTils.pm: All about Databaseconections in Lx
 197
 198 =head1 SYNOPSIS
 199
 200   use DBUtils;
 201
 202   conv_i
 203   conv_date
 204   conv_dateq
 205   quote_db_date($str)
 206
 207   do_query($form, $dbh, $query)
 208   do_statement($form, $sth, $query)
 209
 210   dump_query($level, $msg, $query)
 211   prepare_execute_query($form, $dbh, $query)
 212
 213   my $all_results_ref       = selectall_hashref_query($form, $dbh, $query)
 214   my $first_result_hash_ref = selectfirst_hashref_query($form, $dbh, $query);
 215
 216   my @first_result =  selectfirst_array_query($form, $dbh, $query);  # ==
 217   my @first_result =  selectrow_query($form, $dbh, $query);
 218
 219
 220 =head1 DESCRIPTION
 221
 222 =head1 FUNCTIONS
 223
 224 =over 4
 225
 226 =item conv_i
 227
 228 =item conv_date
 229
 230 =item conv_dateq
 231
 232 =item quote_db_date($str)
 233
 234 =item do_query($form, $dbh, $query)
 235
 236 =item do_statement($form, $sth, $query)
 237
 238 =item dump_query($level, $msg, $query)
 239
 240 =item prepare_execute_query($form, $dbh, $query)
 241
 242 =item selectall_hashref_query($form, $dbh, $query)
 243
 244 =item selectfirst_hashref_query($form, $dbh, $query);
 245
 246 =item selectfirst_array_query($form, $dbh, $query);  # ==
 247
 248 =item selectrow_query($form, $dbh, $query);
 249
 250 =back
 251
 252 =head1 EXAMPLE
 253
 254 =head1 SEE ALSO
 255
 256 =head1 MODULE AUTHORS
 257
 258 Moritz Bunkus E<lt>m.bunkus@linet-services.de<gt>
 259 Sven Schoeling E<lt>s.schoeling@linet-services.de<gt>
 260
 261 =head1 DOCUMENTATION AUTHORS
 262
 263 Udo Spallek  E<lt>udono@gmx.netE<gt>
 264
 265 =head1 COPYRIGHT AND LICENSE
 266
 267 Copyright 2007 by Lx-Office Community
 268
 269 This program is free software; you can redistribute it and/or modify
 270 it under the terms of the GNU General Public License as published by
 271 the Free Software Foundation; either version 2 of the License, or
 272 (at your option) any later version.
 273
 274 This program is distributed in the hope that it will be useful,
 275 but WITHOUT ANY WARRANTY; without even the implied warranty of
 276 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 277 GNU General Public License for more details.
 278 You should have received a copy of the GNU General Public License
 279 along with this program; if not, write to the Free Software
 280 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 281 =cut