POE: Cookbook - Chat Server

#!/usr/bin/perl
# This program is a simple chat server.  It allows multiple people to
# connect and exchange messages.  It's a very simple example, but it
# can be the basis of many multiuser things.
use warnings;
use strict;
use POE;
use POE::Component::Server::TCP;

# Create the server on port 32080, and start it running.
POE::Component::Server::TCP->new(
  Alias              => "chat_server",
  Port               => 32080,
  InlineStates       => {send => \&handle_send},
  ClientConnected    => \&client_connected,
  ClientError        => \&client_error,
  ClientDisconnected => \&client_disconnected,
  ClientInput        => \&client_input,
);
$poe_kernel->run();
exit 0;

# This is a plain Perl function (not a POE event handler) that
# broadcasts a message to all the users in the chat room.  The %users
# hash is used to track connected people.
my %users;

sub broadcast {
  my ($sender, $message) = @_;
  foreach my $user (keys %users) {
    if ($user == $sender) {
      $poe_kernel->post($user => send => "You $message");
    }
    else {
      $poe_kernel->post($user => send => "$sender $message");
    }
  }
}

# Handle an outgoing message by sending it to the client.
sub handle_send {
  my ($heap, $message) = @_[HEAP, ARG0];
  $heap->{client}->put($message);
}

# Handle a connection.  Register the new user, and broadcast a message
# to whoever is already connected.
sub client_connected {
  my $session_id = $_[SESSION]->ID;
  $users{$session_id} = 1;
  broadcast($session_id, "connected.");
}

# The client disconnected.  Remove them from the chat room and
# broadcast a message to whoever is left.
sub client_disconnected {
  my $session_id = $_[SESSION]->ID;
  delete $users{$session_id};
  broadcast($session_id, "disconnected.");
}

# The client socket has had an error.  Remove them from the chat room
# and broadcast a message to whoever is left.
sub client_error {
  my $session_id = $_[SESSION]->ID;
  delete $users{$session_id};
  broadcast($session_id, "disconnected.");
  $_[KERNEL]->yield("shutdown");
}

# Broadcast client input to everyone in the chat room.
sub client_input {
  my ($kernel, $session, $input) = @_[KERNEL, SESSION, ARG0];
  my $session_id = $session->ID;
  broadcast($session_id, "said: $input");
}