* some work on the testing script, fixed several errors on the way

git-svn-id: http://svn.openslx.org/svn/openslx/trunk@393 95ad53e4-c205-0410-b2fa-d234c58c8868

3 files changed, 81 insertions, 4 deletions

diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm
index 4376ec68..8f74a359 100644
--- a/config-db/OpenSLX/ConfigDB.pm
+++ b/config-db/OpenSLX/ConfigDB.pm
@@ -46,6 +46,7 @@ my @manipulationExports = qw(
 	addGroup removeGroup changeGroup
 	setClientIDsOfGroup addClientIDsToGroup removeClientIDsFromGroup
 	setSystemIDsOfGroup addSystemIDsToGroup removeSystemIDsFromGroup
+	emptyDatabase
 );
 
 my @aggregationExports = qw(
@@ -136,6 +137,7 @@ sub _checkAndUpgradeDBSchemaIfNecessary
 sub _aref
 {	# transparently converts the given reference to an array-ref
 	my $ref = shift;
+	return [] unless defined $ref;
 	$ref = [ $ref ] unless ref($ref) eq 'ARRAY';
 	return $ref;
 }
@@ -408,6 +410,11 @@ sub removeSystem
 	my $confDB = shift;
 	my $systemIDs = _aref(shift);
 
+	foreach my $system (@$systemIDs) {
+		setGroupIDsOfSystem($confDB, $system);
+		setClientIDsOfSystem($confDB, $system);
+	}
+
 	return $confDB->{'meta-db'}->removeSystem($systemIDs);
 }
 
@@ -530,6 +537,11 @@ sub removeClient
 	my $confDB = shift;
 	my $clientIDs = _aref(shift);
 
+	foreach my $client (@$clientIDs) {
+		setGroupIDsOfClient($confDB, $client);
+		setSystemIDsOfClient($confDB, $client);
+	}
+
 	return $confDB->{'meta-db'}->removeClient($clientIDs);
 }
 
@@ -627,6 +639,11 @@ sub removeGroup
 	my $confDB = shift;
 	my $groupIDs = _aref(shift);
 
+	foreach my $group (@$groupIDs) {
+		setSystemIDsOfGroup($confDB, $group, []);
+		setClientIDsOfGroup($confDB, $group, []);
+	}
+
 	return $confDB->{'meta-db'}->removeGroup($groupIDs);
 }
 
@@ -711,6 +728,40 @@ sub removeSystemIDsFromGroup
 	return setSystemIDsOfGroup($confDB, $groupID, \@systemIDs);
 }
 
+sub emptyDatabase
+{	# clears all user-data from the database
+	my $confDB = shift;
+
+	my @groupIDs
+		= map { $_->{id} }
+		  fetchGroupsByFilter($confDB);
+	removeGroup($confDB, \@groupIDs);
+
+	my @clientIDs
+		= map { $_->{id} }
+		  grep { $_->{id} > 0 }
+		  fetchClientsByFilter($confDB);
+	removeClient($confDB, \@clientIDs);
+
+	my @sysVarIDs
+		= map { $_->{id} }
+		  grep { $_->{id} > 0 }
+		  fetchSystemVariantsByFilter($confDB);
+	removeSystemVariant($confDB, \@sysVarIDs);
+
+	my @sysIDs
+		= map { $_->{id} }
+		  grep { $_->{id} > 0 }
+		  fetchSystemsByFilter($confDB);
+	removeSystem($confDB, \@sysIDs);
+
+	my @vendorOSIDs
+		= map { $_->{id} }
+		  grep { $_->{id} > 0 }
+		  fetchVendorOSesByFilter($confDB);
+	removeVendorOS($confDB, \@vendorOSIDs);
+}
+
 ################################################################################
 ### data aggregation interface
 ################################################################################
diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm
index 9a078f06..ac8401c2 100644
--- a/config-db/OpenSLX/MetaDB/DBI.pm
+++ b/config-db/OpenSLX/MetaDB/DBI.pm
@@ -473,7 +473,7 @@ sub _updateRefTable
 
 	# all the remaining value-IDs need to be removed:
 	if (scalar keys %lastValueIDs) {
-		$self->_doDelete($table, keys %lastValueIDs, $valueCol);
+		$self->_doDelete($table, [ keys %lastValueIDs ], $valueCol);
 	}
 }
 
@@ -573,7 +573,7 @@ sub setGroupIDsOfSystem
 	my $groupIDs = shift;
 
 	my @currGroups = $self->fetchGroupIDsOfSystem($systemID);
-	$self->_updateRefTable('grop_system_ref', $systemID, $groupIDs,
+	$self->_updateRefTable('group_system_ref', $systemID, $groupIDs,
 						   'system_id', 'group_id', \@currGroups);
 }
 
diff --git a/config-db/test-config-demuxer.pl b/config-db/test-config-demuxer.pl
index 8132ab4a..5918b0d7 100755
--- a/config-db/test-config-demuxer.pl
+++ b/config-db/test-config-demuxer.pl
@@ -1,4 +1,5 @@
 #! /usr/bin/perl
+use strict;
 
 # add the folder this script lives in to perl's search path for modules:
 use FindBin;
@@ -7,20 +8,45 @@ use lib $FindBin::Bin;
 use OpenSLX::Basics;
 use OpenSLX::ConfigDB qw(:access :manipulation);
 
+use Getopt::Long qw(:config pass_through);
+my $clobber;
+GetOptions(
+	'clobber' => \$clobber
+		# clobber causes this script to overwrite the database without asking
+);
+
 openslxInit();
 
 my $openslxDB = connectConfigDB();
 
+if (!$clobber) {
+	my $yes = _tr('yes');
+	my $no = _tr('no');
+	my @systems = fetchSystemsByFilter($openslxDB);
+	my @clients = fetchClientsByFilter($openslxDB);
+	print _tr(qq[This will overwrite the current OpenSLX-database with an example dataset.
+All your data (%s systems and %s clients) will be lost!
+Do you want to continue(%s/%s)? ], scalar(@systems), scalar(@clients), $yes, $no);
+	my $answer = <>;
+	if ($answer !~ m[^\s*$yes]i) {
+		print "no - stopping\n";
+		exit 5;
+	}
+	print "yes - starting...\n";
+}
+
+emptyDatabase($openslxDB);
+
 addVendorOS($openslxDB, {
 		'name' => "suse-10-minimal",
-		'comment' => "SuSE 9.3 minimale Installation",
+		'comment' => "SuSE 10 minimale Installation",
 		'path' => "suse-10.0",
 			# relative to /var/lib/openslx/stage1
 });
 
 addVendorOS($openslxDB, {
 		'name' => "suse-10-KDE",
-		'comment' => "SuSE 9.3 grafische Installation mit KDE",
+		'comment' => "SuSE 10 grafische Installation mit KDE",
 		'path' => "suse-10.0",
 });