Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!uunet!convex!convex.COM
From: tchrist@convex.COM (Tom Christiansen)
Newsgroups: comp.lang.perl
Subject: Re: How to do alarm()?
Message-ID: <108017@convex.convex.com>
Date: 31 Oct 90 23:22:14 GMT
References: <CLIPPER.90Oct28162238@chan.csd.uwo.ca>
Sender: news@convex.com
Reply-To: tchrist@convex.COM (Tom Christiansen)
Organization: CONVEX Software Development, Richardson, TX
Lines: 169

In article <CLIPPER.90Oct28162238@chan.csd.uwo.ca> clipper@chan.csd.uwo.ca (Khun Yee Fung) writes:
>I have tried to do Perl's equivalence of alarm() on and off for two
>months now. I still don't know a good solution. I tried using
>syscall() but did not know how to get result back. I tried putting
>alarm() in perl myself but it did not work. Can somebody tell me how I
>can do alarm() or equivalent in Perl? Thank you very much. I don't
>want to use the usub feature.

I've posted this at least twice before.    Here's get and set itimer,
plus an alarm that groks floats.

--tom

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#	ttimer
#	itimers.pl
# This archive created: Wed Oct 31 15:13:29 1990
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'ttimer'" '(624 characters)'
if test -f 'ttimer'
then
	echo shar: "will not over-write existing file 'ttimer'"
else
sed 's/^	X//' << \SHAR_EOF > 'ttimer'
	X#!/usr/bin/perl
	X
	Xrequire 'itimers.pl';
	Xrequire 'ctime.pl';
	X
	X$| = 1;
	X
	X$SIG{'ALRM'} = 'bingo';
	X
	Xsub bingo {
	X    print "ALARM  @ ", &ctime(time);
	X    $hit++;
	X} 
	X
	Xprint "alarm 7 @ ", &ctime(time);
	X
	Xdo alarm(7);
	X
	Xprint "sleeping 2 seconds... ";
	X
	Xsleep 2;
	X
	Xprintf "alarm had %g secs left\n", &alarm(0);
	X
	Xprint "resetting to 1.25 seconds\n";
	X
	X&alarm(1.25);
	X
	Xdo { &timeleft; } until $hit; 
	X
	Xprint "escaped at \n\t", &ctime(time);
	X
	Xsub timeleft {
	X    local($timeleft);
	X    &getitimer(&ITIMER_REAL, $timeleft) || die "can't getitimer: $!";
	X    ($x, $y, $s, $u) = &itimer($timeleft);
	X    printf("timeleft is %g\n", $s + ($u / 1e6));
	X}
SHAR_EOF
if test 624 -ne "`wc -c < 'ttimer'`"
then
	echo shar: "error transmitting 'ttimer'" '(should have been 624 characters)'
fi
chmod 775 'ttimer'
fi
echo shar: "extracting 'itimers.pl'" '(2221 characters)'
if test -f 'itimers.pl'
then
	echo shar: "will not over-write existing file 'itimers.pl'"
else
sed 's/^	X//' << \SHAR_EOF > 'itimers.pl'
	X#	itimers.pl - timer manipulation functions
	X#	written by tom christiansen <tchrist@convex.com>
	X#
	X#	getitimer, setitimer  - like syscalls but return true on success
	X#				NB: require packed data for args
	X#
	X#	itimer		      - conversion function for packing and 
	X#				unpacking itimers.  packs in scalar context,
	X#				unpacks in array context.
	X#
	X#	alarm		      - like libc call but can take and returns floats
	X#
	X
	Xrequire 'sizeof.ph';
	Xrequire 'syscall.ph';
	Xrequire 'sys/time.ph';
	X
	X#
	X# careful: implementation dependent!
	X#
	X$itimer_t = 'L4';  # itimers consist of four longs
	X$sizeof{'itimer'} = '16' unless defined $sizeof{'itimer'};  # from sizeof.ph?
	X
	X###########################################################################
	X# itimer conversion function; this one goes both ways
	X#
	Xsub itimer {
	X    if (wantarray) {
	X	warn "itimer: only expected one arg in array context" if $#_;
	X	warn "itimer: itimer to unpack not length ".$sizeof{'itimer'} 
	X	    unless length($_[0]) == $sizeof{'itimer'};
	X	return unpack($itimer_t, $_[0]);
	X    } else {
	X	return pack($itimer_t, $_[0], $_[1], $_[2], $_[3]); 
	X    } 
	X} 
	X
	X
	X###########################################################################
	Xsub setitimer {
	X    local($which) = shift;
	X    local($retval);
	X
	X    die "setitimer: input itimer not length ".$sizeof{'itimer'} 
	X	unless length($_[0]) == $sizeof{'itimer'};
	X
	X    $_[1] = &itimer(0,0,0,0);
	X    syscall(&SYS_setitimer, $which, $_[0], $_[1]) != -1;
	X} 
	X
	X###########################################################################
	Xsub getitimer {
	X    local($which) = shift;
	X
	X    $_[0] = &itimer(0,0,0,0);
	X
	X    syscall(&SYS_getitimer, $which, $_[0]) != -1;
	X} 
	X
	X###########################################################################
	X# 
	X# alarm; send me a SIGALRM in this many seconds (fractions ok)
	X# 
	X#
	Xsub alarm {
	X    local($ticks) = @_;
	X    local($itimer,$otimer);
	X    local($isecs, $iusecs, $secs, $usecs);
	X
	X    $secs = int($ticks);
	X    $usecs = ($ticks - $secs) * 1e6;
	X
	X    $otimer = &itimer(0,0,0,0);
	X    $itimer = &itimer(0,0,$secs,$usecs);
	X
	X    &setitimer(&ITIMER_REAL, $itimer, $otimer) 
	X	|| warn "alarm: setitimer failed: $!";
	X
	X    ($isecs, $iusecs, $secs, $usecs) = &itimer($otimer);
	X    return $secs + ($usecs/1e6);
	X} 
SHAR_EOF
if test 2221 -ne "`wc -c < 'itimers.pl'`"
then
	echo shar: "error transmitting 'itimers.pl'" '(should have been 2221 characters)'
fi
chmod 664 'itimers.pl'
fi
exit 0
#	End of shell archive