| Subject: | SELECT DISTINCT(name) gives hash key 'name)' instead of 'name' in fetchrow_hash. |
When running the query:
SELECT DISTINCT(t.name), t.tagid FROM objtagmap m,tags t WHERE (m.objid = 2) AND
(t.tagid = m.tagid)
and then fetching data through fetchrow_hash[ref], gives the hash keys
'name)',
'tagid',
and not
'name',
'tagid'
as you would expect from other DBI drivers.
(name has extra closing parenthesis at the end).
Changing the query to:
SELECT DISTINCT t.name, t.tagid FROM objtagmap m,tags t WHERE (m.objid = 2) AND (t.tagid
= m.tagid)
gives the "right" key names.
I'm running Mac OS X v10.4 with custom built perl.
ask@impulse:/opt/devel/Modwheel$> perl -MDBI -le'print DBI->VERSION'
1.54
ask@impulse:/opt/devel/Modwheel$> uname -a
Darwin impulse.local 8.9.1 Darwin Kernel Version 8.9.1: Thu Feb 22 20:55:00 PST 2007;
root:xnu-792.18.15~1/RELEASE_I386 i386 i386
ask@impulse:/opt/devel/Modwheel$> perl -V
Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
Platform:
osname=darwin, osvers=8.9.1, archname=darwin-2level
uname='darwin impulse.local 8.9.1 darwin kernel version 8.9.1: thu feb 22 20:55:00 pst
2007; root:xnu-792.18.15~1release_i386 i386 i386 '
config_args='-des -Uloclibpth -Dlibpth=/usr/lib -Uusethreads'
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -
pipe -Wdeclaration-after-statement -I/usr/local/include -I/opt/local/include',
optimize='-O3',
cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN -no-cpp-precomp -fno-
strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -I/opt/local/
include'
ccversion='', gccversion='4.0.1 (Apple Computer, Inc. build 5367)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =''
libpth=/usr/lib
libs=-ldbm -ldl -lm -lc
perllibs=-ldl -lm -lc
libc=/usr/lib/libc.dylib, so=dylib, useshrplib=false, libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup'
Characteristics of this binary (from libperl):
Compile-time options: PERL_MALLOC_WRAP USE_LARGE_FILES USE_PERLIO
Built under darwin
Compiled at Apr 25 2007 14:49:25
%ENV:
PERL5LIB="/sw/lib/perl5:/sw/lib/perl5/darwin"
@INC:
/sw/lib/perl5
/sw/lib/perl5/darwin
/usr/local/lib/perl5/5.8.8/darwin-2level
/usr/local/lib/perl5/5.8.8
/usr/local/lib/perl5/site_perl/5.8.8/darwin-2level
/usr/local/lib/perl5/site_perl/5.8.8
/usr/local/lib/perl5/site_perl
.
I made a test for the bug:
#!/usr/bin/perl
# ASKSH@cpan.org
use strict;
use warnings;
use English qw( -no_match_vars );
use DBI;
use Test::More;
our $THIS_TEST_HAS_TESTS = 23;
eval 'use DBD::SQLite2';
if ($EVAL_ERROR) {
plan(skip_all => 'This test requires DBD::SQLite2' );
}
plan( tests => $THIS_TEST_HAS_TESTS );
our $DBFILE = './DistinctHashKeyProblem.db';
my $noprintquerymsg = '(Set ENV{PRINT_QUERY} to true value to see query)';
my $tinfo;
# Remove stale database file. (We dont wanna keep the file).
if (-f $DBFILE) {
unlink $DBFILE;
}
my $dbh = DBI->connect('DBI:SQLite2:' . $DBFILE);
ok( ref $dbh, "create new db: $DBFILE" );
# ######
# First we create our schema (attached in __DATA__)
#
my $slurp;
while (my $line = <DATA>) {
$slurp .= $line;
}
QUERY:
for my $query (split m/ ; /xms, $slurp) {
# remove newline + leading and trailing whitespace.
chomp $query;
$query =~ s/^ \s+ //xms;
$query =~ s/ \s+ $//xms;
next QUERY if not $query;
# execute the query.
my $sth = $dbh->prepare($query);
$tinfo = $ENV{PRINT_QUERY} ? "prepare: $query"
: "prepare: $noprintquerymsg";
ok( ref $sth, $tinfo);
my $ret = $sth->execute( );
$tinfo = $ENV{PRINT_QUERY} ? "execute: $query"
: "execute: $noprintquerymsg";
ok( $ret, $tinfo);
$sth->finish( );
}
# ######
# Then we test the bug.
#
# We test with both 'DISTINCT(t.name) [..]' and 'DISTINCT t.name [..]'
#
my $query_with_parens = trim(q{
SELECT DISTINCT(t.name), t.tagid
FROM objtagmap m,tags t
WHERE (m.objid = 1)
AND (t.tagid = m.tagid)
});
my $query_without_parens = trim(q{
SELECT DISTINCT t.name, t.tagid
FROM objtagmap m,tags t
WHERE (m.objid = 1)
AND (t.tagid = m.tagid)
});
foreach my $query (($query_with_parens, $query_without_parens)) {
# just to print readable test descriptions.
my $abbrev = substr $query, 0, 25;
my $sth = $dbh->prepare($query);
ok( ref $sth, "prepare $abbrev" );
my $ret = $sth->execute( );
ok( $ret, "execute $abbrev" );
ok( $sth->rows, 'rows: got result' );
while (my $hres = $sth->fetchrow_hashref) {
# Here we should get two hash keys: 'name' and 'tagid'.
ok( exists $hres->{name}, 'exists $hres->{name}' );
ok( exists $hres->{tagid}, 'exists $hres->{tagid}' );
if (! exists $hres->{name}) {
eval 'use Data::Dumper';
if (! $EVAL_ERROR) {
$Data::Dumper::Varname = 'fetchrow_hashref';
print {*STDERR} "The keys we got was: ",
Data::Dumper::Dumper($hres), "\n";
}
}
}
$sth->finish;
}
$dbh->disconnect;
sub trim {
my ($string) = @_;
$string =~ s/^ \s+ //xms;
$string =~ s/ \s+ $//xms;
$string =~ s/\s+/ /xms;
return $string;
}
# DATA has schema for 3 tables. object, tags, and objtagmap.
# We create an article object and a tag, and then we connect the article object with the
# tag.
__DATA__
CREATE TABLE object (
id INTEGER PRIMARY KEY NOT NULL,
parent INTEGER NOT NULL DEFAULT 1,
name VARCHAR(255) NOT NULL,
type CHAR(16) NOT NULL default 'directory'
);
CREATE TABLE objtagmap (
id INTEGER PRIMARY KEY NOT NULL,
objid INTEGER NOT NULL,
tagid INTEGER NOT NULL
);
CREATE TABLE tags (
tagid INTEGER PRIMARY KEY NOT NULL,
name char(32) NOT NULL
);
INSERT INTO object (id, parent, name, type) VALUES
(1, 1, 'All about the the distinct hash key problem, and how to survive
deadly weapons', 'article');
INSERT INTO tags(tagid, name) VALUES (1,'bugs');
INSERT INTO objtagmap(id, objid, tagid) VALUES(1, 1, 1);
| Subject: | DistinctHashKeyProblem.t |
#!/usr/bin/perl
use strict;
use warnings;
use English qw( -no_match_vars );
use DBI;
use Test::More;
our $THIS_TEST_HAS_TESTS = 23;
eval 'use DBD::SQLite2';
if ($EVAL_ERROR) {
plan(skip_all => 'This test requires DBD::SQLite2' );
}
plan( tests => $THIS_TEST_HAS_TESTS );
our $DBFILE = './DistinctHashKeyProblem.db';
my $noprintquerymsg = '(Set ENV{PRINT_QUERY} to true value to see query)';
my $tinfo;
# Remove stale database file. (We dont wanna keep the file).
if (-f $DBFILE) {
unlink $DBFILE;
}
my $dbh = DBI->connect('DBI:SQLite2:' . $DBFILE);
ok( ref $dbh, "create new db: $DBFILE" );
# ######
# First we create our schema (attached in __DATA__)
#
my $slurp;
while (my $line = <DATA>) {
$slurp .= $line;
}
QUERY:
for my $query (split m/ ; /xms, $slurp) {
# remove newline + leading and trailing whitespace.
chomp $query;
$query =~ s/^ \s+ //xms;
$query =~ s/ \s+ $//xms;
next QUERY if not $query;
# execute the query.
my $sth = $dbh->prepare($query);
$tinfo = $ENV{PRINT_QUERY} ? "prepare: $query"
: "prepare: $noprintquerymsg";
ok( ref $sth, $tinfo);
my $ret = $sth->execute( );
$tinfo = $ENV{PRINT_QUERY} ? "execute: $query"
: "execute: $noprintquerymsg";
ok( $ret, $tinfo);
$sth->finish( );
}
# ######
# Then we test the bug.
#
# We test with both 'DISTINCT(t.name) [..]' and 'DISTINCT t.name [..]'
#
my $query_with_parens = trim(q{
SELECT DISTINCT(t.name), t.tagid
FROM objtagmap m,tags t
WHERE (m.objid = 1)
AND (t.tagid = m.tagid)
});
my $query_without_parens = trim(q{
SELECT DISTINCT t.name, t.tagid
FROM objtagmap m,tags t
WHERE (m.objid = 1)
AND (t.tagid = m.tagid)
});
foreach my $query (($query_with_parens, $query_without_parens)) {
# just to print readable test descriptions.
my $abbrev = substr $query, 0, 25;
my $sth = $dbh->prepare($query);
ok( ref $sth, "prepare $abbrev" );
my $ret = $sth->execute( );
ok( $ret, "execute $abbrev" );
ok( $sth->rows, 'rows: got result' );
while (my $hres = $sth->fetchrow_hashref) {
# Here we should get two hash keys: 'name' and 'tagid'.
ok( exists $hres->{name}, 'exists $hres->{name}' );
ok( exists $hres->{tagid}, 'exists $hres->{tagid}' );
if (! exists $hres->{name}) {
eval 'use Data::Dumper';
if (! $EVAL_ERROR) {
$Data::Dumper::Varname = 'fetchrow_hashref';
print {*STDERR} "The keys we got was: ",
Data::Dumper::Dumper($hres), "\n";
}
}
}
$sth->finish;
}
$dbh->disconnect;
sub trim {
my ($string) = @_;
$string =~ s/^ \s+ //xms;
$string =~ s/ \s+ $//xms;
$string =~ s/\s+/ /xms;
return $string;
}
# DATA has schema for 3 tables. object, tags, and objtagmap.
# We create an article object and a tag, and then we connect the article object with the
# tag.
__DATA__
CREATE TABLE object (
id INTEGER PRIMARY KEY NOT NULL,
parent INTEGER NOT NULL DEFAULT 1,
name VARCHAR(255) NOT NULL,
type CHAR(16) NOT NULL default 'directory'
);
CREATE TABLE objtagmap (
id INTEGER PRIMARY KEY NOT NULL,
objid INTEGER NOT NULL,
tagid INTEGER NOT NULL
);
CREATE TABLE tags (
tagid INTEGER PRIMARY KEY NOT NULL,
name char(32) NOT NULL
);
INSERT INTO object (id, parent, name, type) VALUES
(1, 1, 'All about the the distinct hash key problem, and how to survive
deadly weapons', 'article');
INSERT INTO tags(tagid, name) VALUES (1,'bugs');
INSERT INTO objtagmap(id, objid, tagid) VALUES(1, 1, 1);