Re: Timeout not working while reading from socket.

[Athanasius]

Hello jrtaylor, and welcome to the Monastery!

I can’t test your code, as Time::Out doesn’t work on Windows. But I’ve had a go at reducing your script to a minimum example (see How do I post a question effectively?):

#! perl
use strict;
use warnings;
use IO::Socket;
use Time::Out qw(timeout);

$SIG{PIPE} = "IGNORE";
$|         = 1;
umask 002;
my $socket = new IO::Socket::INET(
                                      PeerAddr => '192.168.173.9',
                                      PeerPort =>  7001,
                                      Proto    => 'tcp',
                                      Type     =>  SOCK_STREAM,

                                 ) or die "Can't open socket: $@\n";

# Open the output file

my ($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
my  $ymd  = sprintf "%04d%02d%02d%02d%02d%02d",
                     $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
my  $file = "/var/flexshare/shares/logs/backup.$ymd.txt";
open(my $out, '>', $file) or die "Can't open file '$file' for writing:
+ $!";
$out->autoflush(1);

# Send to the socket

print $socket "\r\n\r\nP H 19\r\n";

# Read from the socket

my $nb_secs = 10;

while (my $line = <$socket>)
{
    timeout $nb_secs => sub
    {
        my $count = 0;

        until ($count == 5)     # Read the next xx lines
        {
            print $out $line;
            $socket->flush();
            $count++;
        }
    };

    if ($@)
    {
        $line = "";
    }
}

close $out;
close $socket;

As far as I can see, the code within timeout $nbsecs => sub { ... } does nothing but write the same $line to the output file 5 times, flushing the socket each time. Did you mean to put the while loop that reads from the socket into the timeout sub?

Hope that helps,

[jrtaylor]

I see what I did wrong..... THANKS. This seems to work.

while (my $line = <$sock>) 
    {
    if ($line =~ m/^(ALARM: )/) 
        {
        timeout $nb_secs => sub 
        {
        while (2) 
            {
            $buf .= $sock->getline();
            $sock->flush();
            }
        };
        if ($@)
            {
            my $msg = MIME::Lite->new(
                        .......  
                Type     =>'TEXT',
                Data     =>$buf ,
            );
                $msg->send();
            print $file $buf;
                $line = "";
                $buf = "";
            }
            }    
    print $file $line; #Print current line to open $file.
    }
}
sleep 10; # allow sometime to exit
close $file;