$SIG{ALRM} = \&timeout_code;
alarm = $N;
while (<COM>) {
   $out .= <COM>;
}
$SIG{ALRM} = "";
[download]

thanks! Ill give it a try. It never ceases to amaze me how simple perl can do some things.... :)

This is harder than it seems. You should do as little as possible in your signal handler because in many versions of Perl you can crash in the signal handler due to non-reentrant system libraries. Beware also of slow system calls which may be automatically restarted after an alarm.

Notice that $x = <COM> will hang if you don't get a newline. So you may need to resort to sysread instead. Anyway, I hope the following example code may be of some use to you.

my $N = 10;    # timeout in seconds
my $out;       # read into here

# See Perl Cookbook 2nd edition, Recipe 16.21
# See also perlfaq8 "How do I timeout a slow event".
# Read a chunk from file handle <COM>, timing out after $N seconds.
# Return number of bytes read, 0 if EOF, -1 if timed out.
sub read_for {
   my $diestr = 0;
   my $nbytes = 0;
   eval {
      local $SIG{ALRM} = sub { die "alarm clock restart" };
      alarm($N);    # schedule alarm in $N seconds
      eval {
         $nbytes = sysread(COM, $out, 1024);
      };
      $diestr = $@ if $@;
      alarm(0);           # cancel the alarm
   };
   $diestr = $@ if $@;
   alarm(0);              # race condition protection
   return $nbytes unless $diestr;
   return -1 if $diestr =~ /alarm clock restart/;
   die $diestr;
}

while (1) {
   my $nbytes = read_for();
   if ($nbytes < 0) {
      print "timed out after $N seconds\n"; last;
   } elsif ($nbytes == 0) {
      print "eof\n"; last;
   }
   print "chunk='$out'\n";
}
[download]

What we did (for this exact same application :-) was write our own routine to get a line of data one character at a time using select. Here's the relevant bit of code (modified slightly from the actual code we use):

sub Gets {
   my($fh, $timeout) = @_;
   my($str, $c, $rin, $rout, $found, $timeleft);

   $rin = ''; vec($rin, fileno($fh), 1) = 1;

   $timeout ||= 1;
   while (1) {
      ($found, $timeleft) = select($rout=$rin, undef, undef, $timeout)
+;
      last unless $found;
      sysread($fh, $c, 1);
      $str .= $c if ($c ne "\0");
      last if ($c eq "\n");
   }
   return $str;
}
[download]

Hope this helps!

and here I thought I was the only one still playing with packet radio.....If you dont mind me asking, what are you doing with it? Is that part of a packet BBS?

No, no BBS here. It's part of an old data-collection system we have at work. We have water quality measurement devices attached to a TNC+radio on battery+solar panels that are several miles away from our main offices. Periodically we poll those devices to see what the current conditions are.

I think only 2 of the stations still use packet radio. The rest have been moved to spread spectrum radio. But the existing packet radio system has been in place since 1990 and the original data collection software was written in good ole perl4 :-)

duff

Nice one. Didn't think of using select. :-)

sysread($fh, $c, 1);

However, for performance reasons (remember, sysread is not buffered) you should not read one byte at a time, but in chunks (up to 1024 bytes at a time, say).

Here is my (curent) variation of the above gets function:


sub gets {
  my $timeout;
  my($str, $c, $rin, $rout, $found, $timeleft);

  #be really pessimistic about how long it will take for the fist char
  $timeout = 120; #time in seconds

  $rin = '';
  vec($rin, fileno(COM), 1) = 1;

  while (1) {
    ($found, $timeleft) = select($rout=$rin, undef, undef, $timeout); 
+ #look for input for up to $timeout seconds
    last unless $found;  #give up if nothing was found
    $timeout = $timeout - $timeleft;
    $timeout ||= 15;  #the $timeout must be >= 15 seconds
    sysread(COM, $c, 1);  #read the next char
    if (($c ne "\0")&&($c =~ /[\w\*\-\t\:\/ ]/)) { #sanitize the data
      $str .= $c;  #put the char at the end of the string
    } elsif ($c =~ /\r/) { #Note: must only match \n OR \r.  Matching 
+both does odd stuff
      last;
    }
  }
  return $str;
}
[download]

This version will hopefully take care of some of those *really* slow connections and not waste *too* much time after the transfer is complete.
As for performance, Im not terribly concerned because the datastream is at 1200 baud and sofar this has proven fast enough. It also allows me to do some filtering of the data as it comes in.

Aye. The actual code I pulled this from uses gets() in manner such that if the input matches a pattern, it returns immediately, so we read one character at a time to only read up to the point where the match occurs and nothing beyond.

duff