X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDBUtils.pm;h=4a4ac25c19283c91c2765ed5d9c6c9cafdb15027;hb=e1bf173bae820584e8bafdc01ebe2e7d7537a59c;hp=df4c5ac9363fd8b93aa4e6fbcbafc0d1e09038a8;hpb=d1f932ad48cf69e11e55d10d65fb6c5e528ea55e;p=kivitendo-erp.git diff --git a/SL/DBUtils.pm b/SL/DBUtils.pm index df4c5ac93..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,7 +38,7 @@ 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(@_)) { @@ -56,7 +59,7 @@ 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(@_)) { @@ -73,14 +76,15 @@ sub do_statement { 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/; @@ -110,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); @@ -124,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) { @@ -143,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); @@ -259,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; @@ -271,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) @@ -285,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 @@ -307,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 @@ -364,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 @@ -462,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 @@ -471,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 @@ -504,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