#!/bin/perl 

use strict;
use warnings;
use IO::Select;
use IO::Socket;

#initialise our socket
my $listener = IO::Socket::INET -> new( LocalPort => 5001, 
                    Proto => "tcp",
                    Reuse => 1,
                    Listen => 20,
                    Blocking => 0, );
$listener -> autoflush(1);

#create our 'select' groups
my $listen_select = new IO::Select( $listener );
my $sockets = new IO::Select ( );

#A timeout of 0 can be workable, but is inefficient unless 
#you have _lots_ of IO
my $timeout = 1; #seconds;

while ()
{
  if ( $sockets -> count )
  {
    #check for an incoming socket. Could probably merge
    #the two can_read statements.
    if ( $listen_select -> can_read($timeout) )
    {
      my $client;
      my $raddr = accept($client, $listener);
      $sockets -> add ( $client );
      $client -> autoflush(1);
      $timeout = 0; 
      print "Connection accepted from ", print unpack ( "C*", $raddr )
+, "\n";
    }
   
    my @ready = $sockets -> can_read($timeout); 

    #if any socket has pending data, read it and act on it.
    foreach my $handle ( @ready ) 
    {
      my $read_tmp = <$handle>;
      if ( !defined ( $read_tmp ) )
      {
        print "Filehandle closed.\n";
        $sockets -> remove ( $handle );
        $handle -> close;
      }
      else
      {
        #do processing here. 
       
        #imagine doing something good with read_tmp
        print "Got data: $read_tmp\n";
        #and sending something cool to the client
        print $handle "Fwatoom\n";
      }
    }
  } #if count
  else
  {
    #we have no handles in our thingy, so we sit idle waiting for 
    #a connection.

    print "No pending data. Idling for connect()\n";
    my $client;
    my $raddr = accept($client, $listener);
    $sockets -> add ( $client );
    $client -> autoflush(1);
    $timeout = 0;
    print "Connection accepted from ", print unpack ( "C*", $raddr ), 
+"\n";
  }
}
[download]

#!/bin/perl

use strict;
use warnings;

use IO::Socket;
my $destination_port = 5001;  #change these how you will
my $destination_address = "localhost";

my $socket = new IO::Socket::INET ( proto => "tcp", 
             PeerAddr => $destination_address,
         PeerPort => $destination_port, ) or die "$!";

#send our "command" to the server
print $socket "hello\n";

#See what the response is. In this case, we'll just keep
#reading until the socket is closed remotely.
while ( <$socket> )
{
  print;
}
[download]

Why do you not like fork for situations like this? To me it seems like the perfect tool to create little child processes. Also although I hate to point out the obvious the 'server' I posted above has maybe five times less code, making it substanially easier to read and write.

I dislike the idea of duplicating the entire process for something simple like printing a response to the socket. Fork is know as a heavyweight process for a reason. (yes, I know that copy-on-demand alleviates this)

I also rather like showing off an example of one of the other ways to do it, which becomes useful in some of the situations where a fork is not.

As ever, there's more than one way to do it. Fork can be effective and simple, but IO::Select allows one some better control over child processes.

I've never actually profiled the code, but I'd imagine that fork works pretty good on Unix, where it's integral to the OS. (Ish, because it becomes a little fuzzier when you're talking about forking perl, and the interpreted code) I'd not be so sure about doing so on Windows.

Has anyone tried a benchmark of the relative methods?

$SIG{CHLD}='IGNORE'; # no zombies for me!

use IO::Socket;
my $server = new IO::Socket::INET
(
    LocalPort=>2000,
    LocalAddr=>'127.0.0.1',
    Type=>SOCK_STREAM,
    Reuse=>1,
    Listen=>10,
);

while(my $client = $server->accept)
{
    my $pid = fork;
    next if $pid;
    #
    # This is the body of the forked child,
    # simply read from the client using <$client>
    # and write using print $client foo;
    # then exit the child (DO NOT FORGET);
    exit;
}
[download]

Define a new class that inherits from Net::Daemon in daemon.pl

      require Net::Daemon;
      package Contdmon;
      use vars qw(@ISA);
      @ISA = qw(Net::Daemon); # to inherit from Net::Daem
[download]

   sub new ($$;$) {
          my($class, $attr, $args) = @_;
          my($self) = $class->SUPER::new($attr, $args);
          # set up the logfile
          my $file = IO::File->new ( '/path', "a" );
        $file->autoflush ( 1 ) ;
        $self->{'logfile'} = $file;
      $self;
   }
[download]

  sub Run ($) {
          my($self) = @_;
          my($line, $result, $sock);

          $sock = $self->{'socket'};
          while (1) {
              if (!defined($line = $sock->getline())) {
                  if ($sock->error()) {
                      $self->Error("Client connection error %s",
                                   $sock->error());
                  }
                  $sock->close();
                  return;
              }
          }
       print "Server received request: $line\n";
}
[download]

     package main;
     my $args = {
        'facility' => 'daemon',
        'pidfile' => '/users/ccm_root/logs/contdaem.pid',
        'logfile' => '/users/ccm_root/logs/contdaem.log',
        'user' =>  'ccm_root',
        'group' => 'ccm_root',
        'localport' => '5440',
        'mode' => 'single',
        };
     my $server = Contdmon->new  ({}, $args);
     $server->Bind();
[download]

use strict;
use IO::Socket;
$| = 1; # flush output buffers immediately
my ( $host ) = 'server';
my ( $port ) = 1234;
# create the socket
my $sock = IO::Socket::INET->new ( Proto    => 'tcp',
                   Type     => SOCK_STREAM, 
                          PeerAddr => $host,
                   PeerPort => $port ) 
                      
        or die "Cannot create socket : $!";
# so output goes to daemon immediately    
$sock->autoflush (1);
print $sock "What is the time, Mr Wolf?\n";
[download]