* 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

5 files changed, 233 insertions, 130 deletions

diff --git a/lib/OpenSLX/Basics.pm b/lib/OpenSLX/Basics.pm
index e675ee52..1624727c 100644
--- a/lib/OpenSLX/Basics.pm
+++ b/lib/OpenSLX/Basics.pm
@@ -14,7 +14,9 @@
 package OpenSLX::Basics;
 
 use strict;
-use vars qw(@ISA @EXPORT $VERSION);
+use warnings;
+
+our (@ISA, @EXPORT, $VERSION);
 
 use Exporter;
 $VERSION = 1.01;
@@ -23,31 +25,32 @@ $VERSION = 1.01;
 @EXPORT = qw(
   &openslxInit %openslxConfig %cmdlineConfig
   &_tr &trInit
-  &warn &die
+  &warn &die &croak &carp &confess &cluck
   &callInSubprocess &executeInSubprocess &slxsystem
   &vlog
   &instantiateClass
   &addCleanupFunction &removeCleanupFunction
 );
 
-use vars qw(%openslxConfig %cmdlineConfig %openslxPath);
-use subs qw(die);
+our (%openslxConfig, %cmdlineConfig, %openslxPath);
+
+use subs qw(die warn);
 
 ################################################################################
 ### Module implementation
 ################################################################################
-use Carp;
-use
-  Carp::Heavy; # use it here to have it loaded immediately, not at 
-               # the time when carp() is being invoked (which might
-               # be at a point in time where the script executes in
-               # a chrooted environment, such that the module can't
-               # be loaded anymore).
+require Carp;		# do not import anything as we are going to overload carp
+					# and croak!
+use Carp::Heavy;    # use it here to have it loaded immediately, not at
+                    # the time when carp() is being invoked (which might
+                    # be at a point in time where the script executes in
+                    # a chrooted environment, such that the module can't
+                    # be loaded anymore).
 use FindBin;
 use Getopt::Long;
 use POSIX qw(locale_h);
 
-my %translations;
+my $translations;
 
 # this hash will hold the active openslx configuration,
 # the initial content is based on environment variables or default values.
@@ -80,6 +83,7 @@ chomp($openslxConfig{'locale-charmap'});
 
 # specification of cmdline arguments that are shared by all openslx-scripts:
 my %openslxCmdlineArgs = (
+
 	# name of database, defaults to 'openslx'
 	'db-name=s' => \$cmdlineConfig{'db-name'},
 
@@ -124,6 +128,8 @@ my %cleanupFunctions;
 # filehandle used for logging:
 my $openslxLog = *STDERR;
 
+$Carp::CarpLevel = 3;
+
 # ------------------------------------------------------------------------------
 sub vlog
 {
@@ -147,14 +153,16 @@ sub openslxInit
 	my $configPath = $cmdlineConfig{'config-path'}
 	  || $openslxConfig{'config-path'};
 	my $sharePath = "$openslxConfig{'base-path'}/share";
+	my $configFH;
+	my $verboseLevel = $cmdlineConfig{'verbose-level'} || 0;
 	foreach my $f ("$sharePath/settings.default", "$configPath/settings",
 		"$ENV{HOME}/.openslx/settings")
 	{
-		next unless open(CONFIG, "<$f");
-		if ($cmdlineConfig{'verbose-level'} >= 2) {
+		next unless open($configFH, '<', $f);
+		if ($verboseLevel >= 2) {
 			vlog(0, "reading config-file $f...");
 		}
-		while (<CONFIG>) {
+		while (<$configFH>) {
 			chomp;
 			s/#.*//;
 			s/^\s+//;
@@ -176,7 +184,7 @@ sub openslxInit
 			$key =~ tr/[A-Z]_/[a-z]-/;
 			$openslxConfig{$key} = $value;
 		}
-		close CONFIG;
+		close $configFH;
 	}
 
 	# push any cmdline argument into our config hash, possibly overriding any
@@ -186,10 +194,14 @@ sub openslxInit
 		$openslxConfig{$key} = $val;
 	}
 
-	if (defined $openslxConfig{'logfile'}
-		&& open(LOG, ">>$openslxConfig{'logfile'}"))
-	{
-		$openslxLog = *LOG;
+	if (defined $openslxConfig{'logfile'}) {
+		open($openslxLog, '>>', $openslxConfig{'logfile'})
+		  or croak(
+			_tr(
+				"unable to append to logfile '%s'! (%s)",    
+				$openslxConfig{'logfile'}, $!
+			)
+		  );
 	}
 	if ($openslxConfig{'verbose-level'} >= 2) {
 		foreach my $k (sort keys %openslxConfig) {
@@ -206,8 +218,9 @@ sub openslxInit
 # ------------------------------------------------------------------------------
 sub trInit
 {
+
 	# set the specified locale...
-	setlocale('LC_ALL', $openslxConfig{'locale'});
+	setlocale(LC_ALL, $openslxConfig{'locale'});
 
 	# ...and activate automatic charset conversion on all I/O streams:
 	binmode(STDIN,  ":encoding($openslxConfig{'locale-charmap'})");
@@ -223,6 +236,7 @@ sub trInit
 	}
 
 	if (lc($locale) ne 'posix') {
+
 		# parse locale and canonicalize it (e.g. to 'de_DE') and generate
 		# two filenames from it (language+country and language only):
 		if ($locale !~ m{^\s*([^_]+)(?:_(\w+))?}) {
@@ -238,17 +252,13 @@ sub trInit
 		# specific one [language+country]):
 		my $loadedTranslationModule;
 		foreach my $trName (@locales) {
-			my $trModule = "OpenSLX::Translations::$trName";
-			if (eval "require $trModule") {
-				# Access OpenSLX::Translations::<locale>::translations
-				# via a symbolic reference...
-				no strict 'refs';
-				my $translationsRef = \%{"${trModule}::translations"};
-
-				# ...and copy the available translations into our hash:
-				foreach my $k (keys %{$translationsRef}) {
-					$translations{$k} = $translationsRef->{$k};
-				}
+			vlog(2,	"trying to load translation module $trName...");
+			my $trModule = "OpenSLX/Translations/$trName.pm";
+			my $trModuleSpec = "OpenSLX::Translations::$trName";
+			if (eval { require $trModule } ) {
+				# copy the translations available in the given locale into our 
+				# hash:
+				$translations = $trModuleSpec->getAllTranslations();
 				$loadedTranslationModule = $trModule;
 				vlog(
 					1,
@@ -276,7 +286,10 @@ sub _tr
 	$trKey =~ s[\n][\\n]g;
 	$trKey =~ s[\t][\\t]g;
 
-	my $formatStr = $translations{$trKey};
+	my $formatStr;
+	if (defined $translations) {
+		$formatStr = $translations->{$trKey};
+	}
 	if (!defined $formatStr) {
 		$formatStr = $trOrig;
 	}
@@ -290,6 +303,7 @@ sub callInSubprocess
 
 	my $pid = fork();
 	if (!$pid) {
+
 		# child...
 		# ...execute the given function and exit:
 		&$childFunc();
@@ -315,6 +329,7 @@ sub executeInSubprocess
 
 	my $pid = fork();
 	if (!$pid) {
+
 		# child...
 		# ...exec the given cmdline:
 		exec(@cmdlineArgs);
@@ -357,6 +372,7 @@ sub slxsystem
 	vlog(2, _tr("executing: %s", join ' ', @_));
 	my $res = system(@_);
 	if ($res > 0) {
+
 		# check if child got killed, if so we stop, too (unless the signal is
 		# SIGPIPE, which we ignore in order to loop over failed FTP connections
 		# and the like):
@@ -371,32 +387,77 @@ sub slxsystem
 }
 
 # ------------------------------------------------------------------------------
+sub cluck
+{
+	_doThrowOrWarn('cluck', @_);
+}
+
+# ------------------------------------------------------------------------------
+sub carp
+{
+	_doThrowOrWarn('carp', @_);
+}
+
+# ------------------------------------------------------------------------------
 sub warn
 {
-	my $msg = shift;
-	$msg =~ s[^\*\*\* ][]igms;
-	$msg =~ s[^][*** ]igms;
-	if ($openslxConfig{'debug-confess'}) {
-		Carp::cluck $msg;
-	} else {
-		chomp $msg;
-		CORE::warn "$msg\n";
-	}
+	_doThrowOrWarn('warn', @_);
+}
+
+# ------------------------------------------------------------------------------
+sub confess
+{
+	invokeCleanupFunctions();
+	_doThrowOrWarn('confess', @_);
+}
+
+# ------------------------------------------------------------------------------
+sub croak
+{
+	invokeCleanupFunctions();
+	_doThrowOrWarn('croak', @_);
 }
 
 # ------------------------------------------------------------------------------
 sub die
 {
 	invokeCleanupFunctions();
+	_doThrowOrWarn('die', @_);
+}
 
+# ------------------------------------------------------------------------------
+sub _doThrowOrWarn
+{
+	my $type = shift;
 	my $msg = shift;
+	
 	$msg =~ s[^\*\*\* ][]igms;
 	$msg =~ s[^][*** ]igms;
+
 	if ($openslxConfig{'debug-confess'}) {
-		confess $msg;
-	} else {
+		my %functionFor = (
+			'carp' => sub { Carp::cluck @_ },
+			'cluck' => sub { Carp::cluck @_ },
+			'confess' => sub { Carp::confess @_ },
+			'croak' => sub { Carp::confess @_ },
+			'die' => sub { Carp::confess @_ },
+			'warn' => sub { Carp::cluck @_ },
+		);
+		my $func = $functionFor{$type};
+		$func->($msg);
+	}
+	else {
 		chomp $msg;
-		CORE::die "$msg\n";
+		my %functionFor = (
+			'carp' => sub { Carp::carp @_ },
+			'cluck' => sub { Carp::cluck @_ },
+			'confess' => sub { Carp::confess @_ },
+			'croak' => sub { Carp::croak @_ },
+			'die' => sub { CORE::die @_},
+			'warn' => sub { CORE::warn @_ },
+		);
+		my $func = $functionFor{$type};
+		$func->("$msg\n");
 	}
 }
 
@@ -406,11 +467,15 @@ sub instantiateClass
 	my $class            = shift;
 	my $requestedVersion = shift;
 
-	unless (eval "require $class") {
+	my $moduleName = $class;
+	$moduleName =~ s[::][/]g;
+	$moduleName .= '.pm';
+	unless (eval { require $moduleName } ) {
 		if ($! == 2) {
-			die _tr("Class <%s> not found!\n", $class);
-		} else {
-			die _tr("Unable to load class <%s> (%s)\n", $class, $@);
+			die _tr("Module <%s> not found!\n", $moduleName);
+		}
+		else {
+			die _tr("Unable to load module <%s> (%s)\n", $moduleName, $@);
 		}
 	}
 	if (defined $requestedVersion) {
diff --git a/lib/OpenSLX/ConfigFolder.pm b/lib/OpenSLX/ConfigFolder.pm
index 0c957ef5..de2df73f 100644
--- a/lib/OpenSLX/ConfigFolder.pm
+++ b/lib/OpenSLX/ConfigFolder.pm
@@ -14,7 +14,9 @@
 package OpenSLX::ConfigFolder;
 
 use strict;
-use vars qw(@ISA @EXPORT $VERSION);
+use warnings;
+
+our (@ISA, @EXPORT, $VERSION);
 
 use Exporter;
 $VERSION = 1.01;
@@ -30,6 +32,7 @@ $VERSION = 1.01;
 ################################################################################
 use Carp;
 use OpenSLX::Basics;
+use OpenSLX::Utils;
 
 sub createConfigFolderForDefaultSystem
 {
@@ -47,29 +50,22 @@ sub createConfigFolderForDefaultSystem
 	# create default pre-/postinit scripts for us in initramfs:
 	my $preInitFile = "$defaultConfigPath/initramfs/preinit.local";
 	if (!-e $preInitFile) {
-		open(PREINIT, "> $preInitFile")
-			or die _tr("Unable to create file '%s'!", $preInitFile);
-		my $preInit = <<'			END'
+		my $preInit = unshiftHereDoc(<<'			END-of-HERE');
 			#!/bin/sh
 			#
 			# This script allows the local admin to extend the
 			# capabilities at the beginning of the initramfs (stage3).
 			# The toolset is rather limited and you have to keep in mind 
 			# that stage4 rootfs has the prefix '/mnt'.
-			END
-			;
-		$preInit =~ s[^\s+][]igms;
-		print PREINIT $preInit;
-		close(PREINIT);
+			END-of-HERE
+		spitFile($preInitFile, $preInit);
 		slxsystem("chmod u+x $preInitFile");
 		$result = 1;
 	}
 
 	my $postInitFile = "$defaultConfigPath/initramfs/postinit.local";
 	if (!-e $postInitFile) {
-		open(POSTINIT, "> $postInitFile")
-			or die _tr("Unable to create file '%s'!", $postInitFile);
-		my $postInit = <<'			END'
+		my $postInit = unshiftHereDoc(<<'			END-of-HERE');
 			#!/bin/sh
 			#
 			# This script allows the local admin to extend the
@@ -78,11 +74,8 @@ sub createConfigFolderForDefaultSystem
 			# that stage4 rootfs has the prefix '/mnt'.
 			# But you may use some special slx-functions available via
 			# inclusion: '. /etc/functions' ...
-			END
-			;
-		$postInit =~ s[^\s+][]igms;
-		print POSTINIT $postInit;
-		close(POSTINIT);
+			END-of-HERE
+		spitFile($postInitFile, $postInit);
 		slxsystem("chmod u+x $postInitFile");
 		$result = 1;
 	}
diff --git a/lib/OpenSLX/Translations/de.pm b/lib/OpenSLX/Translations/de.pm
index 081e44e4..e98edd03 100644
--- a/lib/OpenSLX/Translations/de.pm
+++ b/lib/OpenSLX/Translations/de.pm
@@ -14,15 +14,20 @@
 package OpenSLX::Translations::de;
 
 use strict;
-use vars qw(@ISA @EXPORT $VERSION);
+use warnings;
 
-use Exporter;
-$VERSION = 0.02;
-@ISA = qw(Exporter);
+our $VERSION = 0.02;
 
-@EXPORT = qw(%translations);
+my %translations;
 
-use vars qw(%translations);
+################################################################################
+### Implementation
+################################################################################
+sub getAllTranslations
+{
+	my $class = shift;
+	return \%translations;
+}
 
 ################################################################################
 ### Translations
@@ -352,12 +357,3 @@ use vars qw(%translations);
 );
 
 1;
-
-
-
-
-
-
-
-
-
diff --git a/lib/OpenSLX/Translations/posix.pm b/lib/OpenSLX/Translations/posix.pm
index e1199f47..05e16ed5 100644
--- a/lib/OpenSLX/Translations/posix.pm
+++ b/lib/OpenSLX/Translations/posix.pm
@@ -14,15 +14,20 @@
 package OpenSLX::Translations::posix;
 
 use strict;
-use vars qw(@ISA @EXPORT $VERSION);
+use warnings;
 
-use Exporter;
-$VERSION = 0.02;
-@ISA = qw(Exporter);
+our $VERSION = 0.02;
 
-@EXPORT = qw(%translations);
+my %translations;
 
-use vars qw(%translations);
+################################################################################
+### Implementation
+################################################################################
+sub getAllTranslations
+{
+	my $class = shift;
+	return \%translations;
+}
 
 ################################################################################
 ### Translations
@@ -351,18 +356,4 @@ use vars qw(%translations);
 
 );
 
-
-
-
-
 1;
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/OpenSLX/Utils.pm b/lib/OpenSLX/Utils.pm
index 6dbd0e7c..4d11e702 100644
--- a/lib/OpenSLX/Utils.pm
+++ b/lib/OpenSLX/Utils.pm
@@ -18,10 +18,10 @@ use vars qw(@ISA @EXPORT $VERSION);
 
 use Exporter;
 $VERSION = 1.01;
-@ISA = qw(Exporter);
+@ISA     = qw(Exporter);
 
 @EXPORT = qw(
-	&copyFile &fakeFile &linkFile &slurpFile &followLink
+  copyFile fakeFile linkFile slurpFile spitFile followLink unshiftHereDoc
 );
 
 ################################################################################
@@ -34,73 +34,131 @@ use OpenSLX::Basics;
 
 sub copyFile
 {
-	my $fileName = shift;
-	my $targetDir = shift;
+	my $fileName       = shift || croak 'need to pass in a fileName!';
+	my $targetDir      = shift || croak 'need to pass in target dir!';
 	my $targetFileName = shift || '';
 
-	system("mkdir -p $targetDir") 	unless -d $targetDir;
+	system("mkdir -p $targetDir") unless -d $targetDir;
 	my $target = "$targetDir/$targetFileName";
 	vlog(2, _tr("copying '%s' to '%s'", $fileName, $target));
 	if (system("cp -p $fileName $target")) {
-		die _tr("unable to copy file '%s' to dir '%s' (%s)",
-				$fileName, $target, $!);
+		croak(
+			_tr(
+				"unable to copy file '%s' to dir '%s' (%s)",
+				$fileName, $target, $!
+			)
+		);
 	}
+	return;
 }
 
 sub fakeFile
 {
-	my $fullPath = shift;
+	my $fullPath = shift || croak 'need to pass in full path!';
 
 	my $targetDir = dirname($fullPath);
-	system("mkdir", "-p", $targetDir) 	unless -d $targetDir;
+	system("mkdir", "-p", $targetDir) unless -d $targetDir;
 	if (system("touch", $fullPath)) {
-		die _tr("unable to create file '%s' (%s)",
-				$fullPath, $!);
+		croak(_tr("unable to create file '%s' (%s)", $fullPath, $!));
 	}
+	return;
 }
 
 sub linkFile
 {
-	my $linkTarget = shift;
-	my $linkName = shift;
+	my $linkTarget = shift || croak 'need to pass in link target!';
+	my $linkName   = shift || croak 'need to pass in link name!';
 
 	my $targetDir = dirname($linkName);
-	system("mkdir -p $targetDir") 	unless -d $targetDir;
+	system("mkdir -p $targetDir") unless -d $targetDir;
 	if (system("ln -sfn $linkTarget $linkName")) {
-		die _tr("unable to create link '%s' to '%s' (%s)",
-				$linkName, $linkTarget, $!);
+		croak(
+			_tr(
+				"unable to create link '%s' to '%s' (%s)",
+				$linkName, $linkTarget, $!
+			)
+		);
 	}
+	return;
+}
+
+sub checkFlags
+{
+	my $flags = shift || confess 'need to pass in flags-hashref!';
+	my $knownFlags  = shift || confess 'need to pass in knownFlags-arrayref!';
+
+	my %known;
+	@known{@$knownFlags} = ();
+	foreach my $flag (keys %$flags) {
+		next if exists $known{$flag};
+		cluck("flag '$flag' not known!");
+	}
+	return;
 }
 
 sub slurpFile
 {
-	my $file = shift;
-	my $mayNotExist = shift;
+	my $fileName = shift || confess 'need to pass in fileName!';
+	my $flags    = shift || {};
+
+	checkFlags($flags, ['failIfMissing']);
+	my $failIfMissing 
+		= exists $flags->{failIfMissing} ? $flags->{failIfMissing} : 1;
 
-	if (!open(F, "< $file") && !$mayNotExist) {
-		die _tr("could not open file '%s' for reading! (%s)", $file, $!);
+	local $/;
+	my $fh;
+	if (!open($fh, '<', $fileName)) {
+		return '' unless $failIfMissing;
+		croak _tr("could not open file '%s' for reading! (%s)", $fileName, $!);
 	}
-	local $/ = undef;
-	my $text = <F>;
-	close(F);
-	return $text;
+	my $content = <$fh>;
+	close($fh)
+	  or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!);
+	return $content;
+}
+
+sub spitFile
+{
+	my $fileName = shift || croak 'need to pass in a fileName!';
+	my $content  = shift;
+
+	my $fh;
+	open($fh, '>', $fileName)
+	  or croak _tr("unable to create file '%s' (%s)\n", $fileName, $!);
+	print $fh $content
+	  or croak _tr("unable to print to file '%s' (%s)\n", $fileName, $!);
+	close($fh)
+	  or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!);
+	return;
 }
 
 sub followLink
 {
-	my $path = shift;
+	my $path         = shift || croak 'need to pass in a path!';
 	my $prefixedPath = shift || '';
-	
+
 	my $target;
 	while (-l "$path") {
 		$target = readlink "$path";
 		if (substr($target, 1, 1) eq '/') {
 			$path = "$prefixedPath/$target";
-		} else {
-			$path = $prefixedPath.dirname($path).'/'.$target;
+		}
+		else {
+			$path = $prefixedPath . dirname($path) . '/' . $target;
 		}
 	}
 	return $path;
 }
 
-1;
\ No newline at end of file
+sub unshiftHereDoc
+{
+	my $content = shift;
+	return $content unless $content =~ m{^(\s+)};
+	my $shift = length($1);
+	return 
+		join "\n", 
+		map { substr($_, $shift); } 
+		split m{\n}, $content;
+}
+
+1;