news.utdallas.edu!wupost!howland.reston.ans.net!agate!dog.ee.lbl.gov!network.ucsd.edu!news.acns.nwu.edu!ftpbox!cssmp.corp.mot.com!mmuegel Thu Feb 25 11:53:18 CST 1993
Article: 1098 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1098
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!wupost!howland.reston.ans.net!agate!dog.ee.lbl.gov!network.ucsd.edu!news.acns.nwu.edu!ftpbox!cssmp.corp.mot.com!mmuegel
From: mmuegel@cssmp.corp.mot.com (Michael S. Muegel)
#Subject: Re: SUMMARY: Timeout on Connect
Message-ID: <1993Feb18.090607.25547@ftpbox.mot.com>
Keywords: Summary, sockets, connect, timeouts
Sender: news@ftpbox.mot.com (C News)
Organization: Corporate Information Office, Schaumburg, Illinois, Motorola, Inc.
References: <1luq98INN7di@gap.caltech.edu> <1993Feb18.040748.27347@news.eng.convex.com>
Date: Thu, 18 Feb 1993 09:06:07 GMT
Lines: 140

Previously, tchrist@convex.COM (Tom Christiansen) wrote:
> You don't have to use an extra process to zap the connect.  As when
> you're timing out reads, send yourself an alarm.  Here's how I might 
> do it:
> 
>     $TIMEOUT = 15;
>     sub Timer { die "Alarm Clock" }
>     $SIG{ALRM} = Timer;
> 
>     socket(S, &AF_INET, &SOCK_STREAK, $proto)   || die "socket: $!";
>     bind (S, $this)                             || die "bind: $!";
> 
>     eval {
>         alarm($TIMEOUT);
>         connect(S, $primary)                    || die "connect: $!";
>         alarm(0);
>     }; 
> 
>     if ($@ && $@ !~ /Alarm Clock/) {
>         die $@;
>     } 

An here is very similar code in a package, ready for reuse:

---- Cut Here and feed the following to sh ----
#/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 02/18/1993 09:07 UTC by mmuegel@mot.com (Michael S. Muegel)
# Source directory /usr/users/macc/mmuegel
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   2191 -r--r--r-- timeout.pl
#
# ============= timeout.pl ==============
if test -f 'timeout.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping timeout.pl (File already exists)'
else
echo 'x - extracting timeout.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'timeout.pl' &&
;# NAME
;#    timeout.pl - execute Perl code with a built-in timeout
;#
;# AUTHOR
;#    Michael S. Muegel (mmuegel@mot.com)
;#
;# RCS INFORMATION
;#    $Author: mmuegel $
;#    $Header: /usr/local/lib/perl/RCS/timeout.pl,v 1.1 1992/05/29 03:07:35 mmuegel Exp $
X
package Timeout;
X
# Messages sent to die from eval for alarm call
$TIMEOUT = "timeout";
X
;###############################################################################
;# Timeout
;#
;# Executes the Perl code in $Code with a built-in timeout of $Timeout
;# seconds. This is very useful when parsing input from a user, socket,
;# or file and you wish to fix a timeout on your parse.
;#
;# $Code is executed with an eval. Thus you can use die to break out of
;# it prematurely. $Code is also executed in the package $Package. Thus your
;# Perl code can have access to other variables within its package. This also
;# means you can set variables in $Code and they will be available in the
;# package $Package. If $Package is not specified main is assumed.
;#
;# $Status is set to one of the following upon return:
;#
;#    -1	Eval of $Code failed. This can be because of a Perl compiler 
;#		error or a die inside the code was used. See $Msg for reason 
;#		why.
;#
;#     0	A timeout occured.
;#
;#     1	No timeout occured.
;#
;# Arguments:
;#    $Timeout, $Code, $Package
;#
;# Returns:
;#    $Status, $Msg
;###############################################################################
sub main'Timeout
{
X   ($Timeout, $Code, $Package) = @_;
X
X   # The main package is assumed
X   $Package = "main" if ($Package eq "");
X
X   # Save the interrupt handler vector and then override the handler for ALRM
X   %Save_SIG = %SIG;
X   $SIG {'ALRM'} = "Timeout'Alarm_Handler";
X
X   # Set up a timer for $Timeout seconds
X   alarm ($Timeout);
X   
X   # Do our thing here within eval in the $Package package. This way we can die 
X   # from the interrupt handler.
X   eval "package $Package; $Timeout'Code";
X
X   # Restore signal handlers
X   %SIG = %Save_SIG;
X
X   # Check eval status
X   alarm (0);
X   return (0) if ($@ =~ /^$TIMEOUT/);
X   return (-1, $@) if ($@);
X   return (1);
X
};
X
sub Alarm_Handler
{
X   die $TIMEOUT if ($_[0] eq "ALRM");
};
X
1;
SHAR_EOF
chmod 0444 timeout.pl ||
echo 'restore of timeout.pl failed'
Wc_c="`wc -c < 'timeout.pl'`"
test 2191 -eq "$Wc_c" ||
	echo 'timeout.pl: original size 2191, current size' "$Wc_c"
fi
exit 0
-- 
+----------------------------------------------------------------------------+
| Michael S. Muegel                  | Internet E-Mail:    mmuegel@mot.com   |
| UNIX Applications Startup Group    | Moto Dist E-Mail:   X10090            |
| Corporate Information Office       | Voice:              (708) 576-0507    |
| Motorola                           | ... these are my opinions, honest ... |
+----------------------------------------------------------------------------+


news.utdallas.edu!wupost!sdd.hp.com!swrinde!network.ucsd.edu!news.acns.nwu.edu!ftpbox!cssmp.corp.mot.com!mmuegel Thu Feb 25 11:54:08 CST 1993
Article: 1135 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1135
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!wupost!sdd.hp.com!swrinde!network.ucsd.edu!news.acns.nwu.edu!ftpbox!cssmp.corp.mot.com!mmuegel
From: mmuegel@cssmp.corp.mot.com (Michael S. Muegel)
#Subject: Re: SUMMARY: Timeout on Connect
Message-ID: <1993Feb22.032204.8979@ftpbox.mot.com>
Keywords: Summary, sockets, connect, timeouts
Sender: news@ftpbox.mot.com (C News)
Organization: Corporate Information Office, Schaumburg, Illinois, Motorola, Inc.
References: <1993Feb18.040748.27347@news.eng.convex.com> <1993Feb18.090607.25547@ftpbox.mot.com> <1993Feb22.020742.8870@news.eng.convex.com>
Date: Mon, 22 Feb 1993 03:22:04 GMT
Lines: 17

Previously, tchrist@convex.COM (Tom Christiansen) wrote:
> From the keyboard of mmuegel@cssmp.corp.mot.com (Michael S. Muegel):
> :And here is very similar code in a package, ready for reuse:
> 
> Except that syntax errors in the eval block won't be caught 
> until run time rather than compile time.

Well worth the reusability gained!
-Mike

-- 
+----------------------------------------------------------------------------+
| Michael S. Muegel                  | Internet E-Mail:    mmuegel@mot.com   |
| UNIX Applications Startup Group    | Moto Dist E-Mail:   X10090            |
| Corporate Information Office       | Voice:              (708) 576-0507    |
| Motorola                           | ... these are my opinions, honest ... |
+----------------------------------------------------------------------------+



.