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
create_sort_spec does_table_exist
add_token);
+use strict;
+
sub conv_i {
my ($value, $default) = @_;
return (defined($value) && "$value" ne "") ? $value * 1 : $default;
my ($form, $dbh, $query) = splice(@_, 0, 3);
- dump_query(LXDebug::QUERY, '', $query, @_);
+ dump_query(LXDebug->QUERY(), '', $query, @_);
my $result;
if (0 == scalar(@_)) {
my ($form, $sth, $query) = splice(@_, 0, 3);
- dump_query(LXDebug::QUERY, '', $query, @_);
+ dump_query(LXDebug->QUERY(), '', $query, @_);
my $result;
if (0 == scalar(@_)) {
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/;
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);
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) {
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);
=back
-=head1 SEE ALSO
-
=head1 MODULE AUTHORS
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>