summaryrefslogtreecommitdiffstats
path: root/config-db
diff options
context:
space:
mode:
authorOliver Tappe2007-11-09 16:54:04 +0100
committerOliver Tappe2007-11-09 16:54:04 +0100
commitbf6beb5f4374938b20af65af76003376d9ea0ffd (patch)
tree256ba47b2976b0782317112d99fd0ee3c67312ae /config-db
parent* added default debconf database for openslx systems based on (diff)
downloadcore-bf6beb5f4374938b20af65af76003376d9ea0ffd.tar.gz
core-bf6beb5f4374938b20af65af76003376d9ea0ffd.tar.xz
core-bf6beb5f4374938b20af65af76003376d9ea0ffd.zip
* started to work on configDB-tests
git-svn-id: http://svn.openslx.org/svn/openslx/trunk@1407 95ad53e4-c205-0410-b2fa-d234c58c8868
Diffstat (limited to 'config-db')
-rw-r--r--config-db/OpenSLX/ConfigDB.pm130
-rw-r--r--config-db/OpenSLX/MetaDB/DBI.pm20
-rw-r--r--config-db/OpenSLX/MetaDB/SQLite.pm32
-rw-r--r--config-db/t/01-basics.t20
-rw-r--r--config-db/t/10-vendor-os.t179
-rwxr-xr-xconfig-db/t/run-all-tests.pl32
6 files changed, 323 insertions, 90 deletions
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<connect()>
@@ -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<disconnect()>
@@ -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<startTransaction()>
-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<commitTransaction()>
-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<rollbackTransaction()>
-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 => '<<<default>>>'});
pushAttributes($system, $defaultClient);
- return;
+ return 1;
}
=item C<mergeDefaultAndGroupAttributesIntoClient($client)>
@@ -2105,7 +2083,7 @@ sub mergeDefaultAndGroupAttributesIntoClient
vlog(3, _tr('merging from default client...'));
my $defaultClient = $self->fetchClientByFilter({name => '<<<default>>>'});
mergeAttributes($client, $defaultClient);
- return;
+ return 1;
}
=item C<aggregatedSystemIDsOfClient($client)>
@@ -2348,7 +2326,7 @@ sub mergeAttributes
$target->{$key} = $sourceVal;
}
}
- return;
+ return 1;
}
=item C<pushAttributes($target, $source)>
@@ -2385,7 +2363,7 @@ sub pushAttributes
$target->{$key} = $sourceVal;
}
}
- return;
+ return 1;
}
=item C<externalIDForSystem($system)>
@@ -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();