whiskerstat.pl

Top  Previous  Next

A simple TCP client: implementing a status program in Perl

 

Here's an example of network communications using Perl. You can run it as

 

whiskerstat.pl somewhere.psychol.cam.ac.uk

 

#!/usr/bin/perl –w

# PIT.pl

# --------------------------- Call this file "WhiskerStat.pl".

# Note that Perl comments are preceded by a hash (#)

require 5.002;

use Socket;

 

# --------------------------- Say hello

 

print "\n\nWhiskerStat.pl\n\n";

 

&LogIn(@ARGV);

 

&Send("ReportName WhiskerStat status program");

&Send("ReportStatus Absolutely fine.");

&Send("WhiskerStatus");

&Send("TestNetLatency");

 

while ($line = <SOCK>) {

   # The server has sent us a message. Deal with it.

   if ($line =~ /Ping/) { &Send("PingAcknowledged"); }

   print $line;

}

 

&LogOut();

print "All done.\n";

exit;

 

# -----------------------------------------------------------

# --------------------------- Networking routines.

# -----------------------------------------------------------

 

sub LogIn {

   # Get parameters from the command line, or acceptable defaults

 

   my ($remote,$port, $iaddr, $paddr, $proto, $line);

   $remote  = shift || 'localhost';

   $port    = shift || 1333;  # default port

   if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }

   die "No port" unless $port;

 

   # Connect to the server

 

   $iaddr   = inet_aton($remote)               || die "no host: $remote";

   $paddr   = sockaddr_in($port, $iaddr);

   $proto   = getprotobyname('tcp');

   socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "can't make socket: $!";

   connect(SOCK, $paddr)    || die "can't connect: $!";

   print "Connected to " . inet_ntoa($iaddr) . "\n\n";

 

   select(SOCK); $| = 1;

   # This is vital to ensure that output to the socket

   # gets sent immediately. Otherwise it hangs around for ever

   # (literally) in some circumstances.

 

   select(STDOUT);

   # Output goes to the local console once more.

}

 

sub LogOut

{

   close (SOCK)            || die "close: $!";

}

 

sub Send {

   # This sends something to the server, with a trailing newline.

   # Use it like Send("Hello ","I am " . " a ", "fish");

   print SOCK @_;

   print SOCK "\n";

}