* implemented a simple registration mechanism for cleanup functions in order to

  improve the reliability of cleaning up in case of user interrupts

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

1 files changed, 32 insertions, 0 deletions

diff --git a/lib/OpenSLX/Basics.pm b/lib/OpenSLX/Basics.pm
index 998e7982..e723c431 100644
--- a/lib/OpenSLX/Basics.pm
+++ b/lib/OpenSLX/Basics.pm
@@ -26,6 +26,7 @@ $VERSION = 1.01;
 	&warn &die &executeInSubprocess &slxsystem
 	&vlog
 	&instantiateClass
+	&addCleanupFunction &removeCleanupFunction
 );
 
 use vars qw(%openslxConfig %cmdlineConfig);
@@ -135,6 +136,8 @@ my %openslxCmdlineArgs = (
 		# level of logging verbosity (0-3)
 );
 
+my %cleanupFunctions;
+
 # filehandle used for logging:
 my $openslxLog = *STDERR;
 
@@ -321,6 +324,33 @@ sub executeInSubprocess
 }
 
 # ------------------------------------------------------------------------------
+sub addCleanupFunction
+{
+	my $name = shift;
+	my $func = shift;
+
+	$cleanupFunctions{$name} = $func;
+}
+
+# ------------------------------------------------------------------------------
+sub removeCleanupFunction
+{
+	my $name = shift;
+
+	delete $cleanupFunctions{$name};
+}
+
+# ------------------------------------------------------------------------------
+sub invokeCleanupFunctions
+{
+	my @funcNames = keys %cleanupFunctions;
+	foreach my $name (@funcNames) {
+		vlog 2, "invoking cleanup function '$name'...";
+		$cleanupFunctions{$name}->();
+	}
+}
+
+# ------------------------------------------------------------------------------
 sub slxsystem
 {
 	vlog 2, _tr("executing: %s", join ' ', @_);
@@ -350,6 +380,8 @@ sub warn
 # ------------------------------------------------------------------------------
 sub die
 {
+	invokeCleanupFunctions();
+
 	my $msg = shift;
 	$msg =~ s[^\*\*\* ][]igms;
 	$msg =~ s[^][*** ]igms;