Author: REHSACK
Date: Fri Jun 4 08:06:04 2010
New Revision: 14108
Added:
dbi/trunk/t/52dbm_complex.t
Log:
Add complex join tests - first shot testing joins work and import between
tables ...
Added: dbi/trunk/t/52dbm_complex.t
==============================================================================
--- (empty file)
+++ dbi/trunk/t/52dbm_complex.t Fri Jun 4 08:06:04 2010
@@ -0,0 +1,326 @@
+#!perl -w
+$| = 1;
+
+use strict;
+use File::Path;
+use File::Spec;
+use Test::More;
+use Cwd;
+use Config qw(%Config);
+use Storable qw(dclone);
+
+my $using_dbd_gofer = ( $ENV{DBI_AUTOPROXY} || '' ) =~
/^dbi:Gofer.*transport=/i;
+my $haveSS;
+
+use DBI;
+use vars qw( @mldbm_types @dbm_types );
+
+BEGIN
+{
+
+ # 0=SQL::Statement if avail, 1=DBI::SQL::Nano
+ # next line forces use of Nano rather than default behaviour
+ # $ENV{DBI_SQL_NANO}=1;
+ # This is done in zv*n*_50dbm_simple.t
+
+ if ( eval { require 'MLDBM.pm'; } )
+ {
+ push @mldbm_types, qw(Data::Dumper Storable);
# both in CORE
+ push @mldbm_types, 'FreezeThaw' if eval { require 'FreezeThaw.pm' };
+ push @mldbm_types, 'YAML' if eval { require MLDBM::Serializer::YAML; };
+ }
+
+ # Potential DBM modules in preference order (SDBM_File first)
+ # skip NDBM and ODBM as they don't support EXISTS
+ my @dbms = qw(SDBM_File GDBM_File DB_File BerkeleyDB NDBM_File
ODBM_File);
+ my @use_dbms = @ARGV;
+ if ( !...@use_dbms && $ENV{DBD_DBM_TEST_BACKENDS} )
+ {
+ @use_dbms = split ' ', $ENV{DBD_DBM_TEST_BACKENDS};
+ }
+
+ if ( lc "@use_dbms" eq "all" )
+ {
+ # test with as many of the major DBM types as are available
+ @dbm_types = grep {
+ eval { local $^W; require "$_.pm" }
+ } @dbms;
+ }
+ elsif (@use_dbms)
+ {
+ @dbm_types = @use_dbms;
+ }
+ else
+ {
+ # we only test SDBM_File by default to avoid tripping up
+ # on any broken DBM's that may be installed in odd places.
+ # It's only DBD::DBM we're trying to test here.
+ # (However, if SDBM_File is not available, then use another.)
+ for my $dbm (@dbms)
+ {
+ if ( eval { local $^W; require "$dbm.pm" } )
+ {
+ @dbm_types = ($dbm);
+ last;
+ }
+ }
+ }
+
+ eval { require SQL::Statement; require DBD::DBM; $haveSS =
DBD::DBM::Statement->isa('SQL::Statement'); };
+
+ if ( eval { require List::MoreUtils; } )
+ {
+ List::MoreUtils->import("part");
+ }
+ else
+ {
+ # XXX from PP part of List::MoreUtils
+ eval <<'EOP';
+sub part(&@) {
+ my ($code, @list) = @_;
+ my @parts;
+ push @{ $parts[$code->($_)] }, $_ for @list;
+ return @parts;
+}
+EOP
+ }
+}
+
+my $dir = File::Spec->catdir( getcwd(), 'test_output' );
+
+rmtree $dir;
+END { rmtree $dir }
+mkpath $dir;
+
+plan skip_all => "These tests require SQL::Statement" unless ( $haveSS and
@mldbm_types );
+plan skip_all => "Needs more love to run with Gofer, too" if( $using_dbd_gofer
);
+
+my $dbh = DBI->connect( 'dbi:DBM:', undef, undef, { f_dir => $dir, } );
+
+my $suffix;
+
+sub load_tables
+{
+ my ( $dbmtype, $serializer ) = @_;
+ my $last_suffix = $suffix;
+ $serializer =~ s/::/_/g;
+ $suffix = join( "_", $$, $dbmtype, $serializer );
+ if ($last_suffix)
+ {
+ for my $table (qw(APPL_%s PREC_%s NODE_%s LANDSCAPE_%s CONTACT_%s
NM_LANDSCAPE_%s APPL_CONTACT_%s))
+ {
+ my $readsql = sprintf "SELECT * FROM $table", $last_suffix;
+ my $impsql = sprintf "CREATE TABLE $table AS IMPORT (?)", $suffix;
+ my ($readsth);
+ ok( $readsth = $dbh->prepare($readsql), "prepare: $readsql" );
+ ok( $readsth->execute(), "execute: $readsql" );
+ ok( $dbh->do( $impsql, {}, $readsth ), $impsql );
+ }
+ }
+ else
+ {
+ for my $sql ( split( "\n", join( '', <<'EOD' ) ) )
+CREATE TABLE APPL_%s (id INT, applname CHAR, appluniq CHAR, version CHAR,
appl_type CHAR)
+CREATE TABLE PREC_%s (id INT, appl_id INT, node_id INT, precedence INT)
+CREATE TABLE NODE_%s (id INT, nodename CHAR, os CHAR, version CHAR)
+CREATE TABLE LANDSCAPE_%s (id INT, landscapename CHAR)
+CREATE TABLE CONTACT_%s (id INT, surname CHAR, familyname CHAR, phone CHAR,
userid CHAR, mailaddr CHAR)
+CREATE TABLE NM_LANDSCAPE_%s (id INT, ls_id INT, obj_id INT, obj_type INT)
+CREATE TABLE APPL_CONTACT_%s (id INT, contact_id INT, appl_id INT,
contact_type CHAR)
+
+INSERT INTO APPL_%s VALUES ( 1, 'ZQF', 'ZFQLIN', '10.2.0.4', 'Oracle DB')
+INSERT INTO APPL_%s VALUES ( 2, 'YRA', 'YRA-UX', '10.2.0.2', 'Oracle DB')
+INSERT INTO APPL_%s VALUES ( 3, 'PRN1', 'PRN1-4.B2', '1.1.22', 'CUPS' )
+INSERT INTO APPL_%s VALUES ( 4, 'PRN2', 'PRN2-4.B2', '1.1.22', 'CUPS' )
+INSERT INTO APPL_%s VALUES ( 5, 'PRN1', 'PRN1-4.B1', '1.1.22', 'CUPS' )
+INSERT INTO APPL_%s VALUES ( 7, 'PRN2', 'PRN2-4.B1', '1.1.22', 'CUPS' )
+INSERT INTO APPL_%s VALUES ( 8, 'sql-stmt', 'SQL::Statement', '1.21', 'Project
Web-Site')
+INSERT INTO APPL_%s VALUES ( 9, 'cpan.org', 'http://www.cpan.org/', '1.0',
'Web-Site')
+INSERT INTO APPL_%s VALUES (10, 'httpd', 'cpan-apache', '2.2.13', 'Web-Server')
+INSERT INTO APPL_%s VALUES (11, 'cpan-mods', 'cpan-mods', '8.4.1', 'PostgreSQL
DB')
+INSERT INTO APPL_%s VALUES (12, 'cpan-authors', 'cpan-authors', '8.4.1',
'PostgreSQL DB')
+
+INSERT INTO NODE_%s VALUES ( 1, 'ernie', 'RHEL', '5.2')
+INSERT INTO NODE_%s VALUES ( 2, 'bert', 'RHEL', '5.2')
+INSERT INTO NODE_%s VALUES ( 3, 'statler', 'FreeBSD', '7.2')
+INSERT INTO NODE_%s VALUES ( 4, 'waldorf', 'FreeBSD', '7.2')
+INSERT INTO NODE_%s VALUES ( 5, 'piggy', 'NetBSD', '5.0.2')
+INSERT INTO NODE_%s VALUES ( 6, 'kermit', 'NetBSD', '5.0.2')
+INSERT INTO NODE_%s VALUES ( 7, 'samson', 'NetBSD', '5.0.2')
+INSERT INTO NODE_%s VALUES ( 8, 'tiffy', 'NetBSD', '5.0.2')
+INSERT INTO NODE_%s VALUES ( 9, 'rowlf', 'Debian Lenny', '5.0')
+INSERT INTO NODE_%s VALUES (10, 'fozzy', 'Debian Lenny', '5.0')
+
+INSERT INTO PREC_%s VALUES ( 1, 1, 1, 1)
+INSERT INTO PREC_%s VALUES ( 2, 1, 2, 2)
+INSERT INTO PREC_%s VALUES ( 3, 2, 2, 1)
+INSERT INTO PREC_%s VALUES ( 4, 2, 1, 2)
+INSERT INTO PREC_%s VALUES ( 5, 3, 5, 1)
+INSERT INTO PREC_%s VALUES ( 6, 3, 7, 2)
+INSERT INTO PREC_%s VALUES ( 7, 4, 6, 1)
+INSERT INTO PREC_%s VALUES ( 8, 4, 8, 2)
+INSERT INTO PREC_%s VALUES ( 9, 5, 7, 1)
+INSERT INTO PREC_%s VALUES (10, 5, 5, 2)
+INSERT INTO PREC_%s VALUES (11, 6, 8, 1)
+INSERT INTO PREC_%s VALUES (12, 7, 6, 2)
+INSERT INTO PREC_%s VALUES (13, 10, 9, 1)
+INSERT INTO PREC_%s VALUES (14, 10, 10, 1)
+INSERT INTO PREC_%s VALUES (15, 8, 9, 1)
+INSERT INTO PREC_%s VALUES (16, 8, 10, 1)
+INSERT INTO PREC_%s VALUES (17, 9, 9, 1)
+INSERT INTO PREC_%s VALUES (17, 9, 10, 1)
+INSERT INTO PREC_%s VALUES (18, 11, 3, 1)
+INSERT INTO PREC_%s VALUES (19, 11, 4, 2)
+INSERT INTO PREC_%s VALUES (20, 12, 4, 1)
+INSERT INTO PREC_%s VALUES (21, 12, 3, 2)
+
+INSERT INTO LANDSCAPE_%s VALUES (1, 'Logistic')
+INSERT INTO LANDSCAPE_%s VALUES (2, 'Infrastructure')
+INSERT INTO LANDSCAPE_%s VALUES (3, 'CPAN')
+
+INSERT INTO CONTACT_%s VALUES ( 1, 'Hans Peter', 'Mueller', '12345', 'HPMUE',
'[email protected]')
+INSERT INTO CONTACT_%s VALUES ( 2, 'Knut', 'Inge', '54321', 'KINGE',
'[email protected]')
+INSERT INTO CONTACT_%s VALUES ( 3, 'Lola', 'Nguyen', '+1-123-45678-90',
'LNYUG', '[email protected]')
+INSERT INTO CONTACT_%s VALUES ( 4, 'Helge', 'Brunft', '+41-123-45678-09',
'HBRUN', '[email protected]')
+
+-- TYPE: 1: APPL 2: NODE 3: CONTACT
+INSERT INTO NM_LANDSCAPE_%s VALUES ( 1, 1, 1, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES ( 2, 1, 2, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES ( 3, 3, 3, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES ( 4, 3, 4, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES ( 5, 2, 5, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES ( 6, 2, 6, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES ( 7, 2, 7, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES ( 8, 2, 8, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES ( 9, 3, 9, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES (10, 3,10, 2)
+INSERT INTO NM_LANDSCAPE_%s VALUES (11, 1, 1, 1)
+INSERT INTO NM_LANDSCAPE_%s VALUES (12, 2, 2, 1)
+INSERT INTO NM_LANDSCAPE_%s VALUES (13, 2, 2, 3)
+INSERT INTO NM_LANDSCAPE_%s VALUES (14, 3, 1, 3)
+
+INSERT INTO APPL_CONTACT_%s VALUES (1, 3, 1, 'OWNER')
+INSERT INTO APPL_CONTACT_%s VALUES (2, 3, 2, 'OWNER')
+INSERT INTO APPL_CONTACT_%s VALUES (3, 4, 3, 'ADMIN')
+INSERT INTO APPL_CONTACT_%s VALUES (4, 4, 4, 'ADMIN')
+INSERT INTO APPL_CONTACT_%s VALUES (5, 4, 5, 'ADMIN')
+INSERT INTO APPL_CONTACT_%s VALUES (6, 4, 6, 'ADMIN')
+EOD
+ {
+ chomp $sql;
+ $sql =~ s/^\s+//;
+ $sql =~ s/--.*$//;
+ $sql =~ s/\s+$//;
+ next if ( '' eq $sql );
+ $sql = sprintf $sql, $suffix;
+ ok( $dbh->do($sql), $sql );
+ }
+ }
+}
+
+sub do_tests
+{
+ my ( $dbmtype, $serializer ) = @_;
+
+ note "Running do_tests for $dbmtype + $serializer";
+
+ $dbh->{dbm_type} = $dbmtype;
+ $dbh->{dbm_mldbm} = $serializer;
+
+ load_tables( $dbmtype, $serializer );
+
+ my %joins;
+ my $sql;
+
+ $sql = join( " ",
+ q{SELECT applname, appluniq, version, nodename },
+ sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s },
($suffix) x 3 ),
+ sprintf( q{WHERE appl_type LIKE '%%DB' AND
APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
+ sprintf( q{PREC_%s.node_id=NODE_%s.id},
($suffix) x 2 ),
+ );
+
+ $joins{$sql} = [
+ 'ZQF~ZFQLIN~10.2.0.4~ernie',
'ZQF~ZFQLIN~10.2.0.4~bert',
+ 'YRA~YRA-UX~10.2.0.2~bert',
'YRA~YRA-UX~10.2.0.2~ernie',
+ 'cpan-mods~cpan-mods~8.4.1~statler',
'cpan-mods~cpan-mods~8.4.1~waldorf',
+ 'cpan-authors~cpan-authors~8.4.1~waldorf',
'cpan-authors~cpan-authors~8.4.1~statler',
+ ];
+
+ $sql = join( " ",
+ q{SELECT applname, appluniq, version, landscapename,
nodename},
+ sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s, LANDSCAPE_%s,
NM_LANDSCAPE_%s}, ($suffix) x 5 ),
+ sprintf( q{WHERE appl_type LIKE '%%DB' AND
APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
+ sprintf( q{PREC_%s.node_id=NODE_%s.id AND
NM_LANDSCAPE_%s.obj_id=APPL_%s.id AND}, ($suffix) x 4 ),
+ sprintf( q{NM_LANDSCAPE_%s.obj_type=1 AND
NM_LANDSCAPE_%s.ls_id=LANDSCAPE_%s.id}, ($suffix) x 3 ),
+ );
+ $joins{$sql} = [
+ 'ZQF~ZFQLIN~10.2.0.4~Logistic~ernie',
'ZQF~ZFQLIN~10.2.0.4~Logistic~bert',
+ 'YRA~YRA-UX~10.2.0.2~Infrastructure~bert',
'YRA~YRA-UX~10.2.0.2~Infrastructure~ernie',
+ ];
+ $sql = join( " ",
+ q{SELECT applname, appluniq, version, surname, familyname,
phone, nodename},
+ sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s, CONTACT_%s,
APPL_CONTACT_%s}, ($suffix) x 5 ),
+ sprintf( q{WHERE appl_type='CUPS' AND
APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
+ sprintf( q{PREC_%s.node_id=NODE_%s.id AND
APPL_CONTACT_%s.appl_id=APPL_%s.id AND}, ($suffix) x 4 ),
+ sprintf( q{APPL_CONTACT_%s.contact_id=CONTACT_%s.id AND
PREC_%s.PRECEDENCE=1}, ($suffix) x 3 ),
+ );
+ $joins{$sql} = [
+
'PRN1~PRN1-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~piggy',
+
'PRN2~PRN2-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~kermit',
+
'PRN1~PRN1-4.B1~1.1.22~Helge~Brunft~+41-123-45678-09~samson',
+ ];
+ $sql = join( " ",
+ q{SELECT DISTINCT applname, appluniq, version, surname,
familyname, phone, nodename},
+ sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s, CONTACT_%s,
APPL_CONTACT_%s}, ($suffix) x 5 ),
+ sprintf( q{WHERE appl_type='CUPS' AND
APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
+ sprintf( q{PREC_%s.node_id=NODE_%s.id AND
APPL_CONTACT_%s.appl_id=APPL_%s.id}, ($suffix) x 4 ),
+ sprintf( q{AND APPL_CONTACT_%s.contact_id=CONTACT_%s.id},
($suffix) x 2 ),
+ );
+ $joins{$sql} = [
+
'PRN1~PRN1-4.B1~1.1.22~Helge~Brunft~+41-123-45678-09~piggy',
+
'PRN1~PRN1-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~piggy',
+
'PRN1~PRN1-4.B1~1.1.22~Helge~Brunft~+41-123-45678-09~samson',
+
'PRN1~PRN1-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~samson',
+
'PRN2~PRN2-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~kermit',
+
'PRN2~PRN2-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~tiffy',
+ ];
+ $sql = join( " ",
+ q{SELECT CONCAT('[% NOW %]') AS "timestamp", applname,
appluniq, version, nodename},
+ sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s},
($suffix) x 3 ),
+ sprintf( q{WHERE appl_type LIKE '%%DB' AND
APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
+ sprintf( q{PREC_%s.node_id=NODE_%s.id},
($suffix) x 2 ),
+ );
+ $joins{$sql} = [
+ '[% NOW %]~ZQF~ZFQLIN~10.2.0.4~ernie',
+ '[% NOW %]~ZQF~ZFQLIN~10.2.0.4~bert',
+ '[% NOW %]~YRA~YRA-UX~10.2.0.2~bert',
+ '[% NOW %]~YRA~YRA-UX~10.2.0.2~ernie',
+ '[% NOW %]~cpan-mods~cpan-mods~8.4.1~statler',
+ '[% NOW %]~cpan-mods~cpan-mods~8.4.1~waldorf',
+ '[% NOW %]~cpan-authors~cpan-authors~8.4.1~waldorf',
+ '[% NOW %]~cpan-authors~cpan-authors~8.4.1~statler',
+ ];
+
+ while ( my ( $sql, $result ) = each(%joins) )
+ {
+ my $sth = $dbh->prepare($sql);
+ eval { $sth->execute() };
+ warn $@ if $@;
+ my @res;
+ while ( my $row = $sth->fetchrow_arrayref() )
+ {
+ push( @res, join( '~', @{$row} ) );
+ }
+ is( join( '^', sort @res ), join( '^', sort @{$result} ), $sql );
+ }
+}
+
+foreach my $dbmtype (@dbm_types)
+{
+ foreach my $serializer (@mldbm_types)
+ {
+ do_tests( $dbmtype, $serializer );
+ }
+}
+
+done_testing();
