X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDBUtils.pm;h=4a4ac25c19283c91c2765ed5d9c6c9cafdb15027;hb=f9c7abfae65b79945beb7e9260942bc94876248a;hp=36923f46b93bd0105a9d4c746ac2727cd3a00351;hpb=d3f20faab4293434dccf854f39cbe1691960f0dd;p=kivitendo-erp.git diff --git a/SL/DBUtils.pm b/SL/DBUtils.pm index 36923f46b..4a4ac25c1 100644 --- a/SL/DBUtils.pm +++ b/SL/DBUtils.pm @@ -1,15 +1,18 @@ package SL::DBUtils; require Exporter; -@ISA = qw(Exporter); +our @ISA = qw(Exporter); -@EXPORT = qw(conv_i conv_date conv_dateq do_query selectrow_query do_statement +our @EXPORT = qw(conv_i conv_date conv_dateq do_query selectrow_query do_statement dump_query quote_db_date selectfirst_hashref_query selectfirst_array_query selectall_hashref_query selectall_array_query selectall_as_map prepare_execute_query prepare_query - create_sort_spec); + create_sort_spec does_table_exist + add_token); + +use strict; sub conv_i { my ($value, $default) = @_; @@ -35,16 +38,18 @@ sub do_query { my ($form, $dbh, $query) = splice(@_, 0, 3); - dump_query(LXDebug::QUERY, '', $query, @_); + dump_query(LXDebug->QUERY(), '', $query, @_); + my $result; if (0 == scalar(@_)) { - $dbh->do($query) || $form->dberror($query); + $result = $dbh->do($query) || $form->dberror($query); } else { - $dbh->do($query, undef, @_) || - $form->dberror($query . " (" . join(", ", @_) . ")"); + $result = $dbh->do($query, undef, @_) || $form->dberror($query . " (" . join(", ", @_) . ")"); } $main::lxdebug->leave_sub(2); + + return $result; } sub selectrow_query { &selectfirst_array_query } @@ -54,29 +59,32 @@ sub do_statement { my ($form, $sth, $query) = splice(@_, 0, 3); - dump_query(LXDebug::QUERY, '', $query, @_); + dump_query(LXDebug->QUERY(), '', $query, @_); + my $result; if (0 == scalar(@_)) { - $sth->execute() || $form->dberror($query); + $result = $sth->execute() || $form->dberror($query); } else { - $sth->execute(@_) || - $form->dberror($query . " (" . join(", ", @_) . ")"); + $result = $sth->execute(@_) || $form->dberror($query . " (" . join(", ", @_) . ")"); } $main::lxdebug->leave_sub(2); + + return $result; } sub dump_query { my ($level, $msg, $query) = splice(@_, 0, 3); - my $filename = $self_filename = 'SL/DBUtils.pm'; - my $caller_level; + my $self_filename = 'SL/DBUtils.pm'; + my $filename = $self_filename; + my ($caller_level, $line, $subroutine); while ($filename eq $self_filename) { (undef, $filename, $line, $subroutine) = caller $caller_level++; } while ($query =~ /\?/) { - my $value = shift(@_); + my $value = shift || ''; $value =~ s/\'/\\\'/g; $value = "'${value}'"; $query =~ s/\?/$value/; @@ -106,7 +114,7 @@ sub prepare_query { my ($form, $dbh, $query) = splice(@_, 0, 3); - dump_query(LXDebug::QUERY, '', $query, @_); + dump_query(LXDebug->QUERY(), '', $query, @_); my $sth = $dbh->prepare($query) || $form->dberror($query); @@ -120,7 +128,7 @@ sub prepare_execute_query { my ($form, $dbh, $query) = splice(@_, 0, 3); - dump_query(LXDebug::QUERY, '', $query, @_); + dump_query(LXDebug->QUERY(), '', $query, @_); my $sth = $dbh->prepare($query) || $form->dberror($query); if (scalar(@_) != 0) { @@ -139,12 +147,11 @@ sub selectall_hashref_query { my ($form, $dbh, $query) = splice(@_, 0, 3); - my $sth = prepare_execute_query($form, $dbh, $query, @_); - my $result = []; - while (my $ref = $sth->fetchrow_hashref()) { - push(@{ $result }, $ref); - } - $sth->finish(); + dump_query(LXDebug->QUERY(), '', $query, @_); + + # this works back 'til at least DBI 1.46 on perl 5.8.4 on Debian Sarge (2004) + my $result = $dbh->selectall_arrayref($query, { Slice => {} }, @_) + or $form->dberror($query . (@_ ? " (" . join(", ", @_) . ")" : '')); $main::lxdebug->leave_sub(2); @@ -255,6 +262,84 @@ sub create_sort_spec { return %result; } +sub does_table_exist { + $main::lxdebug->enter_sub(2); + + my $dbh = shift; + my $table = shift; + + my $result = 0; + + if ($dbh) { + my $sth = $dbh->table_info('', '', $table, 'TABLE'); + if ($sth) { + $result = $sth->fetchrow_hashref(); + $sth->finish(); + } + } + + $main::lxdebug->leave_sub(2); + + return $result; +} + +# add token to values. +# usage: +# add_token( +# \@where_tokens, +# \@where_values, +# col => 'id', +# val => [ 23, 34, 17 ] +# esc => \&conf_i +# ) +# will append to the given arrays: +# -> 'id IN (?, ?, ?)' +# -> (conv_i(23), conv_i(34), conv_i(17)) +# +# features: +# - don't care if one or multiple values are given. singlewill result in 'col = ?' +# - pass escape routines +# - expand for future method +# - no need to type "push @where_tokens, 'id = ?'" over and over again +sub add_token { + my $tokens = shift() || []; + my $values = shift() || []; + my %params = @_; + my $col = $params{col}; + my $val = $params{val}; + my $method = $params{method} || '='; + my $escape = $params{esc} || sub { $_ }; + + $val = [ $val ] unless ref $val eq 'ARRAY'; + + my %escapes = ( + id => \&conv_i, + date => \&conv_date, + ); + + my %methods = ( + '=' => sub { + my $col = shift; + return scalar @_ > 1 ? sprintf '%s IN (%s)', $col, join ', ', ("?") x scalar @_ + : scalar @_ == 1 ? sprintf '%s = ?', $col + : undef; + }, + ); + + $method = $methods{$method} || $method; + $escape = $escapes{$escape} || $escape; + + my $token = $method->($col, @{ $val }); + my @vals = map { $escape->($_) } @{ $val }; + + return unless $token; + + push @{ $tokens }, $token; + push @{ $values }, @vals; + + return ($token, @vals); +} + 1; @@ -267,7 +352,7 @@ SL::DBUTils.pm: All about Databaseconections in Lx =head1 SYNOPSIS use DBUtils; - + conv_i($str, $default) conv_date($str) conv_dateq($str) @@ -281,10 +366,10 @@ SL::DBUTils.pm: All about Databaseconections in Lx my $all_results_ref = selectall_hashref_query($form, $dbh, $query) my $first_result_hash_ref = selectfirst_hashref_query($form, $dbh, $query); - + my @first_result = selectfirst_array_query($form, $dbh, $query); # == my @first_result = selectrow_query($form, $dbh, $query); - + my %sort_spec = create_sort_spec(%params); =head1 DESCRIPTION @@ -303,8 +388,8 @@ Every function here should accomplish the follwing things: - Safe value binding. Although DBI is far from perfect in terms of binding, the rest of the bindings should happen here. - Error handling. Should a query fail, an error message will be generated here instead of in the backend code invoking DBUtils. -Note that binding is not perfect here either... - +Note that binding is not perfect here either... + =head2 QUOTING FUNCTIONS =over 4 @@ -338,10 +423,14 @@ Returns 'NULL' if STR is empty. 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. +Returns the result of DBI::do which is -1 in case of an error and the number of affected rows otherwise. + =item do_statement FORM,STH,QUERY,ARRAY 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. +Returns the result of DBI::execute which is -1 in case of an error and the number of affected rows otherwise. + =item prepare_execute_query FORM,DBH,QUERY,ARRAY Prepares and executes QUERY on DBH using DBI::prepare and DBI::execute. ARRAY is passed as binding values to execute. @@ -356,11 +445,11 @@ Prepares and executes QUERY on DBH using DBI::prepare and DBI::execute. ARRAY is =item selectrow_query FORM,DBH,QUERY,ARRAY -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. +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. =item selectfirst_hashref_query FORM,DBH,QUERY,ARRAY -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. +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. =item selectall_hashref_query FORM,DBH,QUERY,ARRAY @@ -454,7 +543,7 @@ Dumps a query using LXDebug->message, using LEVEL for the debug-level of LXDebug =item A more complicated example, using dynamic binding values: my @values; - + if ($form->{language_values} ne "") { $query = qq|SELECT l.id, l.description, tr.translation, tr.longdescription FROM language l @@ -463,18 +552,16 @@ Dumps a query using LXDebug->message, using LEVEL for the debug-level of LXDebug } else { $query = qq|SELECT id, description FROM language|; } - + my $languages = selectall_hashref_query($form, $dbh, $query, @values); =back -=head1 SEE ALSO - =head1 MODULE AUTHORS Moritz Bunkus Em.bunkus@linet-services.deE Sven Schoeling Es.schoeling@linet-services.deE - + =head1 DOCUMENTATION AUTHORS Udo Spallek Eudono@gmx.netE @@ -496,4 +583,4 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -=cut +=cut