Hi folks, I am having trouble with the following script. Basically it connects to two different devices. The 'lightspace' device is a program, which sends short messages that are basically XML, I extract some values from that message, do some math on them, then I send them to another device called the 'phabrix' which then acts on that data.

The phabrix device closes the socket after each message/ack, whereas the lightspace device is happy to leave it open.

The script seems to work fine most of the time, but if a message comes in while the script is still sending messages to the phabrix device (in while loop in the main body you can see it calls the device 3 times), the script frequently hangs (it also occasionally hangs even if it has not recieved a message from the lightspace device before it's ready) It usually hangs between the first and the third message being sent to the phabrix device (shown below) It never hangs inside the phabrix subroutine.

I'm relatively new to perl, so I'm sure I've just got some bad form here, but any help you could provide would be appreciated. Also, sorry for posting so much code, not sure what might be relevant

#!/usr/bin/perl
#LSPhabrix.pl

use strict;
use warnings;
use IO::Socket::INET;
use POSIX;
use Term::ReadKey;

my $data = 0;
my $InputRed = 0;
my $InputGreen = 0;
my $InputBlue = 0;
my $scaling = 0;
my $KeyScale = 0;

# flush after every write
#$| = 1;

# there are no newlines, so use last tag as delimiter
IO::Handle->input_record_separator('</calibration>');
my ($Lssocket,$LSclient_socket);
my ($Pxsocket,$Pxclient_socket);

# user input and other minutia here
    
# Connect to Lightspace and listen
print "Connecting to Lightspace... ";
$Lssocket = new IO::Socket::INET (
    PeerHost => '127.0.0.1',
    PeerPort => '20002',
    Proto => 'tcp',
    Blocking => 0,
) or die "ERROR connecting to Lightspace : $!\n";

print "Connected to Lightspace.\n";

while ($data = <$Lssocket>) {
    #print "Received from Server : $data\n";
    
    $InputRed = index $data, "red=\"";
    $InputGreen = index $data, "green=\"";
    $InputBlue = index $data, "blue=\"";
    if ($InputRed == -1) {
        print "msg from server ng - no color data found\n";
        last;
    }
    
    #take the indexes and adjust to get the whole number

    # ------------ doing some math here that we don't need to worry ab
+out -------
    
    # and send them out
    phabrix ("4700", $InputRed);
        # *********** USUALLY HANGS HERE
    phabrix ("4800", $InputGreen);
        # ************ OR HERE 
    phabrix ("4900", $InputBlue);
    
    print "\n";
}

$Lssocket->close();

# phabrix subroutine
sub phabrix {
    # call using phabrix( command , value ) 
    # Where:    
    #        command is a string of 4 hex digits ie "0500"
    #        value is an unsigned int
    # Remember for command that hex is in intel little endian small by
+te first 
    # Also, because phabrix doesn't always respond or ack, we will do 
+the 
    # operation up to 3 times before giving up and erroring out.
    print "\n*";
    my $Pxsocket = 0;
    $Pxsocket = new IO::Socket::INET (
        PeerHost => '192.168.200.5',
        PeerPort => '2100',
        Proto => 'tcp',
    ) or die "ERROR connecting to Phabrix : $!\n";
    
    my $magicNumber = pack "H8", "12cb5aa5";
    my $commandType = pack ("H4", "0500");
    my $command = shift;
    my $spacer = pack ("H16", "0000000000000000");
    my $value = shift;
    my $phabrix_ACK = pack ("H12", "12cb5aa50000");
    my $response = 0;
    my $errCount = 0;
    
    # pack command and value
    $command = pack ("H4", $command);
    $value = pack ("L", $value);
        
    while (1) {
        # send command
        $Pxsocket->send($magicNumber);
        $Pxsocket->send($commandType);
        $Pxsocket->send($command);
        $Pxsocket->send($spacer);
        $Pxsocket->send($value);
        print "sent ";
        print (unpack ("H*",$magicNumber));
        print (unpack ("H*",$commandType));
        print (unpack ("H*",$command));
        print (unpack ("H*",$spacer));
        print (unpack ("H*",$value));
        print " - ";
        #get response
        $Pxsocket->recv($response,6);
        print " recv ";
        print (unpack ("H*", $response));
        print "";
        
        if ($response eq $phabrix_ACK) {
            print " ACK($errCount)";
            last;
        } elsif ($errCount == 3) {
            #die "ERROR Too many retries to Phabrix.  Exiting!\n";
            $Pxsocket->close();
            print "NO Ack, skipping";
            last;
        } else {
            $Pxsocket->close();
            $errCount = $errCount + 1;
            sleep (1);
        }
    }
}

[download]

Thanks for your time in looking at this.

In reply to socket problem? script hangs occasionally... by bgervais

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.