#!/usr/bin/perl
use warnings;
use strict;
use POSIX;
use IO::Socket;
use IO::Select;
use Tie::RefHash;

my $port = 1800;

### Create the server socket.
my $server = IO::Socket::INET->new(
  LocalPort => $port,
  Listen    => 10,
) or die "can't make server socket: $@\n";
$server->blocking(0);
### Set up structures to track input and output data.
my %inbuffer  = ();
my %outbuffer = ();
my %ready     = ();
tie %ready, "Tie::RefHash";
### The select loop itself.
my $select = IO::Select->new($server);

while (1) {

  # Process sockets that are ready for reading.
  foreach my $client ($select->can_read(1)) {
    handle_read($client);
  }

  # Process any complete requests.  Echo the data back to the client,
  # by putting the ready lines into the client's output buffer.
  foreach my $client (keys %ready) {
    foreach my $request (@{$ready{$client}}) {
        process_request($client,$request);
    }
    delete $ready{$client};
  }

  # Process sockets that are ready for writing.
  foreach my $client ($select->can_write(1)) {
    handle_write($client);
  }
}
exit;

sub process_request {
    my ($client,$request) = @_;
    print "Got request: $request";
    chomp $request;
    if ( $request eq "HELLO" ) {
        $outbuffer{$client} .= "TEST SERVER 0.1\n";
    } elsif ($request eq "GET NODES" ) {
        $outbuffer{$client} .= "NODES: 0 ZERO, 1 ONE, 2 TWO, 4 FOUR\n"
+;
    } elsif ( $request =~ /^JOIN / ) {
        $outbuffer{$client} .= "JOINING NOT IMPLEMENTED\n";
    } elsif ( $request =~ /^MSG / ) {
        $outbuffer{$client} .= "MSGING NOT IMPLEMENTED\n";
    } else {
        $outbuffer{$client} .= "UNKNOWN COMMAND\n";
    }
}


### Handle a socket that's ready to be read from.
sub handle_read {
  my $client = shift;

  # If it's the server socket, accept a new client connection.
  if ($client == $server) {
    my $new_client = $server->accept();
    $new_client->blocking(0);
    $select->add($new_client);
    return;
  }

  # Read from an established client socket.
  my $data = "";
  my $rv = $client->recv($data, POSIX::BUFSIZ, 0);

  # Handle socket errors.
  unless (defined($rv) and length($data)) {
    handle_error($client);
    return;
  }

  # Successful read.  Buffer the data we got, and parse it into lines.
  # Place the lines into %ready, where they will be processed later.
  $inbuffer{$client} .= $data;
  while ($inbuffer{$client} =~ s/(.*\n)//) {
    push @{$ready{$client}}, $1;
  }
}

### Handle a socket that's ready to be written to.
sub handle_write {
  my $client = shift;

  # Skip this client if there's nothing to write.
  return unless exists $outbuffer{$client};

  # Attempt to write pending data to the client.
  my $rv = $client->send($outbuffer{$client}, 0);
  unless (defined $rv) {
    warn "I was told I could write, but I can't.\n";
    return;
  }

  # Successful write.  Remove what was sent from the output buffer.
  if ( $rv == length($outbuffer{$client})
    or $! == POSIX::EWOULDBLOCK) {
    substr($outbuffer{$client}, 0, $rv) = "";
    delete $outbuffer{$client} unless length $outbuffer{$client};
    return;
  }

  # Otherwise there was an error.
  handle_error($client);
}
### Handle client errors.  Clean up after the dead socket.
sub handle_error {
  my $client = shift;
  delete $inbuffer{$client};
  delete $outbuffer{$client};
  delete $ready{$client};
  $select->remove($client);
  close $client;
}
[download]