* more work towards perlcritic compliance, fixed the low-hanging fruit

  for level 4

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

9 files changed, 68 insertions, 14 deletions

diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm
index e9940fd1..07da71c8 100644
--- a/config-db/OpenSLX/ConfigDB.pm
+++ b/config-db/OpenSLX/ConfigDB.pm
@@ -13,7 +13,7 @@ package OpenSLX::ConfigDB;
 use strict;
 use warnings;
 
-our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
+our (@ISA, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
 $VERSION = 1;    # API-version
 
 use Exporter;
@@ -39,7 +39,6 @@ my @supportExports = qw(
   externalAttrName generatePlaceholderFor
 );
 
-@EXPORT      = ();
 @EXPORT_OK   = (@supportExports);
 %EXPORT_TAGS = ('support' => [@supportExports],);
 
@@ -115,6 +114,7 @@ sub _checkAndUpgradeDBSchemaIfNecessary
 	} else {
 		vlog(1, _tr('DB matches current schema version %s', $currVersion));
 	}
+	return;
 }
 
 sub _aref
@@ -141,7 +141,7 @@ sub new
 	return bless $self, $class;
 }
 
-sub connect
+sub connect		## no critic (ProhibitBuiltinHomonyms)
 {
 	my $self     = shift;
 	my $dbParams = shift;
@@ -196,6 +196,7 @@ sub connect
 	}
 
 	_checkAndUpgradeDBSchemaIfNecessary($metaDB);
+	return;
 }
 
 sub disconnect
@@ -203,6 +204,7 @@ sub disconnect
 	my $self = shift;
 
 	$self->{'meta-db'}->disconnect();
+	return;
 }
 
 sub start_transaction
@@ -210,6 +212,7 @@ sub start_transaction
 	my $self = shift;
 
 	$self->{'meta-db'}->start_transaction();
+	return;
 }
 
 sub commit_transaction
@@ -217,6 +220,7 @@ sub commit_transaction
 	my $self = shift;
 
 	$self->{'meta-db'}->commit_transaction();
+	return;
 }
 
 sub rollback_transaction
@@ -224,6 +228,7 @@ sub rollback_transaction
 	my $self = shift;
 
 	$self->{'meta-db'}->rollback_transaction();
+	return;
 }
 
 sub fetchVendorOSByFilter
@@ -829,6 +834,7 @@ sub emptyDatabase
 	my @vendorOSIDs = map { $_->{id} }
 	  grep { $_->{id} > 0 } $self->fetchVendorOSByFilter();
 	$self->removeVendorOS(\@vendorOSIDs);
+	return;
 }
 
 ################################################################################
@@ -845,6 +851,7 @@ sub mergeDefaultAttributesIntoSystem
 
 	my $defaultClient = $self->fetchClientByID(0);
 	pushAttributes($system, $defaultClient);
+	return;
 }
 
 sub mergeDefaultAndGroupAttributesIntoClient
@@ -869,6 +876,7 @@ sub mergeDefaultAndGroupAttributesIntoClient
 	vlog(3, _tr('merging from default client...'));
 	my $defaultClient = $self->fetchClientByID(0);
 	mergeAttributes($client, $defaultClient);
+	return;
 }
 
 sub aggregatedSystemIDsOfClient
@@ -991,6 +999,7 @@ sub mergeAttributes
 			$target->{$key} = $sourceVal;
 		}
 	}
+	return;
 }
 
 sub pushAttributes
@@ -1005,6 +1014,7 @@ sub pushAttributes
 			$target->{$key} = $sourceVal;
 		}
 	}
+	return;
 }
 
 sub externalIDForSystem
diff --git a/config-db/OpenSLX/DBSchema.pm b/config-db/OpenSLX/DBSchema.pm
index 1454390a..e4263a9b 100644
--- a/config-db/OpenSLX/DBSchema.pm
+++ b/config-db/OpenSLX/DBSchema.pm
@@ -345,3 +345,4 @@ if ($lang =~ m[^\w\w_(\w\w)]) {
 	],
 );
 
+1;
diff --git a/config-db/OpenSLX/MetaDB/Base.pm b/config-db/OpenSLX/MetaDB/Base.pm
index 2aa1c3f2..3f03fbed 100644
--- a/config-db/OpenSLX/MetaDB/Base.pm
+++ b/config-db/OpenSLX/MetaDB/Base.pm
@@ -28,7 +28,7 @@ sub new
 	confess "Don't create OpenSLX::MetaDB::Base - objects directly!";
 }
 
-sub connect
+sub connect		## no critic (ProhibitBuiltinHomonyms)
 {
 }
 
@@ -124,7 +124,7 @@ sub generateNextIdForTable
 	# NB: if this method is called without a tablename, it returns:
 	# 	  1 if this backend requires manual ID generation
 	# 	  0 if not.
-	return undef;
+	return;
 }
 
 sub addVendorOS
diff --git a/config-db/OpenSLX/MetaDB/CSV.pm b/config-db/OpenSLX/MetaDB/CSV.pm
index ef96833a..0ef9ab93 100644
--- a/config-db/OpenSLX/MetaDB/CSV.pm
+++ b/config-db/OpenSLX/MetaDB/CSV.pm
@@ -38,7 +38,7 @@ sub new
 	return bless $self, $class;
 }
 
-sub connect
+sub connect		## no critic (ProhibitBuiltinHomonyms)
 {
 	my $self = shift;
 
@@ -55,6 +55,7 @@ sub connect
 	$self->{'dbh'} =
 	  DBI->connect("dbi:CSV:$dbSpec", undef, undef, {PrintError => 0})
 	  or die _tr("Cannot connect to database '%s' (%s)", $dbSpec, $DBI::errstr);
+	return;
 }
 
 sub quote
@@ -78,6 +79,7 @@ sub start_transaction
 	$self->{"transaction-lock"} = *TRANSFILE;
 	flock(TRANSFILE, LOCK_EX)
 	  or confess _tr(q[Can't lock transaction-file '%s' (%s)], $lockFile, $!);
+	return;
 }
 
 sub commit_transaction
@@ -150,6 +152,7 @@ sub schemaDeclareTable
 
 	my $dbh = $self->{'dbh'};
 	$dbh->{'csv_tables'}->{"$table"} = {'file' => "${table}.csv"};
+	return;
 }
 
 sub schemaRenameTable
@@ -162,6 +165,7 @@ sub schemaRenameTable
 	$self->SUPER::schemaRenameTable($oldTable, $newTable, @_);
 	my $dbh = $self->{'dbh'};
 	rename "$dbh->{'f_dir'}/id-$oldTable", "$dbh->{'f_dir'}/id-$newTable";
+	return;
 }
 
 sub schemaDropTable
@@ -172,6 +176,7 @@ sub schemaDropTable
 	$self->SUPER::schemaDropTable($table, @_);
 	my $dbh = $self->{'dbh'};
 	unlink "$dbh->{'f_dir'}/id-$table";
+	return;
 }
 
 1;
diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm
index 91d774c7..470fa5c7 100644
--- a/config-db/OpenSLX/MetaDB/DBI.pm
+++ b/config-db/OpenSLX/MetaDB/DBI.pm
@@ -35,6 +35,7 @@ sub disconnect
 
 	$self->{'dbh'}->disconnect;
 	$self->{'dbh'} = undef;
+	return;
 }
 
 sub quote
@@ -669,6 +670,7 @@ sub setSystemIDsOfClient
 	my @currSystems = $self->fetchSystemIDsOfClient($clientID);
 	$self->_updateRefTable('client_system_ref', $clientID, $systemIDs,
 		'client_id', 'system_id', \@currSystems);
+	return;
 }
 
 sub setGroupIDsOfClient
@@ -680,6 +682,7 @@ sub setGroupIDsOfClient
 	my @currGroups = $self->fetchGroupIDsOfClient($clientID);
 	$self->_updateRefTable('group_client_ref', $clientID, $groupIDs,
 		'client_id', 'group_id', \@currGroups);
+	return;
 }
 
 sub addGroup
@@ -716,6 +719,7 @@ sub setClientIDsOfGroup
 	my @currClients = $self->fetchClientIDsOfGroup($groupID);
 	$self->_updateRefTable('group_client_ref', $groupID, $clientIDs, 'group_id',
 		'client_id', \@currClients);
+	return;
 }
 
 sub setSystemIDsOfGroup
@@ -727,6 +731,7 @@ sub setSystemIDsOfGroup
 	my @currSystems = $self->fetchSystemIDsOfGroup($groupID);
 	$self->_updateRefTable('group_system_ref', $groupID, $systemIDs, 'group_id',
 		'system_id', \@currSystems);
+	return;
 }
 
 ################################################################################
@@ -826,6 +831,7 @@ sub schemaAddTable
 		# don't care about IDs if there's no 'id' column in this table
 		$self->_doInsert($table, $initialVals, $ignoreIDs);
 	}
+	return;
 }
 
 sub schemaDropTable
@@ -840,6 +846,7 @@ sub schemaDropTable
 	vlog(3, $sql);
 	$dbh->do($sql)
 	  or confess _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr);
+	return;
 }
 
 sub schemaRenameTable
@@ -871,6 +878,7 @@ sub schemaRenameTable
 	vlog(3, $sql);
 	$dbh->do($sql)
 	  or confess _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr);
+	return;
 }
 
 sub schemaAddColumns
@@ -912,6 +920,7 @@ sub schemaAddColumns
 
 	$self->schemaDropTable($table, 1);
 	$self->schemaRenameTable($tempTable, $table, $colDescrs, 1);
+	return;
 }
 
 sub schemaDropColumns
@@ -944,6 +953,7 @@ sub schemaDropColumns
 
 	$self->schemaDropTable($table, 1);
 	$self->schemaRenameTable($tempTable, $table, $colDescrs, 1);
+	return;
 }
 
 sub schemaChangeColumns
@@ -985,6 +995,7 @@ sub schemaChangeColumns
 
 	$self->schemaDropTable($table, 1);
 	$self->schemaRenameTable($tempTable, $table, $colDescrs, 1);
+	return;
 }
 
 1;
diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm
index d6681ce6..f6b395d0 100644
--- a/config-db/OpenSLX/MetaDB/SQLite.pm
+++ b/config-db/OpenSLX/MetaDB/SQLite.pm
@@ -35,7 +35,7 @@ sub new
 	return bless $self, $class;
 }
 
-sub connect
+sub connect		## no critic (ProhibitBuiltinHomonyms)
 {
 	my $self = shift;
 
@@ -70,6 +70,7 @@ sub schemaRenameTable
 	vlog(3, $sql);
 	$dbh->do($sql)
 	  or croak(_tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr));
+	return;
 }
 
 sub schemaAddColumns
@@ -98,6 +99,7 @@ sub schemaAddColumns
 	if (defined $newColDefaultVals) {
 		$self->_doUpdate($table, undef, $newColDefaultVals);
 	}
+	return;
 }
 
 1;
diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm
index 769506d1..03272331 100644
--- a/config-db/OpenSLX/MetaDB/mysql.pm
+++ b/config-db/OpenSLX/MetaDB/mysql.pm
@@ -35,7 +35,7 @@ sub new
 	return bless $self, $class;
 }
 
-sub connect
+sub connect		## no critic (ProhibitBuiltinHomonyms)
 {
 	my $self = shift;
 
@@ -49,6 +49,7 @@ sub connect
 	$self->{'dbh'} =
 	  DBI->connect("dbi:mysql:$dbSpec", $user, '', {PrintError => 0})
 	  or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr);
+	return;
 }
 
 sub schemaConvertTypeDescrToNative
@@ -85,6 +86,7 @@ sub schemaRenameTable
 	vlog(3, $sql);
 	$dbh->do($sql)
 	  or confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr);
+	return;
 }
 
 sub schemaAddColumns
@@ -111,6 +113,7 @@ sub schemaAddColumns
 	if (defined $newColDefaultVals) {
 		$self->_doUpdate($table, undef, $newColDefaultVals);
 	}
+	return;
 }
 
 sub schemaDropColumns
@@ -132,6 +135,7 @@ sub schemaDropColumns
 	$dbh->do($sql)
 	  or confess _tr(q[Can't drop columns from table <%s> (%s)], $table,
 		$dbh->errstr);
+	return;
 }
 
 sub schemaChangeColumns
@@ -156,5 +160,7 @@ sub schemaChangeColumns
 	$dbh->do($sql)
 	  or confess _tr(q[Can't change columns in table <%s> (%s)], $table,
 		$dbh->errstr);
+	return;
 }
+
 1;
diff --git a/config-db/slxconfig b/config-db/slxconfig
index 58a06d9f..94ebc13a 100755
--- a/config-db/slxconfig
+++ b/config-db/slxconfig
@@ -109,8 +109,6 @@ Try '%s --help' for more info.\n", $0);
 
 $openslxDB->disconnect();
 
-exit;
-
 sub parseKeyValueArgs
 {
     my $allowedKeys = shift;
@@ -154,8 +152,9 @@ sub dumpElements
 			);
 		}
 	} else {
-		print join('', sort map &$nameClause, @_);
+		print join('', sort map { $nameClause->($_); } @_);
 	}
+	return;
 }
 
 sub listClients
@@ -182,6 +181,7 @@ sub listClients
 		sort { $a->{name} cmp $b->{name} }
 		$openslxDB->fetchClientByFilter($clientData)
 	);
+	return;
 }
 
 sub listExports
@@ -210,6 +210,7 @@ sub listExports
 		sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} }
 		$openslxDB->fetchExportByFilter($exportData)
 	);
+	return;
 }
 
 sub listSystems
@@ -240,6 +241,7 @@ sub listSystems
 		sort { $a->{name} cmp $b->{name} }
 		$openslxDB->fetchSystemByFilter($systemData)
 	);
+	return;
 }
 
 sub listVendorOSes
@@ -255,6 +257,7 @@ sub listVendorOSes
 	dumpElements('vendor-OS', undef,
 				 sort { $a->{name} cmp $b->{name} }
 				 $openslxDB->fetchVendorOSByFilter($vendorOSData));
+	return;
 }
 
 sub addClientToConfigDB
@@ -311,6 +314,7 @@ sub addClientToConfigDB
 	if ($verbose) {
 		listClients("id=$clientID");
 	}
+	return;
 }
 
 sub addSystemToConfigDB
@@ -397,6 +401,7 @@ sub addSystemToConfigDB
 	if ($verbose) {
 		listSystems("id=$systemID");
 	}
+	return;
 }
 
 sub changeClientInConfigDB
@@ -473,6 +478,7 @@ sub changeClientInConfigDB
 	if ($verbose) {
 		listClients("id=$client->{id}");
 	}
+	return;
 }
 
 sub changeSystemInConfigDB
@@ -543,6 +549,7 @@ sub changeSystemInConfigDB
 	if ($verbose) {
 		listSystems("id=$system->{id}");
 	}
+	return;
 }
 
 sub removeClientFromConfigDB
@@ -566,6 +573,7 @@ sub removeClientFromConfigDB
 	$openslxDB->removeClient($client->{id});
 	vlog(0, _tr("client '%s' has been successfully removed from DB\n",
 				$clientName));
+	return;
 }
 
 sub removeSystemFromConfigDB
@@ -589,10 +597,9 @@ sub removeSystemFromConfigDB
 	$openslxDB->removeSystem($system->{id});
 	vlog(0, _tr("system '%s' has been successfully removed from DB\n",
 				$systemName));
+	return;
 }
 
-
-
 =head1 NAME
 
 slxconfig - OpenSLX-script to view & change the configurational database
diff --git a/config-db/slxconfig-demuxer b/config-db/slxconfig-demuxer
index 54bcf4f3..91a79849 100755
--- a/config-db/slxconfig-demuxer
+++ b/config-db/slxconfig-demuxer
@@ -191,8 +191,9 @@ sub unlockScript
 	return if $dryRun;
 
 	close(LOCKFILE);
-
 	unlink $lockFile;
+
+	return;
 }
 
 sub folderContainsFiles
@@ -262,6 +263,7 @@ sub writeAttributesToFile
 		vlog(0, $content);
 		vlog(0, "--- END OF $fileName --- ");
 	}
+	return;
 }
 
 sub writeSlxConfigToFile
@@ -276,6 +278,7 @@ sub writeSlxConfigToFile
 		$content .= qq[$key="$slxConf->{$key}"\n];
 	}
 	spitFile($fileName, $content);
+	return;
 }
 
 sub copyExternalSystemConfig
@@ -316,6 +319,7 @@ sub copyExternalSystemConfig
 			slxsystem("cp -a $clientSpecConfigPath/* $targetPath");
 		}
 	}
+	return;
 }
 
 sub createTarOfPath
@@ -404,6 +408,7 @@ sub writePXEMenus
 		close($pxeFH)
 			or croak _tr("unable to close file '%s' (%s)\n", $pxeFile, $!);
 	}
+	return;
 }
 
 sub generateInitalRamFS
@@ -465,6 +470,7 @@ sub generateInitalRamFS
 
 	# ... finally invoke mkdxsinitrd:
 	slxsystem($cmd) unless $dryRun;
+	return;
 }
 
 sub writeSystemPXEFiles
@@ -488,6 +494,7 @@ sub writeSystemPXEFiles
 	  sprintf("initramfs-%d",
 		$vendorOSInitramfsMap{$info->{'vendor-os'}->{id}});
 	generateInitalRamFS($info, $pxeVendorOSPath);
+	return;
 }
 
 sub writeDhcpConfig
@@ -501,6 +508,7 @@ sub writeDhcpConfig
 	my $dhcpBackend = $dhcpModule->new();
 	my @clients     = $openslxDB->fetchClientByFilter();
 	$dhcpBackend->execute(\@clients);
+	return;
 }
 
 sub writeClientConfigurationsForSystem
@@ -563,6 +571,7 @@ sub writeClientConfigurationsForSystem
 				"$tftpbootPath/client-config/$info->{'external-id'}");
 		}
 	}
+	return;
 }
 
 sub writePluginConfigurationsForSystem
@@ -617,6 +626,7 @@ sub writePluginConfigurationsForSystem
 			);
 		}
 	}
+	return;
 }
 
 sub writeSystemConfiguration
@@ -648,6 +658,7 @@ sub writeSystemConfiguration
 	writeClientConfigurationsForSystem($info, $buildPath, $attrFile);
 
 	slxsystem("rm -rf $buildPath") unless $dryRun;
+	return;
 }
 
 sub writeConfigurations
@@ -673,6 +684,7 @@ sub writeConfigurations
 	if (defined $dhcpType) {
 		writeDhcpConfig();
 	}
+	return;
 }
 
 =head1 NAME