diff options
Diffstat (limited to 'lib/OpenSLX')
-rw-r--r-- | lib/OpenSLX/Basics.pm | 68 | ||||
-rw-r--r-- | lib/OpenSLX/ScopedResource.pm | 91 |
2 files changed, 100 insertions, 59 deletions
diff --git a/lib/OpenSLX/Basics.pm b/lib/OpenSLX/Basics.pm index 230bf72b..9af056e6 100644 --- a/lib/OpenSLX/Basics.pm +++ b/lib/OpenSLX/Basics.pm @@ -30,12 +30,10 @@ $VERSION = 1.01; &vlog &checkParams &instantiateClass - &addCleanupFunction &removeCleanupFunction ); our (%openslxConfig, %cmdlineConfig, %openslxPath); -use sigtrap qw( die normal-signals error-signals ); use subs qw(die warn); use open ':utf8'; @@ -139,8 +137,6 @@ my %openslxCmdlineArgs = ( 'verbose-level=i' => \$cmdlineConfig{'verbose-level'}, ); -my %cleanupFunctions; - # filehandle used for logging: my $openslxLog = *STDERR; @@ -313,27 +309,20 @@ sub callInSubprocess my $pid = fork(); if (!$pid) { - - # child... - # ...execute the given function and exit: - my $ok = eval { $childFunc->(); 1 }; - if (!$ok) { - print STDERR "*** $@"; - exit 5; - } + # child -> execute the given function and exit: + eval { $childFunc->(); 1 } + or die $@; exit 0; } - # parent... - # ...pass on interrupt- and terminate-signals to child... - local $SIG{INT} = sub { kill 'INT', $pid; waitpid($pid, 0); exit $? }; - local $SIG{TERM} = sub { kill 'TERM', $pid; waitpid($pid, 0); exit $? }; + # parent -> pass on interrupt- and terminate-signals to child ... + $SIG{INT} = sub { kill 'INT', $pid; }; + $SIG{TERM} = sub { kill 'TERM', $pid; }; - # ...and wait for child to do its work: + # ... and wait until child has done its work waitpid($pid, 0); - if ($?) { - exit $?; - } + exit $? if $?; + return; } @@ -355,36 +344,6 @@ sub executeInSubprocess } # ------------------------------------------------------------------------------ -sub addCleanupFunction -{ - my $name = shift; - my $func = shift; - - $cleanupFunctions{$name} = $func; - return; -} - -# ------------------------------------------------------------------------------ -sub removeCleanupFunction -{ - my $name = shift; - - delete $cleanupFunctions{$name}; - return; -} - -# ------------------------------------------------------------------------------ -sub invokeCleanupFunctions -{ - my @funcNames = keys %cleanupFunctions; - foreach my $name (@funcNames) { - vlog(2, "invoking cleanup function '$name'..."); - $cleanupFunctions{$name}->(); - } - return; -} - -# ------------------------------------------------------------------------------ sub slxsystem { vlog(2, _tr("executing: %s", join ' ', @_)); @@ -426,7 +385,6 @@ sub warn # ------------------------------------------------------------------------------ sub confess { - invokeCleanupFunctions(); _doThrowOrWarn('confess', @_); return; } @@ -434,7 +392,6 @@ sub confess # ------------------------------------------------------------------------------ sub croak { - invokeCleanupFunctions(); _doThrowOrWarn('croak', @_); return; } @@ -442,7 +399,6 @@ sub croak # ------------------------------------------------------------------------------ sub die { - invokeCleanupFunctions(); _doThrowOrWarn('die', @_); return; } @@ -636,10 +592,4 @@ sub instantiateClass return $class->new; } -# ------------------------------------------------------------------------------ -END -{ - invokeCleanupFunctions() if %cleanupFunctions; -} - 1; diff --git a/lib/OpenSLX/ScopedResource.pm b/lib/OpenSLX/ScopedResource.pm new file mode 100644 index 00000000..c905b50a --- /dev/null +++ b/lib/OpenSLX/ScopedResource.pm @@ -0,0 +1,91 @@ +# Copyright (c) 2008 - OpenSLX GmbH +# +# This program is free software distributed under the GPL version 2. +# See http://openslx.org/COPYING +# +# If you have any feedback please consult http://openslx.org/feedback and +# send your suggestions, praise, or complaints to feedback@openslx.org +# +# General information about OpenSLX can be found at http://openslx.org/ +# ----------------------------------------------------------------------------- +# ScopedResource.pm +# - a helper class that releases resources if the object leaves scope +# ----------------------------------------------------------------------------- +package OpenSLX::ScopedResource; + +use strict; +use warnings; + +our $VERSION = 1.01; # API-version . implementation-version + +# make sure that we catch any signals in order to properly released scoped +# resources +use sigtrap qw( die normal-signals error-signals ); + +use OpenSLX::Basics; + +sub new +{ + my $class = shift; + my $params = shift; + + checkParams($params, { + name => '!', + acquire => '!', + release => '!', + }); + + my $self = { + name => $params->{name}, + owner => 0, + acquire => $params->{acquire}, + release => $params->{release}, + }; + + bless $self, $class; + + $self->acquire(); + + return $self; +} + +sub acquire +{ + my $self = shift; + + # acquire the resource and set ourselves as owner + if ($self->{acquire}->()) { + vlog(1, "process $$ acquired resource $self->{name}"); + $self->{owner} = $$; + } +} + +sub release +{ + my $self = shift; + + # only release the resource if invoked by the owning process + vlog(3, "process $$ tries to release resource $self->{name}"); + return if $self->{owner} != $$; + + # release the resource and unset owner + if ($self->{release}->()) { + vlog(1, "process $$ released resource $self->{name}"); + $self->{owner} = 0; + } +} + +sub DESTROY +{ + my $self = shift; + + $self->release(); + + # remove references to functions, in order to release any closures + $self->{acquire} = undef; + $self->{release} = undef; + + return; +} + +1; |