Exemplo de sala de chat utilizando IO Não bloqueante para o equinocio do SPPM 2013

chat.pl

use strict;
use warnings;
use POSIX;
use IO::Socket::INET; 
use IO::Select;
use feature 'say';

use constant TIMEOUT => 0.5;

my $server = IO::Socket::INET->new(
    Proto     => 'tcp',
    Reuse     => 1,
    Listen    => SOMAXCONN,
    LocalPort => 9090,
    Blocking  => 0
    ) or die "ops... $!\n"; 

$|++; 
say "Listen in 9090";

my $select = IO::Select->new;

$select->add($server);

my %clients;

while(1) {
  foreach my $socket ($select->can_read(TIMEOUT)){
    process_read($socket);
  }
  process_data();
  foreach my $socket ($select->can_write(TIMEOUT)){
    process_write($socket);
  }
}

sub process_new_connection {
  my $name = rand();
  
  say "new client: $name connected!\n";
  
  my $new = $server->accept;
  
  $select->add($new);
  
  foreach my $client (values %clients){
    $client->{out_buffer} .= "\n$name connected...\n";
  }
  
  $clients{$new} = { name => $name, in_buffer => "", out_buffer => ""};
}

sub process_read_to_buffer {
  my $socket = shift;
  
  if( exists $clients{$socket} ){
      my $rv = $socket->sysread(my $data, POSIX::BUFSIZ, 0); 
      if(defined($rv) && length $data) {
          $clients{$socket}->{in_buffer} .= $data;
      }  elsif ($! != POSIX::EAGAIN) { 
          my $name = $clients{$socket}->{name};
          say "delete client $name";
          delete $clients{$socket};
          foreach my $client (values %clients){
            $client->{out_buffer} .= "\n$name disconnect...\n";
          }
      }
  } else {
      say "client disconnected";
      $select->remove($socket);
      $socket->close;
  }
}

sub process_read{
  my $socket = shift;
  
  if ($socket == $server) {
    process_new_connection
  } else {
    process_read_to_buffer $socket;
  }
}

sub process_data{
  # todos falam com todos:
  foreach my $a (values %clients){
    my $name    = $a->{name};
    my $message = $a->{in_buffer};

    # se não tenho nada para dizer, vamos para o proximo
    next unless $message;
    foreach my $b (values %clients){
      # escrevo no buffer de saida de todos
      $b->{out_buffer} .= "\n" . ( $b->{name} eq $name ? "You": $name ) . " say: $message";
    }
    
    # limpo o meu buffer
    $a->{in_buffer} = '';
  }
}
sub process_write{
  my $socket = shift;
  
  return unless (exists($clients{$socket}) &&    # vou escrever apenas nos clientes conectados
      length($clients{$socket}->{out_buffer}));  # e vou escrever apenas se houver algum buffer
      
  # aqui vou escrever de forma bufferizada  
  my $rv = $socket->syswrite($clients{$socket}->{out_buffer}, POSIX::BUFSIZ);
  
  # e vou remover a quantidade de bytes que eu escrevi do buffer.
  if ($rv || $! == POSIX::EAGAIN) {
      substr($clients{$socket}->{out_buffer}, 0, $rv) = '';
      $clients{$socket}->{out_buffer} = '' unless length $clients{$socket}->{out_buffer};
  }
}