From bf6beb5f4374938b20af65af76003376d9ea0ffd Mon Sep 17 00:00:00 2001 From: Oliver Tappe Date: Fri, 9 Nov 2007 15:54:04 +0000 Subject: * started to work on configDB-tests git-svn-id: http://svn.openslx.org/svn/openslx/trunk@1407 95ad53e4-c205-0410-b2fa-d234c58c8868 --- config-db/OpenSLX/ConfigDB.pm | 130 +++++++++++---------------- config-db/OpenSLX/MetaDB/DBI.pm | 20 +++-- config-db/OpenSLX/MetaDB/SQLite.pm | 32 ++++++- config-db/t/01-basics.t | 20 +++++ config-db/t/10-vendor-os.t | 179 +++++++++++++++++++++++++++++++++++++ config-db/t/run-all-tests.pl | 32 +++++++ 6 files changed, 323 insertions(+), 90 deletions(-) create mode 100644 config-db/t/01-basics.t create mode 100644 config-db/t/10-vendor-os.t create mode 100755 config-db/t/run-all-tests.pl (limited to 'config-db') diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm index ed86c8e1..e286a4d7 100644 --- a/config-db/OpenSLX/ConfigDB.pm +++ b/config-db/OpenSLX/ConfigDB.pm @@ -93,8 +93,6 @@ use OpenSLX::Basics; use OpenSLX::DBSchema; use OpenSLX::Utils; -our $configDBInstance; - =head1 Methods =head2 Basic Methods @@ -112,25 +110,12 @@ new will return the *same* object =cut sub new -{ # TODO: it would be better to allow new() to do what any caller expects and - # rename this to instance() or anything similar ... +{ my $class = shift; - if ($configDBInstance) { - return $configDBInstance; - } - - $configDBInstance = { - connectedCount => 0, + my $self = { }; - return bless $configDBInstance, $class; -} - -sub DESTROY -{ - my $self = shift; - - $configDBInstance = undef; + return bless $self, $class; } =item C @@ -165,49 +150,45 @@ sub connect ## no critic (ProhibitBuiltinHomonyms) # hash-ref with any additional info that might be required by # specific metadb-module (not used yet) - if (!$self->{connectedCount}) { - - my $dbType = $openslxConfig{'db-type'}; - # name of underlying database module... - - my $dbModuleName = "OpenSLX/MetaDB/$dbType.pm"; - my $dbModule = "OpenSLX::MetaDB::$dbType"; - unless (eval { require $dbModuleName } ) { - if ($! == 2) { - die _tr( - "Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n", - $dbModuleName - ); - } else { - die _tr("Unable to load DB-module <%s> (%s)\n", $dbModuleName, $@); - } - } - my $metaDB = $dbModule->new(); - if (!$metaDB->connect($dbParams)) { - warn _tr("Unable to connect to DB-module <%s>\n%s", $dbModuleName, $@); - warn _tr("These DB-modules seem to work ok:"); - foreach my $dbMod ('mysql', 'SQLite') { - my $fullDbModName = "DBD/$dbMod.pm"; - if (eval { require $fullDbModName }) { - vlog(0, "\t$dbMod\n"); - } - } + my $dbType = $openslxConfig{'db-type'}; + # name of underlying database module... + + my $dbModuleName = "OpenSLX/MetaDB/$dbType.pm"; + my $dbModule = "OpenSLX::MetaDB::$dbType"; + unless (eval { require $dbModuleName } ) { + if ($! == 2) { die _tr( - 'Please use slxsettings if you want to switch to another db-type.'); + "Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n", + $dbModuleName + ); + } else { + die _tr("Unable to load DB-module <%s> (%s)\n", $dbModuleName, $@); } - - $self->{'db-type'} = $dbType; - $self->{'meta-db'} = $metaDB; - foreach my $tk (keys %{$DbSchema->{tables}}) { - $metaDB->schemaDeclareTable($tk, $DbSchema->{tables}->{$tk}); + } + my $metaDB = $dbModule->new(); + if (!$metaDB->connect($dbParams)) { + warn _tr("Unable to connect to DB-module <%s>\n%s", $dbModuleName, $@); + warn _tr("These DB-modules seem to work ok:"); + foreach my $dbMod ('mysql', 'SQLite') { + my $fullDbModName = "DBD/$dbMod.pm"; + if (eval { require $fullDbModName }) { + vlog(0, "\t$dbMod\n"); + } } + die _tr( + 'Please use slxsettings if you want to switch to another db-type.' + ); + } - _checkAndUpgradeDBSchemaIfNecessary($metaDB); + $self->{'db-type'} = $dbType; + $self->{'meta-db'} = $metaDB; + foreach my $tk (keys %{$DbSchema->{tables}}) { + $metaDB->schemaDeclareTable($tk, $DbSchema->{tables}->{$tk}); } - $self->{connectedCount}++; + _checkAndUpgradeDBSchemaIfNecessary($metaDB); - return; + return 1; } =item C @@ -220,18 +201,15 @@ sub disconnect { my $self = shift; - if ($self->{connectedCount} == 1) { - $self->{'meta-db'}->disconnect(); - } - $self->{connectedCount}--; + $self->{'meta-db'}->disconnect(); - return; + return 1; } =item C -Opens a database transaction - most useful if you want to make sure a couple of changes -apply as a whole or not at all. +Opens a database transaction - most useful if you want to make sure a couple of +changes apply as a whole or not at all. =cut @@ -240,13 +218,13 @@ sub startTransaction my $self = shift; $self->{'meta-db'}->startTransaction(); - return; + return 1; } =item C -Commits a database transaction - so all changes done inside of this transaction will -be applied to the database. +Commits a database transaction - so all changes done inside of this transaction +will be applied to the database. =cut @@ -255,13 +233,13 @@ sub commitTransaction my $self = shift; $self->{'meta-db'}->commitTransaction(); - return; + return 1; } =item C -Revokes a database transaction - so all changes done inside of this transaction will -be undone. +Revokes a database transaction - so all changes done inside of this transaction +will be undone. =cut @@ -270,7 +248,7 @@ sub rollbackTransaction my $self = shift; $self->{'meta-db'}->rollbackTransaction(); - return; + return 1; } =back @@ -2024,7 +2002,7 @@ sub emptyDatabase my @vendorOSIDs = map { $_->{id} } $self->fetchVendorOSByFilter(); $self->removeVendorOS(\@vendorOSIDs); - return; + return 1; } =back @@ -2062,7 +2040,7 @@ sub mergeDefaultAttributesIntoSystem my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); pushAttributes($system, $defaultClient); - return; + return 1; } =item C @@ -2105,7 +2083,7 @@ sub mergeDefaultAndGroupAttributesIntoClient vlog(3, _tr('merging from default client...')); my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); mergeAttributes($client, $defaultClient); - return; + return 1; } =item C @@ -2348,7 +2326,7 @@ sub mergeAttributes $target->{$key} = $sourceVal; } } - return; + return 1; } =item C @@ -2385,7 +2363,7 @@ sub pushAttributes $target->{$key} = $sourceVal; } } - return; + return 1; } =item C @@ -2600,7 +2578,7 @@ sub _checkAndUpgradeDBSchemaIfNecessary } else { vlog(1, _tr('DB matches current schema version %s', $currVersion)); } - return; + return 1; } sub _aref @@ -2618,7 +2596,3 @@ sub _unique } 1; - -=back - -=cut diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm index b80f3c0a..bb0a8fdc 100644 --- a/config-db/OpenSLX/MetaDB/DBI.pm +++ b/config-db/OpenSLX/MetaDB/DBI.pm @@ -86,14 +86,15 @@ sub _doSelect vlog(3, _trim($sql)); my $sth = $dbh->prepare($sql) - or - croak _tr(q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr); + or croak _tr( + q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr + ); $sth->execute() - or - croak _tr(q[Can't execute SQL-statement <%s> (%s)], $sql, $dbh->errstr); - my (@vals, $row); - while ($row = $sth->fetchrow_hashref()) { - + or croak _tr( + q[Can't execute SQL-statement <%s> (%s)], $sql, $dbh->errstr + ); + my @vals; + while (my $row = $sth->fetchrow_hashref()) { if (defined $resultCol) { return $row->{$resultCol} unless wantarray(); push @vals, $row->{$resultCol}; @@ -113,10 +114,11 @@ sub fetchVendorOSByFilter $resultCols = '*' unless (defined $resultCols); my $sql = "SELECT $resultCols FROM vendor_os"; - my $connector; + my ($connector, $quotedVal); foreach my $col (keys %$filter) { $connector = !defined $connector ? 'WHERE' : 'AND'; - $sql .= " $connector $col = '$filter->{$col}'"; + $quotedVal = $self->{dbh}->quote($filter->{$col}); + $sql .= " $connector $col = $quotedVal"; } return $self->_doSelect($sql); } diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm index 558aebf9..c0725191 100644 --- a/config-db/OpenSLX/MetaDB/SQLite.pm +++ b/config-db/OpenSLX/MetaDB/SQLite.pm @@ -35,6 +35,27 @@ sub new return bless $self, $class; } +sub databaseExists +{ + my $self = shift; + + my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; +print "$fullDBPath\n"; + return -e $fullDBPath; +} + +sub dropDatabase +{ + my $self = shift; + + if ($self->{dbh}) { + die "need to disconnect before you can drop the database!"; + } + + my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; + system("rm -rf $fullDBPath") if -e $fullDBPath; +} + sub connect ## no critic (ProhibitBuiltinHomonyms) { my $self = shift; @@ -42,9 +63,7 @@ sub connect ## no critic (ProhibitBuiltinHomonyms) my $dbSpec = $openslxConfig{'db-spec'}; if (!defined $dbSpec) { # build $dbSpec from individual parameters: - my $dbBasepath = "$openslxConfig{'private-path'}/db"; - my $dbDatadir = 'sqlite'; - my $dbPath = "$dbBasepath/$dbDatadir"; + my $dbPath = $self->_getDBPath; system("mkdir -p $dbPath") unless -e $dbPath; $dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}"; } @@ -102,4 +121,11 @@ sub schemaAddColumns return; } +sub _getDBPath +{ + my $self = shift; + + return "$openslxConfig{'private-path'}/db/sqlite"; +} + 1; diff --git a/config-db/t/01-basics.t b/config-db/t/01-basics.t new file mode 100644 index 00000000..fdc7a052 --- /dev/null +++ b/config-db/t/01-basics.t @@ -0,0 +1,20 @@ +use Test::More qw(no_plan); + +use lib '/opt/openslx/lib'; + +# basic stuff +use_ok(OpenSLX::ConfigDB); + +# connecting and disconnecting +ok(my $configDB = OpenSLX::ConfigDB->new, 'can create object'); +isa_ok($configDB, 'OpenSLX::ConfigDB'); + +{ + # create a second object - should work and yield different objects + ok(my $configDB2 = OpenSLX::ConfigDB->new, 'can create another object'); + cmp_ok($configDB, 'ne', $configDB2, 'should have two different objects now'); +} + +ok($configDB->connect(), 'connecting'); +ok($configDB->disconnect(), 'disconnecting'); + diff --git a/config-db/t/10-vendor-os.t b/config-db/t/10-vendor-os.t new file mode 100644 index 00000000..9f7c9f11 --- /dev/null +++ b/config-db/t/10-vendor-os.t @@ -0,0 +1,179 @@ +use Test::More qw(no_plan); + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +is( + my $vendorOS = $configDB->fetchVendorOSByFilter, undef, + 'no vendor-OS yet (scalar context)' +); +is( + my @vendorOSes = $configDB->fetchVendorOSByFilter, 0, + 'no vendor-OS yet (array context)' +); + +my $inVendorOS1 = { + 'name' => 'vos-1', + 'comment' => '', +}; +is( + my $vendorOS1ID = $configDB->addVendorOS($inVendorOS1), 1, + 'first vendor-OS has ID 1' +); + +my $inVendorOS2 = { + 'name' => 'vos-2.0', + 'comment' => 'batch 2', +}; +my $inVendorOS3 = { + 'name' => 'vos-3.0', + 'comment' => 'batch 2', + 'clone_source' => 'kiwi::test-vos', +}; +ok( + my ($vendorOS2ID, $vendorOS3ID) = $configDB->addVendorOS([ + $inVendorOS2, $inVendorOS3 + ]), + 'add two more vendor-OSes' +); +is($vendorOS2ID, 2, 'vendor-OS 2 should have ID=2'); +is($vendorOS3ID, 3, 'vendor-OS 3 should have ID=3'); + +# fetch vendor-OS 3 by id and check all values +ok(my $vendorOS3 = $configDB->fetchVendorOSByID(3), 'fetch vendor-OS 3'); +is($vendorOS3->{id}, 3, 'vendor-OS 3 - id'); +is($vendorOS3->{name}, 'vos-3.0', 'vendor-OS 3 - name'); +is($vendorOS3->{comment}, 'batch 2', 'vendor-OS 3 - comment'); +is($vendorOS3->{clone_source}, 'kiwi::test-vos', 'vendor-OS 3 - clone_source'); + +# fetch vendor-OS 2 by a filter on id and check all values +ok( + my $vendorOS2 = $configDB->fetchVendorOSByFilter({ id => 2 }), + 'fetch vendor-OS 2 by filter on id' +); +is($vendorOS2->{id}, 2, 'vendor-OS 2 - id'); +is($vendorOS2->{name}, 'vos-2.0', 'vendor-OS 2 - name'); +is($vendorOS2->{comment}, 'batch 2', 'vendor-OS 2 - comment'); +is($vendorOS2->{clone_source}, undef, 'vendor-OS 2 - clone_source'); + +# fetch vendor-OS 1 by filter on name and check all values +ok( + my $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => 'vos-1' }), + 'fetch vendor-OS 1 by filter on name' +); +is($vendorOS1->{id}, 1, 'vendor-OS 1 - id'); +is($vendorOS1->{name}, 'vos-1', 'vendor-OS 1 - name'); +is($vendorOS1->{comment}, '', 'vendor-OS 1 - comment'); +is($vendorOS1->{clone_source}, undef, 'vendor-OS 1 - clone_source'); + +# fetch vendor-OSes 3 & 1 by id +ok( + my @vendorOSes3And1 + = $configDB->fetchVendorOSByID([3, 1]), + 'fetch vendor-OSes 3 & 1 by id' +); +is(@vendorOSes3And1, 2, 'should have got 2 vendor-OSes'); +# now sort by ID and check if we have really got 3 and 1 +@vendorOSes3And1 = sort { $a->{id} cmp $b->{id} } @vendorOSes3And1; +is($vendorOSes3And1[0]->{id}, 1, 'first id should be 1'); +is($vendorOSes3And1[1]->{id}, 3, 'second id should be 3'); + +# fetching vendor-OSes by id without giving any should yield undef +is( + $configDB->fetchVendorOSByID(), undef, + 'fetch vendor-OSes by id without giving any' +); + +# fetching vendor-OSes by filter without giving any should yield all of them +ok( + @vendorOSes = $configDB->fetchVendorOSByFilter(), + 'fetch vendor-OSes by filter without giving any' +); +is(@vendorOSes, 3, 'should have got all three vendor-OSes'); + +# fetch vendor-OSes 2 & 3 by filter on comment +ok( + my @vendorOSes2And3 + = $configDB->fetchVendorOSByFilter({ comment => 'batch 2' }), + 'fetch vendor-OSes 2 & 3 by filter on comment' +); +is(@vendorOSes2And3, 2, 'should have got 2 vendor-OSes'); +# now sort by ID and check if we have really got 2 and 3 +@vendorOSes2And3 = sort { $a->{id} cmp $b->{id} } @vendorOSes2And3; +is($vendorOSes2And3[0]->{id}, 2, 'first id should be 2'); +is($vendorOSes2And3[1]->{id}, 3, 'second id should be 3'); + +# try to fetch with multi-column filter +ok( + ($vendorOS2, $vendorOS3) + = $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 2 }), + 'fetching vendor-OS with comment="batch 2" and id=2 should work' +); +is($vendorOS2->{name}, 'vos-2.0', 'should have got vos-2.0'); +is($vendorOS3, undef, 'should not get vos-3.0'); + +# try to fetch multiple occurrences of the same vendor-OS, combined with +# some unknown IDs +ok( + my @vendorOSes1And3 + = $configDB->fetchVendorOSByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), + 'fetch a complex set of vendor-OSes by ID' +); +is(@vendorOSes1And3, 2, 'should have got 2 vendor-OSes'); +# now sort by ID and check if we have really got 1 and 3 +@vendorOSes1And3 = sort { $a->{id} cmp $b->{id} } @vendorOSes1And3; +is($vendorOSes1And3[0]->{id}, 1, 'first id should be 1'); +is($vendorOSes1And3[1]->{id}, 3, 'second id should be 3'); + +# try to fetch a couple of non-existing vendor-OSes by id +is( + $configDB->fetchVendorOSByID(-1), undef, + 'vendor-OS with id -1 should not exist' +); +is( + $configDB->fetchVendorOSByID(0), undef, + 'vendor-OS with id 0 should not exist' +); +is( + $configDB->fetchVendorOSByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown vendor-OS' +); + +# try to fetch a couple of non-existing vendor-OSes by filter +is( + $configDB->fetchVendorOSByFilter({ id => 0 }), undef, + 'fetching vendor-OS with id=0 by filter should fail' +); +is( + $configDB->fetchVendorOSByFilter({ name => 'vos-1.x' }), undef, + 'fetching vendor-OS with name="vos-1.x" should fail' +); +is( + $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 1 }), undef, + 'fetching vendor-OS with comment="batch 2" and id=1 should fail' +); + +# rename vendor-OS 1 and then fetch it by its new name +ok($configDB->changeVendorOS(1, { name => q{VOS-'1'} }), 'changing vendor-OS 1'); +ok( + $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => q{VOS-'1'} }), + 'fetching renamed vendor-OS 1' +); +is($vendorOS1->{id}, 1, 'really got vendor-OS number 1'); +is($vendorOS1->{name}, q{VOS-'1'}, q{really got vendor-OS named "VOS-'1'"}); + +# changing a non-existing column should fail +ok( + ! eval { $configDB->changeVendorOS(1, { xname => "xx" }) }, + 'changing unknown colum should fail' +); + +ok($configDB->changeVendorOS(1, { id => 23 }), 'changing id should fail'); + +$configDB->disconnect(); + diff --git a/config-db/t/run-all-tests.pl b/config-db/t/run-all-tests.pl new file mode 100755 index 00000000..6cebdac1 --- /dev/null +++ b/config-db/t/run-all-tests.pl @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Test::Harness; + +# add the development paths to perl's search path for modules: +use FindBin; +use lib "$FindBin::RealBin/../"; +use lib "$FindBin::RealBin/../../lib"; + +use OpenSLX::Basics; + +use OpenSLX::MetaDB::SQLite; + +# make sure a specific test-db will be used +$cmdlineConfig{'private-path'} = $ENV{SLX_PRIVATE_PATH} = '/tmp/slx-db-test'; +$cmdlineConfig{'db-name'} = $ENV{SLX_DB_NAME} = 'slx-test'; +$cmdlineConfig{'db-type'} = $ENV{SLX_DB_TYPE} = 'SQLite'; + +openslxInit(); + +# remove the test-db if it already exists +my $metaDB = OpenSLX::MetaDB::SQLite->new(); +if ($metaDB->databaseExists()) { + print "removing leftovers of slx-test-db\n"; + $metaDB->dropDatabase(); +} +runtests(glob("*.t")); + +$metaDB->dropDatabase(); -- cgit v1.2.3-55-g7522