Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Re: Timeout not working while reading from socket.

by Athanasius (Abbot)
on Jan 24, 2013 at 03:42 UTC ( #1015069=note: print w/ replies, xml ) Need Help??


in reply to Timeout not working while reading from socket.

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,

Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,


Comment on Re: Timeout not working while reading from socket.
Select or Download Code
Replies are listed 'Best First'.
Re^2: Timeout not working while reading from socket.
by jrtaylor (Initiate) on Jan 25, 2013 at 17:14 UTC
    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;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1015069]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (8)
As of 2015-07-31 19:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (280 votes), past polls