kivitendo/SL/DBUtils.pm @ c45403f9
| e7530c83 | Moritz Bunkus | package SL::DBUtils;
|
||
| 88dea78e | Moritz Bunkus | use SL::Util qw(trim);
|
||
| e7530c83 | Moritz Bunkus | require Exporter;
|
||
| ed944ca3 | Sven Schöling | our @ISA = qw(Exporter);
|
||
| e7530c83 | Moritz Bunkus | |||
| ed944ca3 | Sven Schöling | our @EXPORT = qw(conv_i conv_date conv_dateq do_query selectrow_query do_statement
|
||
| bed19453 | Moritz Bunkus | dump_query quote_db_date like
|
||
| 93a4e424 | Moritz Bunkus | selectfirst_hashref_query selectfirst_array_query
|
||
| 4b29b4b6 | Geoffrey Richardson | selectall_hashref_query selectall_array_query selectcol_array_query
|
||
| 8c7e4493 | Moritz Bunkus | selectall_as_map
|
||
| 188696a4 | Sven Schöling | selectall_ids
|
||
| d3f20faa | Moritz Bunkus | prepare_execute_query prepare_query
|
||
| 451843cf | Sven Schöling | create_sort_spec does_table_exist
|
||
| 8f07fac1 | Bernd Bleßmann | add_token check_trgm);
|
||
| e7530c83 | Moritz Bunkus | |||
| 3d967be3 | Sven Schöling | use strict;
|
||
| e7530c83 | Moritz Bunkus | sub conv_i {
|
||
my ($value, $default) = @_;
|
||||
return (defined($value) && "$value" ne "") ? $value * 1 : $default;
|
||||
}
|
||||
| 8545bbce | Sven Schöling | # boolean escape
|
||
sub conv_b {
|
||||
my ($value, $default) = @_;
|
||||
return !defined $value && defined $default ? $default
|
||||
: $value ? 't'
|
||||
: 'f';
|
||||
}
|
||||
| e7530c83 | Moritz Bunkus | sub conv_date {
|
||
my ($value) = @_;
|
||||
| 88dea78e | Moritz Bunkus | return undef if !defined $value;
|
||
$value = trim($value);
|
||||
return $value eq "" ? undef : $value;
|
||||
| e7530c83 | Moritz Bunkus | }
|
||
| 5b47ed3e | Moritz Bunkus | sub conv_dateq {
|
||
my ($value) = @_;
|
||||
if (defined($value) && "$value" ne "") {
|
||||
$value =~ s/\'/\'\'/g;
|
||||
return "'$value'";
|
||||
}
|
||||
return "NULL";
|
||||
}
|
||||
| e7530c83 | Moritz Bunkus | sub do_query {
|
||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->enter_sub(2);
|
||
| e7530c83 | Moritz Bunkus | my ($form, $dbh, $query) = splice(@_, 0, 3);
|
||
| 12451e34 | Udo Spallek | |||
| ed944ca3 | Sven Schöling | dump_query(LXDebug->QUERY(), '', $query, @_);
|
||
| 12451e34 | Udo Spallek | |||
| d1f932ad | Moritz Bunkus | my $result;
|
||
| e7530c83 | Moritz Bunkus | if (0 == scalar(@_)) {
|
||
| d1f932ad | Moritz Bunkus | $result = $dbh->do($query) || $form->dberror($query);
|
||
| e7530c83 | Moritz Bunkus | } else {
|
||
| d1f932ad | Moritz Bunkus | $result = $dbh->do($query, undef, @_) || $form->dberror($query . " (" . join(", ", @_) . ")");
|
||
| e7530c83 | Moritz Bunkus | }
|
||
| 4b17bfa8 | Moritz Bunkus | |||
$main::lxdebug->leave_sub(2);
|
||||
| d1f932ad | Moritz Bunkus | |||
return $result;
|
||||
| e7530c83 | Moritz Bunkus | }
|
||
| 7b825818 | Sven Schöling | sub selectrow_query { &selectfirst_array_query }
|
||
| 2b664a1f | Moritz Bunkus | |||
| dcef6ec7 | Moritz Bunkus | sub do_statement {
|
||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->enter_sub(2);
|
||
| dcef6ec7 | Moritz Bunkus | my ($form, $sth, $query) = splice(@_, 0, 3);
|
||
| ed944ca3 | Sven Schöling | dump_query(LXDebug->QUERY(), '', $query, @_);
|
||
| 12451e34 | Udo Spallek | |||
| d1f932ad | Moritz Bunkus | my $result;
|
||
| dcef6ec7 | Moritz Bunkus | if (0 == scalar(@_)) {
|
||
| d1f932ad | Moritz Bunkus | $result = $sth->execute() || $form->dberror($query);
|
||
| dcef6ec7 | Moritz Bunkus | } else {
|
||
| d1f932ad | Moritz Bunkus | $result = $sth->execute(@_) || $form->dberror($query . " (" . join(", ", @_) . ")");
|
||
| dcef6ec7 | Moritz Bunkus | }
|
||
| 4b17bfa8 | Moritz Bunkus | |||
$main::lxdebug->leave_sub(2);
|
||||
| d1f932ad | Moritz Bunkus | |||
return $result;
|
||||
| dcef6ec7 | Moritz Bunkus | }
|
||
| e7530c83 | Moritz Bunkus | sub dump_query {
|
||
my ($level, $msg, $query) = splice(@_, 0, 3);
|
||||
| 12451e34 | Udo Spallek | |||
| ed944ca3 | Sven Schöling | my $self_filename = 'SL/DBUtils.pm';
|
||
my $filename = $self_filename;
|
||||
my ($caller_level, $line, $subroutine);
|
||||
| b7eaaf1f | Bernd Bleßmann | while ($filename =~ m{$self_filename$}) {
|
||
| 09239113 | Sven Schöling | (undef, $filename, $line, $subroutine) = caller $caller_level++;
|
||
}
|
||||
| e7530c83 | Moritz Bunkus | while ($query =~ /\?/) {
|
||
| 49ce0054 | Sven Schöling | my $value = shift || '';
|
||
| e7530c83 | Moritz Bunkus | $value =~ s/\'/\\\'/g;
|
||
$value = "'${value}'";
|
||||
$query =~ s/\?/$value/;
|
||||
}
|
||||
| 874ae842 | Sven Schöling | $query =~ s/[\n\s]+/ /g;
|
||
| e7530c83 | Moritz Bunkus | $msg .= " " if ($msg);
|
||
| 09239113 | Sven Schöling | my $info = "$subroutine called from $filename:$line\n";
|
||
$main::lxdebug->message($level, $info . $msg . $query);
|
||||
| e7530c83 | Moritz Bunkus | }
|
||
| 04c85293 | Sven Schöling | sub quote_db_date {
|
||
my ($str) = @_;
|
||||
| 12451e34 | Udo Spallek | |||
| 04c85293 | Sven Schöling | return "NULL" unless defined $str;
|
||
return "current_date" if $str =~ /current_date/;
|
||||
| 12451e34 | Udo Spallek | |||
| 58a1b54b | Moritz Bunkus | $str =~ s/\'/\'\'/g;
|
||
| 04c85293 | Sven Schöling | return "'$str'";
|
||
}
|
||||
| 93a4e424 | Moritz Bunkus | sub prepare_query {
|
||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->enter_sub(2);
|
||
| 93a4e424 | Moritz Bunkus | my ($form, $dbh, $query) = splice(@_, 0, 3);
|
||
| ed944ca3 | Sven Schöling | dump_query(LXDebug->QUERY(), '', $query, @_);
|
||
| 93a4e424 | Moritz Bunkus | |||
my $sth = $dbh->prepare($query) || $form->dberror($query);
|
||||
| 4b17bfa8 | Moritz Bunkus | |||
$main::lxdebug->leave_sub(2);
|
||||
| 93a4e424 | Moritz Bunkus | return $sth;
|
||
}
|
||||
| 9d047497 | Moritz Bunkus | sub prepare_execute_query {
|
||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->enter_sub(2);
|
||
| 9d047497 | Moritz Bunkus | my ($form, $dbh, $query) = splice(@_, 0, 3);
|
||
| 12451e34 | Udo Spallek | |||
| ed944ca3 | Sven Schöling | dump_query(LXDebug->QUERY(), '', $query, @_);
|
||
| 12451e34 | Udo Spallek | |||
my $sth = $dbh->prepare($query) || $form->dberror($query);
|
||||
| 9d047497 | Moritz Bunkus | if (scalar(@_) != 0) {
|
||
$sth->execute(@_) || $form->dberror($query . " (" . join(", ", @_) . ")");
|
||||
} else {
|
||||
$sth->execute() || $form->dberror($query);
|
||||
}
|
||||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->leave_sub(2);
|
||
| 9d047497 | Moritz Bunkus | return $sth;
|
||
}
|
||||
sub selectall_hashref_query {
|
||||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->enter_sub(2);
|
||
| 9d047497 | Moritz Bunkus | my ($form, $dbh, $query) = splice(@_, 0, 3);
|
||
| 33ba9950 | Sven Schöling | 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(", ", @_) . ")" : ''));
|
||||
| 9d047497 | Moritz Bunkus | |||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->leave_sub(2);
|
||
| f0949ba8 | Moritz Bunkus | return wantarray ? @{ $result } : $result;
|
||
| 9d047497 | Moritz Bunkus | }
|
||
| 4b29b4b6 | Geoffrey Richardson | sub selectall_array_query { goto &selectcol_array_query; }
|
||
sub selectcol_array_query {
|
||||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->enter_sub(2);
|
||
| 93a4e424 | Moritz Bunkus | my ($form, $dbh, $query) = splice(@_, 0, 3);
|
||
my $sth = prepare_execute_query($form, $dbh, $query, @_);
|
||||
| 4b29b4b6 | Geoffrey Richardson | my @result = @{ $dbh->selectcol_arrayref($sth) };
|
||
| 93a4e424 | Moritz Bunkus | $sth->finish();
|
||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->leave_sub(2);
|
||
| 93a4e424 | Moritz Bunkus | return @result;
|
||
}
|
||||
| 15d5b55d | Sven Schöling | sub selectfirst_hashref_query {
|
||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->enter_sub(2);
|
||
| 15d5b55d | Sven Schöling | my ($form, $dbh, $query) = splice(@_, 0, 3);
|
||
my $sth = prepare_execute_query($form, $dbh, $query, @_);
|
||||
my $ref = $sth->fetchrow_hashref();
|
||||
$sth->finish();
|
||||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->leave_sub(2);
|
||
| 15d5b55d | Sven Schöling | return $ref;
|
||
}
|
||||
| 9d047497 | Moritz Bunkus | |||
| 7b825818 | Sven Schöling | sub selectfirst_array_query {
|
||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->enter_sub(2);
|
||
| 7b825818 | Sven Schöling | my ($form, $dbh, $query) = splice(@_, 0, 3);
|
||
my $sth = prepare_execute_query($form, $dbh, $query, @_);
|
||||
my @ret = $sth->fetchrow_array();
|
||||
$sth->finish();
|
||||
| 4b17bfa8 | Moritz Bunkus | $main::lxdebug->leave_sub(2);
|
||
| 7b825818 | Sven Schöling | return @ret;
|
||
}
|
||||
| 8c7e4493 | Moritz Bunkus | sub selectall_as_map {
|
||
$main::lxdebug->enter_sub(2);
|
||||
my ($form, $dbh, $query, $key_col, $value_col) = splice(@_, 0, 5);
|
||||
my $sth = prepare_execute_query($form, $dbh, $query, @_);
|
||||
my %hash;
|
||||
if ('' eq ref $value_col) {
|
||||
while (my $ref = $sth->fetchrow_hashref()) {
|
||||
| 8f3e8a02 | Moritz Bunkus | $hash{$ref->{$key_col} // ''} = $ref->{$value_col};
|
||
| 8c7e4493 | Moritz Bunkus | }
|
||
} else {
|
||||
while (my $ref = $sth->fetchrow_hashref()) {
|
||||
| 8f3e8a02 | Moritz Bunkus | $hash{$ref->{$key_col} // ''} = { map { $_ => $ref->{$_} } @{ $value_col } };
|
||
| 8c7e4493 | Moritz Bunkus | }
|
||
}
|
||||
$sth->finish();
|
||||
$main::lxdebug->leave_sub(2);
|
||||
return %hash;
|
||||
}
|
||||
| 188696a4 | Sven Schöling | sub selectall_ids {
|
||
$main::lxdebug->enter_sub(2);
|
||||
my ($form, $dbh, $query, $key_col) = splice(@_, 0, 4);
|
||||
my $sth = prepare_execute_query($form, $dbh, $query, @_);
|
||||
my @ids;
|
||||
while (my $ref = $sth->fetchrow_arrayref()) {
|
||||
push @ids, $ref->[$key_col];
|
||||
}
|
||||
$sth->finish;
|
||||
$main::lxdebug->leave_sub(2);
|
||||
return @ids;
|
||||
}
|
||||
| d3f20faa | Moritz Bunkus | sub create_sort_spec {
|
||
$main::lxdebug->enter_sub(2);
|
||||
my %params = @_;
|
||||
# Safety check:
|
||||
$params{defs} || die;
|
||||
$params{default} || die;
|
||||
# The definition of valid columns to sort by.
|
||||
my $defs = $params{defs};
|
||||
# The column name to sort by. Use the default column name if none was given.
|
||||
my %result = ( 'column' => $params{column} || $params{default} );
|
||||
# Overwrite the column name with the default column name if the other one is not valid.
|
||||
$result{column} = $params{default} unless ($defs->{ $result{column} });
|
||||
# The sort direction. true means 'sort ascending', false means 'sort descending'.
|
||||
$result{dir} = defined $params{dir} ? $params{dir}
|
||||
: defined $params{default_dir} ? $params{default_dir}
|
||||
: 1;
|
||||
$result{dir} = $result{dir} ? 1 : 0;
|
||||
my $asc_desc = $result{dir} ? 'ASC' : 'DESC';
|
||||
# Create the SQL code.
|
||||
my $cols = $defs->{ $result{column} };
|
||||
$result{sql} = join ', ', map { "${_} ${asc_desc}" } @{ ref $cols eq 'ARRAY' ? $cols : [ $cols ] };
|
||||
$main::lxdebug->leave_sub(2);
|
||||
return %result;
|
||||
}
|
||||
| 32147d43 | Moritz Bunkus | 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;
|
||||
}
|
||||
| 451843cf | Sven Schöling | # 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 $escape = $params{esc} || sub { $_ };
|
||||
| 8545bbce | Sven Schöling | my $method = $params{esc} =~ /^start|end|substr$/ ? 'ILIKE' : $params{method} || '=';
|
||
| 451843cf | Sven Schöling | |||
$val = [ $val ] unless ref $val eq 'ARRAY';
|
||||
my %escapes = (
|
||||
id => \&conv_i,
|
||||
| 8545bbce | Sven Schöling | bool => \&conv_b,
|
||
| 451843cf | Sven Schöling | date => \&conv_date,
|
||
| bc40bcab | Moritz Bunkus | start => sub { trim($_[0]) . '%' },
|
||
end => sub { '%' . trim($_[0]) },
|
||||
substr => sub { like($_[0]) },
|
||||
| 451843cf | Sven Schöling | );
|
||
| 8545bbce | Sven Schöling | my $_long_token = sub {
|
||
my $op = shift;
|
||||
sub {
|
||||
my $col = shift;
|
||||
return scalar @_ ? join ' OR ', ("$col $op ?") x scalar @_,
|
||||
: undef;
|
||||
}
|
||||
};
|
||||
| 451843cf | Sven Schöling | my %methods = (
|
||
'=' => sub {
|
||||
my $col = shift;
|
||||
return scalar @_ > 1 ? sprintf '%s IN (%s)', $col, join ', ', ("?") x scalar @_
|
||||
: scalar @_ == 1 ? sprintf '%s = ?', $col
|
||||
: undef;
|
||||
},
|
||||
| 8545bbce | Sven Schöling | map({ $_ => $_long_token->($_) } qw(LIKE ILIKE >= <= > <)),
|
||
| 451843cf | Sven Schöling | );
|
||
$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);
|
||||
}
|
||||
| 32147d43 | Moritz Bunkus | |||
| bed19453 | Moritz Bunkus | sub like {
|
||
my ($string) = @_;
|
||||
return "%" . SL::Util::trim($string // '') . "%";
|
||||
}
|
||||
| be54aea5 | Moritz Bunkus | sub role_is_superuser {
|
||
my ($dbh, $login) = @_;
|
||||
my ($is_superuser) = $dbh->selectrow_array(qq|SELECT usesuper FROM pg_user WHERE usename = ?|, undef, $login);
|
||||
return $is_superuser;
|
||||
}
|
||||
| 8f07fac1 | Bernd Bleßmann | sub check_trgm {
|
||
my ($dbh) = @_;
|
||||
my $version = $dbh->selectrow_array(qq|SELECT installed_version FROM pg_available_extensions WHERE name = 'pg_trgm'|);
|
||||
return !!$version;
|
||||
}
|
||||
| e7530c83 | Moritz Bunkus | 1;
|
||
| 12451e34 | Udo Spallek | |||
__END__
|
||||
| 611491d9 | Sven Schöling | =encoding utf-8
|
||
| 12451e34 | Udo Spallek | =head1 NAME
|
||
| 52683706 | Geoffrey Richardson | SL::DBUtils.pm: All about database connections in kivitendo
|
||
| 12451e34 | Udo Spallek | |||
=head1 SYNOPSIS
|
||||
use DBUtils;
|
||||
| 451843cf | Sven Schöling | |||
| 743f51fc | Sven Schöling | conv_i($str, $default)
|
||
conv_date($str)
|
||||
conv_dateq($str)
|
||||
quote_db_date($date)
|
||||
| 12451e34 | Udo Spallek | |||
| 52683706 | Geoffrey Richardson | my $dbh = SL::DB->client->dbh;
|
||
| 12451e34 | Udo Spallek | do_query($form, $dbh, $query)
|
||
do_statement($form, $sth, $query)
|
||||
dump_query($level, $msg, $query)
|
||||
prepare_execute_query($form, $dbh, $query)
|
||||
my $all_results_ref = selectall_hashref_query($form, $dbh, $query)
|
||||
my $first_result_hash_ref = selectfirst_hashref_query($form, $dbh, $query);
|
||||
| 451843cf | Sven Schöling | |||
| 52683706 | Geoffrey Richardson | my @first_result = selectfirst_array_query($form, $dbh, $query);
|
||
| 12451e34 | Udo Spallek | my @first_result = selectrow_query($form, $dbh, $query);
|
||
| 451843cf | Sven Schöling | |||
| 4b29b4b6 | Geoffrey Richardson | my @values = selectcol_array_query($form, $dbh, $query);
|
||
| d3f20faa | Moritz Bunkus | my %sort_spec = create_sort_spec(%params);
|
||
| 12451e34 | Udo Spallek | =head1 DESCRIPTION
|
||
| 743f51fc | Sven Schöling | |||
| 611491d9 | Sven Schöling | DBUtils provides wrapper functions for low level database retrieval. It saves
|
||
| 51dd16d6 | Geoffrey Richardson | you the trouble of mucking around with statement handles for small database
|
||
| 611491d9 | Sven Schöling | queries and does exception handling in the common cases for you.
|
||
| cc125b4f | Geoffrey Richardson | Query and retrieval functions share the parameter scheme:
|
||
| 611491d9 | Sven Schöling | |||
query_or_retrieval(C<FORM, DBH, QUERY[, BINDVALUES]>)
|
||||
=over 4
|
||||
=item *
|
||||
C<FORM> is used for error handling only. It can be omitted in theory, but should
|
||||
not. In most cases you will call it with C<$::form>.
|
||||
=item *
|
||||
C<DBH> is a handle to the database, as returned by the C<DBI::connect> routine.
|
||||
If you don't have an active connection, you can use
|
||||
| 52683706 | Geoffrey Richardson | C<SL::DB->client->dbh> or get a C<Rose::DB::Object> handle from any RDBO class with
|
||
C<<SL::DB::Part->new->db->dbh>>. In both cases the handle will have AutoCommit set.
|
||||
| 611491d9 | Sven Schöling | |||
See C<PITFALLS AND CAVEATS> for common errors.
|
||||
=item *
|
||||
C<QUERY> must be exactly one query. You don't need to include the terminal
|
||||
C<;>. There must be no tainted data interpolated into the string. Instead use
|
||||
the DBI placeholder syntax.
|
||||
=item *
|
||||
All additional parameters will be used as C<BINDVALUES> for the query. Note
|
||||
that DBI can't bind arrays to a C<id IN (?)>, so you will need to generate a
|
||||
statement with exactly one C<?> for each bind value. DBI can however bind
|
||||
DateTime objects, and you should always pass these for date selections.
|
||||
=back
|
||||
=head1 PITFALLS AND CAVEATS
|
||||
=head2 Locking
|
||||
| 743f51fc | Sven Schöling | |||
| 611491d9 | Sven Schöling | As mentioned above, there are two sources of database handles in the program:
|
||
C<<$::form->get_standard_dbh>> and C<<SL::DB::Object->new->db->dbh>>. It's easy
|
||||
to produce deadlocks when using both of them. To reduce the likelyhood of
|
||||
locks, try to obey these rules:
|
||||
| 743f51fc | Sven Schöling | |||
| 611491d9 | Sven Schöling | =over 4
|
||
=item *
|
||||
In a controller that uses Rose objects, never use C<get_standard_dbh>.
|
||||
=item *
|
||||
In backend code, that has no preference, always accept the database handle as a
|
||||
parameter from the controller.
|
||||
=back
|
||||
=head2 Exports
|
||||
C<DBUtils> is one of the last modules in the program to use C<@EXPORT> instead
|
||||
of C<@EXPORT_OK>. This means it will flood your namespace with its functions,
|
||||
causing potential clashes. When writing new code, always either export nothing
|
||||
and call directly:
|
||||
| 743f51fc | Sven Schöling | |||
| 611491d9 | Sven Schöling | use SL::DBUtils ();
|
||
DBUtils::selectall_hashref_query(...)
|
||||
| 743f51fc | Sven Schöling | |||
| 611491d9 | Sven Schöling | or export only what you need:
|
||
| 743f51fc | Sven Schöling | |||
| 611491d9 | Sven Schöling | use SL::DBUtils qw(selectall_hashref_query);
|
||
selectall_hashref_query(...)
|
||||
| 451843cf | Sven Schöling | |||
| 611491d9 | Sven Schöling | |||
| 52683706 | Geoffrey Richardson | =head2 Performance
|
||
| 611491d9 | Sven Schöling | |||
Since it is really easy to write something like
|
||||
my $all_parts = selectall_hashref_query($::form, $dbh, 'SELECT * FROM parts');
|
||||
people do so from time to time. When writing code, consider this a ticking
|
||||
timebomb. Someone out there has a database with 1mio parts in it, and this
|
||||
| 52683706 | Geoffrey Richardson | statement just gobbled up 2GB of memory and timeouted the request.
|
||
| 611491d9 | Sven Schöling | |||
Parts may be the obvious example, but the same applies to customer, vendors,
|
||||
records, projects or custom variables.
|
||||
=head1 QUOTING FUNCTIONS
|
||||
| 743f51fc | Sven Schöling | |||
| 12451e34 | Udo Spallek | =over 4
|
||
| 743f51fc | Sven Schöling | =item conv_i STR
|
||
| 12451e34 | Udo Spallek | |||
| 743f51fc | Sven Schöling | =item conv_i STR,DEFAULT
|
||
| 12451e34 | Udo Spallek | |||
| 611491d9 | Sven Schöling | Converts STR to an integer. If STR is empty, returns DEFAULT. If no DEFAULT is
|
||
given, returns undef.
|
||||
| 12451e34 | Udo Spallek | |||
| 743f51fc | Sven Schöling | =item conv_date STR
|
||
| 12451e34 | Udo Spallek | |||
| 743f51fc | Sven Schöling | Converts STR to a date string. If STR is emptry, returns undef.
|
||
| 12451e34 | Udo Spallek | |||
| 743f51fc | Sven Schöling | =item conv_dateq STR
|
||
| 12451e34 | Udo Spallek | |||
| 611491d9 | Sven Schöling | Database version of conv_date. Quotes STR before returning. Returns 'NULL' if
|
||
STR is empty.
|
||||
| 12451e34 | Udo Spallek | |||
| 743f51fc | Sven Schöling | =item quote_db_date STR
|
||
| 12451e34 | Udo Spallek | |||
| 611491d9 | Sven Schöling | 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.
|
||||
Returns C<'NULL'> if STR is empty.
|
||||
| 12451e34 | Udo Spallek | |||
| bed19453 | Moritz Bunkus | =item like STR
|
||
Turns C<STR> into an argument suitable for SQL's C<LIKE> and C<ILIKE>
|
||||
operators by Trimming the string C<STR> (removes leading and trailing
|
||||
whitespaces) and prepending and appending C<%>.
|
||||
| 743f51fc | Sven Schöling | =back
|
||
| 611491d9 | Sven Schöling | =head1 QUERY FUNCTIONS
|
||
| 743f51fc | Sven Schöling | |||
=over 4
|
||||
=item do_query FORM,DBH,QUERY,ARRAY
|
||||
| 611491d9 | Sven Schöling | 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.
|
||||
| 743f51fc | Sven Schöling | |||
| 611491d9 | Sven Schöling | Returns the result of DBI::do which is -1 in case of an error and the number of
|
||
affected rows otherwise.
|
||||
| d1f932ad | Moritz Bunkus | |||
| 743f51fc | Sven Schöling | =item do_statement FORM,STH,QUERY,ARRAY
|
||
| 611491d9 | Sven Schöling | 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.
|
||||
| 743f51fc | Sven Schöling | |||
| 611491d9 | Sven Schöling | Returns the result of DBI::execute which is -1 in case of an error and the
|
||
number of affected rows otherwise.
|
||||
| d1f932ad | Moritz Bunkus | |||
| 743f51fc | Sven Schöling | =item prepare_execute_query FORM,DBH,QUERY,ARRAY
|
||
| 611491d9 | Sven Schöling | Prepares and executes QUERY on DBH using DBI::prepare and DBI::execute. ARRAY
|
||
is passed as binding values to execute.
|
||||
| 12451e34 | Udo Spallek | |||
=back
|
||||
| 743f51fc | Sven Schöling | |||
| 611491d9 | Sven Schöling | =head1 RETRIEVAL FUNCTIONS
|
||
| 743f51fc | Sven Schöling | |||
=over 4
|
||||
=item selectfirst_array_query FORM,DBH,QUERY,ARRAY
|
||||
=item selectrow_query FORM,DBH,QUERY,ARRAY
|
||||
| cc125b4f | Geoffrey Richardson | Prepares and executes a query using DBUtils functions, retrieves the first row
|
||
| 611491d9 | Sven Schöling | from the database, and returns it as an arrayref of the first row.
|
||
| 743f51fc | Sven Schöling | |||
=item selectfirst_hashref_query FORM,DBH,QUERY,ARRAY
|
||||
| cc125b4f | Geoffrey Richardson | Prepares and executes a query using DBUtils functions, retrieves the first row
|
||
| 611491d9 | Sven Schöling | from the database, and returns it as a hashref of the first row.
|
||
| 743f51fc | Sven Schöling | |||
=item selectall_hashref_query FORM,DBH,QUERY,ARRAY
|
||||
| cc125b4f | Geoffrey Richardson | Prepares and executes a query using DBUtils functions, retrieves all data from
|
||
| 611491d9 | Sven Schöling | 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.
|
||||
| 743f51fc | Sven Schöling | |||
| 4b29b4b6 | Geoffrey Richardson | |||
=item selectall_array_query FORM,DBH,QUERY,ARRAY
|
||||
Deprecated, see C<selectcol_array_query>
|
||||
=item selectcol_array_query FORM,DBH,QUERY,ARRAY
|
||||
Prepares and executes a query using DBUtils functions, retrieves the values of
|
||||
the first result column and returns the values as an array.
|
||||
| 8c7e4493 | Moritz Bunkus | =item selectall_as_map FORM,DBH,QUERY,KEY_COL,VALUE_COL,ARRAY
|
||
| cc125b4f | Geoffrey Richardson | Prepares and executes a query using DBUtils functions, retrieves all data from
|
||
| 611491d9 | Sven Schöling | the database, and creates a hash from the results using KEY_COL as the column
|
||
for the hash keys and VALUE_COL for its values.
|
||||
| 8c7e4493 | Moritz Bunkus | |||
| 743f51fc | Sven Schöling | =back
|
||
| 611491d9 | Sven Schöling | =head1 UTILITY FUNCTIONS
|
||
| d3f20faa | Moritz Bunkus | |||
=over 4
|
||||
=item create_sort_spec
|
||||
params:
|
||||
defs => { }, # mandatory
|
||||
default => 'name', # mandatory
|
||||
column => 'name',
|
||||
default_dir => 0|1,
|
||||
dir => 0|1,
|
||||
returns hash:
|
||||
column => 'name',
|
||||
dir => 0|1,
|
||||
sql => 'SQL code',
|
||||
This function simplifies the creation of SQL code for sorting
|
||||
columns. It uses a hashref of valid column names, the column name and
|
||||
direction requested by the user, the application defaults for the
|
||||
column name and the direction and returns the actual column name,
|
||||
direction and SQL code that can be used directly in a query.
|
||||
The parameter 'defs' is a hash reference. The keys are the column
|
||||
names as they may come from the application. The values are either
|
||||
scalars with SQL code or array references of SQL code. Example:
|
||||
| 611491d9 | Sven Schöling | defs => {
|
||
customername => 'lower(customer.name)',
|
||||
address => [ 'lower(customer.city)', 'lower(customer.street)' ],
|
||||
}
|
||||
| d3f20faa | Moritz Bunkus | |||
'default' is the default column name to sort by. It must be a key of
|
||||
'defs' and should not be come from user input.
|
||||
The 'column' parameter is the column name as requested by the
|
||||
application (e.g. if the user clicked on a column header in a
|
||||
report). If it is invalid then the 'default' parameter will be used
|
||||
instead.
|
||||
'default_dir' is the default sort direction. A true value means 'sort
|
||||
ascending', a false one 'sort descending'. 'default_dir' defaults to
|
||||
'1' if undefined.
|
||||
The 'dir' parameter is the sort direction as requested by the
|
||||
application (e.g. if the user clicked on a column header in a
|
||||
report). If it is undefined then the 'default_dir' parameter will be
|
||||
used instead.
|
||||
| 8f07fac1 | Bernd Bleßmann | =item check_trgm
|
||
Checks if the postgresextension pg_trgm is installed and return trueish
|
||||
or falsish.
|
||||
| d3f20faa | Moritz Bunkus | =back
|
||
| 611491d9 | Sven Schöling | =head1 DEBUG FUNCTIONS
|
||
| 743f51fc | Sven Schöling | |||
=over 4
|
||||
=item dump_query LEVEL,MSG,QUERY,ARRAY
|
||||
| 611491d9 | Sven Schöling | 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.
|
||||
| 743f51fc | Sven Schöling | |||
=back
|
||||
=head1 EXAMPLES
|
||||
=over 4
|
||||
=item Retrieving a whole table:
|
||||
$query = qq|SELECT id, pricegroup FROM pricegroup|;
|
||||
$form->{PRICEGROUPS} = selectall_hashref_query($form, $dbh, $query);
|
||||
=item Retrieving a single value:
|
||||
$query = qq|SELECT nextval('glid')|;
|
||||
($new_id) = selectrow_query($form, $dbh, $query);
|
||||
| 4b29b4b6 | Geoffrey Richardson | =item Retrieving all values from a column:
|
||
$query = qq|SELECT id FROM units|;
|
||||
@units = selectcol_array_query($form, $dbh, $query);
|
||||
| 743f51fc | Sven Schöling | =item Using binding values:
|
||
$query = qq|UPDATE ar SET paid = amount + paid, storno = 't' WHERE id = ?|;
|
||||
do_query($form, $dbh, $query, $id);
|
||||
=item A more complicated example, using dynamic binding values:
|
||||
my @values;
|
||||
| 451843cf | Sven Schöling | |||
| 743f51fc | Sven Schöling | if ($form->{language_values} ne "") {
|
||
| 611491d9 | Sven Schöling | $query = qq|
|
||
SELECT l.id, l.description, tr.translation, tr.longdescription
|
||||
FROM language l
|
||||
LEFT JOIN translation tr ON (tr.language_id = l.id AND tr.parts_id = ?)
|
||||
|;
|
||||
| 743f51fc | Sven Schöling | @values = (conv_i($form->{id}));
|
||
} else {
|
||||
$query = qq|SELECT id, description FROM language|;
|
||||
}
|
||||
| 451843cf | Sven Schöling | |||
| 743f51fc | Sven Schöling | my $languages = selectall_hashref_query($form, $dbh, $query, @values);
|
||
=back
|
||||
| 12451e34 | Udo Spallek | |||
=head1 MODULE AUTHORS
|
||||
| 611491d9 | Sven Schöling | Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
|
||
Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
|
||||
| 451843cf | Sven Schöling | |||
| 12451e34 | Udo Spallek | =head1 DOCUMENTATION AUTHORS
|
||
| 611491d9 | Sven Schöling | Udo Spallek E<lt>udono@gmx.netE<gt>
|
||
Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
|
||||
| 12451e34 | Udo Spallek | |||
=head1 COPYRIGHT AND LICENSE
|
||||
| 008c2e15 | Moritz Bunkus | Copyright 2007 by kivitendo Community
|
||
| 12451e34 | Udo Spallek | |||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
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.
|
||||
| 07b14d1f | Sven Schöling | |||
| 451843cf | Sven Schöling | =cut
|