* activated 'use warnings' to all modules and adjusted all occurences of

  'use of uninitialized values', a couple of which might still show up
* adjusted all code with respect to passing perlcritic level 4 and 5

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

10 files changed, 101 insertions, 105 deletions

diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm
index 5518d230..e9940fd1 100644
--- a/config-db/OpenSLX/ConfigDB.pm
+++ b/config-db/OpenSLX/ConfigDB.pm
@@ -11,9 +11,14 @@
 package OpenSLX::ConfigDB;
 
 use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+use warnings;
+
+our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
 $VERSION = 1;    # API-version
 
+use Exporter;
+@ISA = qw(Exporter);
+
 ################################################################################
 ### This module defines the data abstraction layer for the OpenSLX configuration
 ### database.
@@ -28,9 +33,6 @@ $VERSION = 1;    # API-version
 ### 	- support methods
 ################################################################################
 
-use Exporter;
-@ISA = qw(Exporter);
-
 my @supportExports = qw(
   isAttribute mergeAttributes pushAttributes
   externalIDForSystem externalIDForClient externalConfigNameForClient
@@ -44,7 +46,6 @@ my @supportExports = qw(
 ################################################################################
 ### private stuff
 ################################################################################
-use Carp;
 use OpenSLX::Basics;
 use OpenSLX::DBSchema;
 
@@ -106,7 +107,7 @@ sub _checkAndUpgradeDBSchemaIfNecessary
 						$changeDescr->{'cols'}
 					);
 				} else {
-					confess _tr('UnknownDbSchemaCommand', $cmd);
+					croak _tr('UnknownDbSchemaCommand', $cmd);
 				}
 			}
 		}
@@ -162,29 +163,25 @@ sub connect
 		$dbType = $dbTypeMap{$lcType};
 	}
 
+	my $dbModuleName = "OpenSLX/MetaDB/$dbType.pm";
 	my $dbModule = "OpenSLX::MetaDB::$dbType";
-	unless (eval "require $dbModule") {
+	unless (eval { require $dbModuleName } ) {
 		if ($! == 2) {
 			die _tr(
 				"Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n",
-				$dbModule
+				$dbModuleName
 			);
 		} else {
-			die _tr("Unable to load DB-module <%s> (%s)\n", $dbModule, $@);
+			die _tr("Unable to load DB-module <%s> (%s)\n", $dbModuleName, $@);
 		}
 	}
-	my $modVersion = $dbModule->VERSION;
-	if ($modVersion < $VERSION) {
-		confess _tr(
-			'Could not load module <%s> (Version <%s> required, but <%s> found)',
-			$dbModule, $VERSION, $modVersion);
-	}
 	my $metaDB = $dbModule->new();
-	if (!eval '$metaDB->connect($dbParams);1') {
-		warn _tr("Unable to connect to DB-module <%s>\n%s", $dbModule, $@);
+	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 ('CSV', 'mysql', 'SQLite') {
-			if (eval "require DBD::$dbMod;") {
+			my $fullDbModName = "DBD/$dbMod.pm";
+			if (eval { require $fullDbModName }) {
 				vlog(0, "\t$dbMod\n");
 			}
 		}
@@ -436,7 +433,7 @@ sub incrementExportCounterForVendorOS
 
 	$self->start_transaction();
 	my $vendorOS = $self->fetchVendorOSByID($id);
-	return undef unless defined $vendorOS;
+	return unless defined $vendorOS;
 	my $exportCounter = $vendorOS->{export_counter} + 1;
 	$self->changeVendorOS($id, {'export_counter' => $exportCounter});
 	$self->commit_transaction();
@@ -451,7 +448,7 @@ sub incrementGlobalCounter
 
 	$self->start_transaction();
 	my $value = $self->fetchGlobalInfo($counterName);
-	return undef unless defined $value;
+	return unless defined $value;
 	my $newValue = $value + 1;
 	$self->changeGlobalInfo($counterName, $newValue);
 	$self->commit_transaction();
@@ -499,10 +496,10 @@ sub addSystem
 	my $valRows = _aref(shift);
 
 	foreach my $valRow (@$valRows) {
-		if (!length($valRow->{kernel})) {
+		if (!defined $valRow->{kernel} || !length($valRow->{kernel})) {
 			$valRow->{kernel} = 'vmlinuz';
 		}
-		if (!length($valRow->{label})) {
+		if (!defined $valRow->{label} || !length($valRow->{label})) {
 			$valRow->{label} = $valRow->{name};
 		}
 	}
@@ -958,7 +955,7 @@ sub aggregatedSystemFileInfoFor
 	  "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}/boot";
 	$info->{'kernel-file'} = "$kernelPath/$system->{kernel}";
 
-	my $exportURI = $export->{'uri'};
+	my $exportURI = $export->{'uri'} || '';
 	if ($exportURI !~ m[\w]) {
 		# auto-generate export_uri if none has been given:
 		my $type           = $export->{'type'};
@@ -987,9 +984,11 @@ sub mergeAttributes
 	my $source = shift;
 
 	foreach my $key (grep { isAttribute($_) } keys %$source) {
-		if (length($source->{$key}) > 0 && length($target->{$key}) == 0) {
-			vlog(3, _tr("merging %s (val=%s)", $key, $source->{$key}));
-			$target->{$key} = $source->{$key};
+		my $sourceVal = $source->{$key} || '';
+		my $targetVal = $target->{$key} || '';
+		if (length($sourceVal) > 0 && length($targetVal) == 0) {
+			vlog(3, _tr("merging %s (val=%s)", $key, $sourceVal));
+			$target->{$key} = $sourceVal;
 		}
 	}
 }
@@ -1000,9 +999,10 @@ sub pushAttributes
 	my $source = shift;
 
 	foreach my $key (grep { isAttribute($_) } keys %$source) {
-		if (length($source->{$key}) > 0) {
-			vlog(3, _tr("pushing %s (val=%s)", $key, $source->{$key}));
-			$target->{$key} = $source->{$key};
+		my $sourceVal = $source->{$key} || '';
+		if (length($sourceVal) > 0) {
+			vlog(3, _tr("pushing %s (val=%s)", $key, $sourceVal));
+			$target->{$key} = $sourceVal;
 		}
 	}
 }
diff --git a/config-db/OpenSLX/DBSchema.pm b/config-db/OpenSLX/DBSchema.pm
index 0fbce67a..1454390a 100644
--- a/config-db/OpenSLX/DBSchema.pm
+++ b/config-db/OpenSLX/DBSchema.pm
@@ -14,7 +14,9 @@
 package OpenSLX::DBSchema;
 
 use strict;
-use vars qw(@ISA @EXPORT $VERSION);
+use warnings;
+
+our (@ISA, @EXPORT, $VERSION);
 
 use Exporter;
 $VERSION = 0.01;
@@ -24,7 +26,7 @@ $VERSION = 0.01;
 	$DbSchema %DbSchemaHistory
 );
 
-use vars qw($DbSchema %DbSchemaHistory);
+our ($DbSchema, %DbSchemaHistory);
 
 # configurable attributes for system, client and group:
 my @sharedAttributes = (
diff --git a/config-db/OpenSLX/Export/DHCP/ISC.pm b/config-db/OpenSLX/Export/DHCP/ISC.pm
index 194876fa..2e7aa01b 100644
--- a/config-db/OpenSLX/Export/DHCP/ISC.pm
+++ b/config-db/OpenSLX/Export/DHCP/ISC.pm
@@ -13,14 +13,14 @@
 # -----------------------------------------------------------------------------
 package OpenSLX::Export::DHCP::ISC;
 
-use vars qw(@ISA $VERSION);
-$VERSION = 1.01;		# API-version . implementation-version
+use strict;
+use warnings;
+
+our $VERSION = 1.01;		# API-version . implementation-version
 
 ################################################################################
 ### This class provides an ISC specific implementation for DHCP export.
 ################################################################################
-use strict;
-use Carp;
 use OpenSLX::Basics;
 
 ################################################################################
diff --git a/config-db/OpenSLX/MetaDB/Base.pm b/config-db/OpenSLX/MetaDB/Base.pm
index 2738cb16..2aa1c3f2 100644
--- a/config-db/OpenSLX/MetaDB/Base.pm
+++ b/config-db/OpenSLX/MetaDB/Base.pm
@@ -14,11 +14,11 @@
 package OpenSLX::MetaDB::Base;
 
 use strict;
+use warnings;
 
-use vars qw($VERSION);
-$VERSION = 1.01;		# API-version . implementation-version
+our $VERSION = 1.01;		# API-version . implementation-version
 
-use Carp;
+use OpenSLX::Basics;
 
 ################################################################################
 ### basic functions
diff --git a/config-db/OpenSLX/MetaDB/CSV.pm b/config-db/OpenSLX/MetaDB/CSV.pm
index 104a4d98..ef96833a 100644
--- a/config-db/OpenSLX/MetaDB/CSV.pm
+++ b/config-db/OpenSLX/MetaDB/CSV.pm
@@ -14,8 +14,8 @@
 package OpenSLX::MetaDB::CSV;
 
 use strict;
-use vars qw($VERSION);
-$VERSION = 1.01;    # API-version . implementation-version
+use warnings;
+
 use base qw(OpenSLX::MetaDB::DBI);
 
 ################################################################################
@@ -24,12 +24,9 @@ use base qw(OpenSLX::MetaDB::DBI);
 ### - each table will be stored into a CSV file.
 ### - by default all files will be created inside a 'openslxdata-csv' directory.
 ################################################################################
-use strict;
-use Carp;
 use Fcntl qw(:DEFAULT :flock);
 use DBD::CSV 0.22;
 use OpenSLX::Basics;
-use OpenSLX::MetaDB::DBI 1;
 
 ################################################################################
 ### implementation
diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm
index ea0b66f1..91d774c7 100644
--- a/config-db/OpenSLX/MetaDB/DBI.pm
+++ b/config-db/OpenSLX/MetaDB/DBI.pm
@@ -14,14 +14,12 @@
 package OpenSLX::MetaDB::DBI;
 
 use strict;
-use vars qw($VERSION);
-$VERSION = 1.01;    # API-version . implementation-version
+use warnings;
+
 use base qw(OpenSLX::MetaDB::Base);
 
-use Carp;
 use DBI;
 use OpenSLX::Basics;
-use OpenSLX::MetaDB::Base 1;
 
 ################################################################################
 ### basics
@@ -783,7 +781,7 @@ sub schemaFetchDBVersion
 	  eval { $dbh->selectrow_hashref('SELECT schema_version FROM meta'); };
 	return 0 if $@;
 	# no database access possible
-	return undef unless defined $row;
+	return unless defined $row;
 	# no entry in meta-table
 	return $row->{schema_version};
 }
diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm
index 65e1668c..d6681ce6 100644
--- a/config-db/OpenSLX/MetaDB/SQLite.pm
+++ b/config-db/OpenSLX/MetaDB/SQLite.pm
@@ -14,19 +14,16 @@
 package OpenSLX::MetaDB::SQLite;
 
 use strict;
-use vars qw($VERSION);
-$VERSION = 1.01;    # API-version . implementation-version
+use warnings;
+
 use base qw(OpenSLX::MetaDB::DBI);
 
 ################################################################################
 ### This class provides a MetaDB backend for SQLite databases.
 ### - by default the db will be created inside a 'openslxdata-sqlite' directory.
 ################################################################################
-use strict;
-use Carp;
 use DBD::SQLite;
 use OpenSLX::Basics;
-use OpenSLX::MetaDB::DBI 1;
 
 ################################################################################
 ### implementation
@@ -52,16 +49,11 @@ sub connect
 		$dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}";
 	}
 	vlog(1, "trying to connect to SQLite-database <$dbSpec>");
-	eval('require DBD::SQLite; 1;')
-	  or die _tr(
-		qq[%s doesn't seem to be installed,
-so there is no support for %s available, sorry!\n%s], 'DBD::SQLite', 'SQLite',
-		$@
-	  );
 	$self->{'dbh'} =
 	  DBI->connect("dbi:SQLite:$dbSpec", undef, undef,
 		{PrintError => 0, AutoCommit => 1})
 	  or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr);
+	return 1;
 }
 
 sub schemaRenameTable
@@ -77,7 +69,7 @@ sub schemaRenameTable
 	my $sql = "ALTER TABLE $oldTable RENAME TO $newTable";
 	vlog(3, $sql);
 	$dbh->do($sql)
-	  or confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr);
+	  or croak(_tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr));
 }
 
 sub schemaAddColumns
@@ -99,8 +91,8 @@ sub schemaAddColumns
 		my $sql = "ALTER TABLE $table ADD COLUMN $colDescrString";
 		vlog(3, $sql);
 		$dbh->do($sql)
-		  or confess _tr(q[Can't add column to table <%s> (%s)], $table,
-			$dbh->errstr);
+		  or croak(_tr(q[Can't add column to table <%s> (%s)], $table,
+			$dbh->errstr));
 	}
 	# if default values have been provided, we apply them now:
 	if (defined $newColDefaultVals) {
diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm
index 195f9870..769506d1 100644
--- a/config-db/OpenSLX/MetaDB/mysql.pm
+++ b/config-db/OpenSLX/MetaDB/mysql.pm
@@ -14,19 +14,16 @@
 package OpenSLX::MetaDB::mysql;
 
 use strict;
-use vars qw($VERSION);
-$VERSION = 1.01;    # API-version . implementation-version
+use warnings;
+
 use base qw(OpenSLX::MetaDB::DBI);
 
 ################################################################################
 ### This class provides a MetaDB backend for mysql databases.
 ### - by default the db will be created inside a 'openslxdata-mysql' directory.
 ################################################################################
-use strict;
-use Carp;
 use DBD::mysql;
 use OpenSLX::Basics;
-use OpenSLX::MetaDB::DBI 1;
 
 ################################################################################
 ### implementation
diff --git a/config-db/slxconfig b/config-db/slxconfig
index cb6c912e..07ff6473 100755
--- a/config-db/slxconfig
+++ b/config-db/slxconfig
@@ -11,6 +11,7 @@
 # General information about OpenSLX can be found at http://openslx.org/
 # -----------------------------------------------------------------------------
 use strict;
+use warnings;
 
 my $abstract = q[
 slxconfig
@@ -143,7 +144,7 @@ sub dumpElements
 				'',
 				map {
 					my $spc = ' 'x25;
-					my $val = $elem->{$_};
+					my $val = $elem->{$_} || '';
 					$val =~ s[\n][\n\t$spc   ]g;
 					"\t$_"
 					.substr($spc, length($_))
@@ -319,12 +320,12 @@ sub addSystemToConfigDB
     my $systemData = parseKeyValueArgs(\@systemKeys, 'system', @_);
 	$systemData->{name} = $systemName;
 
-	if (!length($systemData->{export})) {
-		$systemData->{export} = $systemName;
+	my $exportName = $systemData->{export} || '';
+	delete $systemData->{export};
+	if (!length($exportName)) {
+		$exportName = $systemName;
 			# try falling back to given system name
 	}
-    my $exportName = $systemData->{export};
-	delete $systemData->{export};
 	my $export
 		= $openslxDB->fetchExportByFilter({ 'name' => $exportName });
 	if (!defined $export) {
diff --git a/config-db/slxconfig-demuxer b/config-db/slxconfig-demuxer
index d3b53541..c227d510 100755
--- a/config-db/slxconfig-demuxer
+++ b/config-db/slxconfig-demuxer
@@ -14,6 +14,7 @@
 #	- OpenSLX configuration demultiplexer
 # -----------------------------------------------------------------------------
 use strict;
+use warnings;
 
 my $abstract = q[
 slxconfig-demuxer
@@ -217,9 +218,14 @@ sub digestAttributes
 	    # facilitate comparing different attribute hashes.
 	my $attrs = shift;
 
-	my $attrsAsString = join ';', map { "$_=$attrs->{$_}"; }
-	  sort { $a cmp $b }
-	  grep { isAttribute($_) } keys %$attrs;
+	my $attrsAsString 
+		=   join ';', 
+			map { 
+				my $val = $attrs->{$_} || '';
+				"$_=$val";
+			}
+		    sort { $a cmp $b }
+		    grep { isAttribute($_) } keys %$attrs;
 
 	vlog(3, "Attribute-string: $attrsAsString");
 	use Digest::MD5 qw(md5_hex);
@@ -234,27 +240,27 @@ sub writeAttributesToFile
 
 	return if $dryRun;
 
-	# Overwrite attribute file even if it exists, to make sure that our users
-	# will never again try to fiddle with machine-setup directly the
-	# file-system. From now on the DB is the keeper of that info.
-	open(ATTRS, "> $fileName") or die "unable to write to $fileName";
+	my $content = "# attributes set by slxconfig-demuxer:\n";
 	my @attrs = (
 		$grepForAttributes
-		? sort grep { isAttribute($_) } keys %$attrHash
-		: keys %$attrHash
+			? sort grep { isAttribute($_) } keys %$attrHash
+			: keys %$attrHash
 	);    
-	print ATTRS "# attributes set by slxconfig-demuxer:\n";
 	foreach my $attr (@attrs) {
-		if (length($attrHash->{$attr}) > 0) {
+		my $attrVal = $attrHash->{$attr} || '';
+		if (length($attrVal) > 0) {
 			my $externalAttrName = externalAttrName($attr);
-			print ATTRS qq[$externalAttrName="$attrHash->{$attr}"\n];
+			$content .= qq[$externalAttrName="$attrVal"\n];
 		}
 	}
-	close(ATTRS);
+	# Overwrite attribute file even if it exists, to make sure that our users
+	# will never again try to fiddle with machine-setup directly the
+	# file-system. From now on the DB is the keeper of that info.
+	spitFile($fileName, $content);
 	if ($openslxConfig{'verbose-level'} > 2) {
-		print "--- START OF $fileName ---\n";
-		system("cat $fileName");
-		print "--- END OF $fileName --- \n";
+		vlog(0, "--- START OF $fileName ---");
+		vlog(0, $content);
+		vlog(0, "--- END OF $fileName --- ");
 	}
 }
 
@@ -265,11 +271,11 @@ sub writeSlxConfigToFile
 
 	return if $dryRun;
 
-	open(SLXCONF, "> $fileName") or die "unable to write to $fileName";
+	my $content = '';
 	foreach my $key (sort keys %$slxConf) {
-		print SLXCONF qq[$key="$slxConf->{$key}"\n];
+		$content .= qq[$key="$slxConf->{$key}"\n];
 	}
-	close(SLXCONF);
+	spitFile($fileName, $content);
 }
 
 sub copyExternalSystemConfig
@@ -372,11 +378,13 @@ sub writePXEMenus
 	foreach my $client (@clients) {
 		my $externalClientID = externalIDForClient($client);
 		my $pxeFile          = "$pxeConfigPath/$externalClientID";
-		my $clientAppend     = $client->{kernel_params};
+		my $clientAppend     = $client->{kernel_params} || '';
 		vlog(1, _tr("writing PXE-file %s", $pxeFile));
 		next if $dryRun;
-		open(PXE, ">$pxeFile") or die "unable to write to $pxeFile";
-		print PXE $pxeTemplate;
+		my $pxeFH;
+		open($pxeFH, '>', $pxeFile)
+			or croak _tr("unable to create file '%s' (%s)\n", $pxeFile, $!);
+		print $pxeFH $pxeTemplate;
 		my %systemIDs;
 		@systemIDs{$openslxDB->aggregatedSystemIDsOfClient($client)} = ();
 		my @systemInfos = grep { exists $systemIDs{$_->{id}} } @infos;
@@ -387,13 +395,14 @@ sub writePXEMenus
 			my $append     = $info->{kernel_params};
 			$append .= " initrd=$extID/$info->{'initramfs-name'}";
 			$append .= " $clientAppend";
-			print PXE "LABEL openslx-$info->{'external-id'}\n";
-			print PXE "\tMENU LABEL ^$info->{label}\n";
-			print PXE "\tKERNEL $extID/$kernelName\n";
-			print PXE "\tAPPEND $append\n";
-			print PXE "\tIPAPPEND 1\n";
+			print $pxeFH "LABEL openslx-$info->{'external-id'}\n";
+			print $pxeFH "\tMENU LABEL ^$info->{label}\n";
+			print $pxeFH "\tKERNEL $extID/$kernelName\n";
+			print $pxeFH "\tAPPEND $append\n";
+			print $pxeFH "\tIPAPPEND 1\n";
 		}
-		close(PXE);
+		close($pxeFH)
+			or croak _tr("unable to close file '%s' (%s)\n", $pxeFile, $!);
 	}
 }
 
@@ -430,10 +439,10 @@ sub generateInitalRamFS
 	# generate initramfs-setup file (with settings relevant for initramfs only):
 	my $initramfsAttrFile = "$tempPath/initramfs-setup";
 	my $initramfsAttrs    = {
-		'ramfs_fsmods'  => "$info->{'attr_ramfs_fsmods'}",
-		'ramfs_nicmods' => "$info->{'attr_ramfs_nicmods'}",
-		'ramfs_screen'  => "$info->{'attr_ramfs_screen'}",
-		'rootfs'        => "$info->{'export-uri'}",
+		'ramfs_fsmods'  => $info->{'attr_ramfs_fsmods'} || '',
+		'ramfs_nicmods' => $info->{'attr_ramfs_nicmods'} || '',
+		'ramfs_screen'  => $info->{'attr_ramfs_screen'} || '',
+		'rootfs'        => $info->{'export-uri'} || '',
 	};
 	writeAttributesToFile($initramfsAttrs, $initramfsAttrFile, 0);
 	# and pass it to mkdxsinitrd:
@@ -478,7 +487,7 @@ sub writeDhcpConfig
 {
 	vlog(0, _tr("sorry, exporting dhcp data is not implemented yet!"));
 	my $dhcpModule = "OpenSLX::Export::DHCP::$dhcpType";
-	if (!eval "require $dhcpModule") {
+	if (!eval { require $dhcpModule } ) {
 		die _tr("unable to load DHCP-Export backend '%s'! (%s)\n",
 			$dhcpModule, $@);
 	}