Article 8623 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:8623
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!spool.mu.edu!olivea!hal.com!parlo.hal.COM!not-for-mail
From: paul@hal.COM (Paul Sander)
Newsgroups: comp.lang.perl
Subject: Re: Critical regions or sighold & sigrelse
Date: 3 Dec 1993 17:36:04 -0800
Organization: HaL Computer Systems, Inc.
Lines: 285
Message-ID: <2dopi4$dsp@parlo.hal.COM>
References: <fop.754856337@teal>
NNTP-Posting-Host: parlo.hal.com
Keywords: signals sighold sigrelese critical

In article <fop.754856337@teal> fop@teal.csn.org (J. Gabriel Foster) writes:
>Hello,
>	I am implementing a simple spooling daemon with perl, and I need
>to be able to create some sections of code that cannot be interrupted by
>signals,  but I don't want to lose those signals.  sighold and sigrelse
>seem to fit the bill from a C standpoint, but they are not implemented in
>perl that I can see.   Any clues on how to do this?

Here is what I use.

---------

# This file contains simple signal handler code.  The client can register
# commands to be executed when HUP, INT, QUIT, or TERM signals are received,
# and also enter and exit critical sections (which can be nested).  Registered
# signal handlers are kept in a stack and are removed in the reverse order from
# which they were registered.  After a signal is received, the handlers are
# invoked in the reverse order in which they were registered, and then the
# program exits with a status code determined by the client (or with the
# die operator if the code is left unset).  Handlers are invoked in the same
# package that was set when they were registered.  Signals received while a
# critical section is active are postponed until the critical section ends.

# Public interfaces (all in the "main" package):
# &beginCrSect       -- Begins critical section, returning undef.
# &endCrSect         -- Ends critical section, returning undef.
# &pushHandler($cmd) -- Registers $cmd to be invoked when a signal is
#                       received; pushes the handler onto the handler stack.
#                       $cmd is invoked in the package that was active when
#                       it was registered.  Returns undef.
# &popHandler        -- Pops a handler off of the handler stack.  Returns
#                       ($package, $command), where $package is the package
#                       that was active when the handler was pushed, and
#                       $command is the command passed to &pushHandler.
# &setSigCode($code) -- Sets the exit code used when the process terminates
#                       after executing registered signal handlers.  $code
#                       must be between 0 and 255, inclusive.  Returns 1 if
#                       successful, 0 otherwise.

package SigHandle;

if ( ! defined $sighandle_loaded )
{
	$sighandle_loaded = 1;

	if ( ! defined $debugging )
	{
		$debugging = 0;
	}
	if ( $debugging )
	{
		print STDERR "Initializing sighandle.pl\n";
	}
	$crNesting = 0;
	$gotSignal = 0;
	$acceptSignal = 1;
	@handlers = ( );
	$exitCode = -1;
	$SIG{"HUP"} = "SigHandle'terminate";
	$SIG{"INT"} = "SigHandle'terminate";
	$SIG{"QUIT"} = "SigHandle'terminate";
	$SIG{"TERM"} = "SigHandle'terminate";

#-----------------------------------------------

# Begin critical section

sub main'beginCrSect
{
	if ($crNesting == 0)
	{
		if ( $acceptSignal )
		{
			if ( $debugging )
			{
				print STDERR "Entering critical section\n";
			}
			$SIG{"HUP"} = "SigHandle'queueSignal";
			$SIG{"INT"} = "SigHandle'queueSignal";
			$SIG{"QUIT"} = "SigHandle'queueSignal";
			$SIG{"TERM"} = "SigHandle'queueSignal";
		}
		elsif ( $debugging )
		{
			print STDERR "Entering critical section inside handler\n";
		}
	}
	elsif ( $debugging )
	{
		print STDERR "Entering nested critical section\n";
	}
	$crNesting++;
	return undef;
}

#-----------------------------------------------

# End critical section

sub main'endCrSect
{
	if ( $crNesting > 0 )
	{
		$crNesting--;
	}
	if ($crNesting == 0)
	{

		if ( $gotSignal )
		{
			$acceptSignal = 0;
			$gotSignal = 0;
			print STDERR "Interrupted during critical section, ";
			print STDERR "terminating...\n";
			&runHandlers;
			&suicide;
		}
		if ( $acceptSignal )
		{
			if ( $debugging )
			{
				print STDERR "Exiting critical section\n";
			}
			$SIG{"HUP"} = "SigHandle'terminate";
			$SIG{"INT"} = "SigHandle'terminate";
			$SIG{"QUIT"} = "SigHandle'terminate";
			$SIG{"TERM"} = "SigHandle'terminate";
		}
		elsif ( $debugging )
		{
			print STDERR "Exiting critical section in handler\n";
		}

	}
	elsif ( $debugging )
	{
		print STDERR "Exiting nested critical section\n";
	}
	return undef;
}

#-----------------------------------------------

sub runHandlers
{
	local($this,$pkg,$cmd,$str);

	$this = pop(@handlers);
	while ( $this ne "" )
	{
		( $pkg, $cmd ) = split(/ /,$this,2);
		if ( $debugging )
		{
			print STDERR "Invoking pkg $pkg cmd $cmd\n";
		}
		$str = join(" ","package $pkg;", $cmd);
		eval($str);
		if ( $@ ne "" )
		{
			print STDERR "Error invoking $str\n";
			print STDERR "$@\n";
		}
		$this = pop(@handlers);
	}
}

#-----------------------------------------------

# Exits the process

sub suicide
{
	if ( $exitCode >= 0 )
	{
		exit $exitCode;
	}
	else
	{
		exit 255;
	}
}

#-----------------------------------------------

# Run handlers and terminate after receiving signal

sub terminate
{
	print STDERR "Signal received, cleaning up...\n";
	$SIG{"HUP"} = "SigHandle'queueSignal";
	$SIG{"INT"} = "SigHandle'queueSignal";
	$SIG{"QUIT"} = "SigHandle'queueSignal";
	$SIG{"TERM"} = "SigHandle'queueSignal";
	$acceptSignal = 0;
	$gotSignal = 0;
	&runHandlers;
	&suicide;
}

#-----------------------------------------------

# Signal handler; records a signal if it comes in during a critical
# section.

sub queueSignal
{
	if ( $acceptSignal )
	{
		if ( $debugging )
		{
			print STDERR "Received signal in critical section, deferred\n";
		}
		$gotSignal = 1;
	}
	else
	{
		print STDERR "Received signal during handler, ignored\n";
	}
}

#-----------------------------------------------

sub main'pushHandler
{
	local($cmd) = @_;
	local($pkg,$handler);

	( $pkg ) = caller(0);
	if ( $debugging )
	{
		print STDERR "Pushing handler pkg $pkg cmd $cmd\n";
	}
	&main'beginCrSect;
	$handler = join(" ",$pkg,$cmd);
	push(@handlers,$handler);
	&main'endCrSect;
	return undef;
}

#-----------------------------------------------

sub main'popHandler
{
	local($pkg,$cmd);

	&main'beginCrSect;
	( $pkg, $cmd) = split(/ /,pop(@handlers),2);
	&main'endCrSect;
	if ( $debugging )
	{
		print STDERR "Popping handler pkg $pkg cmd $cmd\n";
	}
	return "$pkg $cmd";
}

#-----------------------------------------------

sub main'setSigCode
{
	local($code) = @_;

	if ( ( $code >= 0 ) && ( $code <= 255 ) )
	{
		$exitCode = $code;
		return 1;
	}
	else
	{
		return 0;
	}
}

#-----------------------------------------------

}
elsif ( $debugging )
{
	print STDERR "sighandle.pl was required multiple times.\n";
}
1;
-- 
Paul M. Sander  (408) 379-7000  |  "If everything were easy, where would be
HaL Computer Systems, Inc.      |   the challenge?"
1315 Dell Avenue                |
Campbell, CA  95008  USA        |