X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDBUtils.pm;h=5fc33cedc75dedbc9c73f0653d0efe22af756793;hb=67079598f8f98a12e12a8acddc3afbf12bb58c5d;hp=e041e10014160119a421b1b20c2871b960e4a248;hpb=66022cbd0893e066eec8826a15884d2d0457fe4f;p=kivitendo-erp.git diff --git a/SL/DBUtils.pm b/SL/DBUtils.pm index e041e1001..5fc33cedc 100644 --- a/SL/DBUtils.pm +++ b/SL/DBUtils.pm @@ -19,6 +19,14 @@ sub conv_i { return (defined($value) && "$value" ne "") ? $value * 1 : $default; } +# boolean escape +sub conv_b { + my ($value, $default) = @_; + return !defined $value && defined $default ? $default + : $value ? 't' + : 'f'; +} + sub conv_date { my ($value) = @_; return (defined($value) && "$value" ne "") ? $value : undef; @@ -84,7 +92,7 @@ sub dump_query { } while ($query =~ /\?/) { - my $value = shift(@_); + my $value = shift || ''; $value =~ s/\'/\\\'/g; $value = "'${value}'"; $query =~ s/\?/$value/; @@ -147,12 +155,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); @@ -308,16 +315,29 @@ sub add_token { my %params = @_; my $col = $params{col}; my $val = $params{val}; - my $method = $params{method} || '='; my $escape = $params{esc} || sub { $_ }; + my $method = $params{esc} =~ /^start|end|substr$/ ? 'ILIKE' : $params{method} || '='; $val = [ $val ] unless ref $val eq 'ARRAY'; my %escapes = ( id => \&conv_i, + bool => \&conv_b, date => \&conv_date, + start => sub { $_[0] . '%' }, + end => sub { '%' . $_[0] }, + substr => sub { '%' . $_[0] . '%' }, ); + my $_long_token = sub { + my $op = shift; + sub { + my $col = shift; + return scalar @_ ? join ' OR ', ("$col $op ?") x scalar @_, + : undef; + } + }; + my %methods = ( '=' => sub { my $col = shift; @@ -325,6 +345,7 @@ sub add_token { : scalar @_ == 1 ? sprintf '%s = ?', $col : undef; }, + map({ $_ => $_long_token->($_) } qw(LIKE ILIKE >= <= > <)), ); $method = $methods{$method} || $method;