#!/usr/bin/perl

# Simple client for testing 
# https://www.perlmonks.org/?node_id=11151665

use strict;
use warnings;
$!=1;
use IO::Socket;

my $socket = IO::Socket::INET -> new 
          (PeerAddr  => 'localhost',
           PeerPort  => 8081,
           Proto     => 'tcp',
           Type      => SOCK_STREAM)
      or
die "Cannot open socket!";  

print "$socket";

my $cmd = <<'END_MESSAGE';
GET /DATA_String/{300 continuous characters of sensor data}HTTP/1.1
Some host line
Some Connection line
Some user-agent line, next line is blank

END_MESSAGE

$SIG{PIPE} = 'handler';
$SIG{INT}  = 'handler';
$SIG{QUIT} = 'handler';
$SIG{ALRM} = 'handler';

server_request($cmd);  #single request

close $socket;     #hang up
exit();


sub server_request
{
    my $cmd = shift;
    print "sending CMD to server\n";
    alarm(2);
    print $socket "$cmd";
    $socket->flush();
    alarm(0);
    

    print "client debug: back from server: \n";
    while (alarm(2),my $sResponse = <$socket>)
    { 
       alarm(0);
       print "from Server: $sResponse";
    }
    alarm(0);
}

sub handler
{
   my ($signo) = shift;
   if ($signo eq "INT" or $signo eq "QUIT")
   {
       print $socket "QUIT\n";
       close ($socket);
       exit (1);
   }
   elsif ($signo eq "ALRM")
   {
       print "server too slow - request timed out!\n";
       exit (2);
   }
   else  #SIGPIPE (probably!)
   {
       print "Server died with signal $signo\n";
       exit (3);
   }
}

##</code><code>##

#!/usr/bin/perl

# Perl SOPW 
# https://www.perlmonks.org/?node_id=11151665

use strict;
use warnings;
$|=1; #Turn stdio buffering off

use IO::Socket;
use POSIX qw(sys_wait_h);
use constant LISTEN_PORT => 8081;

my $socket = IO::Socket::INET->new
              ( LocalPort => 8081,
                Proto     => 'tcp',
                Type      => SOCK_STREAM,
                Reuse     => 1,
                Listen    => 10,
               )
           or
die "Could not open port 8081!";

my $client;

while (1)
{
   $client = $socket->accept() || next; #accept() is not re-entrant
                                        #loop if error
   
   my $pid = fork();
   die "Bad Fork!" unless defined $pid;
   
   if ($pid == 0 )  # child
   {
       close ($socket); # children don't listen for new connections
       
       my $line;
       my @buff;
       
       while (defined ($line=<$client>) and $line !~ /^\s*$/)
       {
          push @buff, $line;
       }
             
       my $time = time();
       print "INCOMING from a Client Connection at $time\n";
       
       do_command(\@buff);
       
       exit(0);
   }
   else              # parent
   {
       close ($client); #wait for next client request
   }
}

sub do_command  
{
    my $buff = shift;
    
    print $client "START\n";
    print $client "$_" for @$buff;  #just loopback lines to client
    print $client "END\n";
    $client->flush();
}