use warnings; use strict; use POE::Component::Server::TCP; use Term::ReadKey; use POE qw(Filter::Stream); use Data::Dumper; my %users; # Create the server on port 32080, and start it running. POE::Component::Server::TCP->new( Alias => "Simple_Server", Port => 32080, InlineStates => { send => \&handle_send, }, ClientConnected => \&client_connected, ClientError => \&client_error, ClientDisconnected => \&client_disconnected, ClientInput => \&client_input, # So I can get input one character at a time ClientInputFilter => POE::Filter::Stream->new(), # So I can print output with no additional unwanted character ie: \n ClientOutputFilter => POE::Filter::Line->new( Literal => chr(0), ), ); $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. sub broadcast { my ( $sender, $message ) = @_; foreach my $user ( keys %users ) { if ( $user == $sender ) { $poe_kernel->post( $user => send => "You $message\r\n" ); } else { $poe_kernel->post( $user => send => "$sender $message\r\n" ); } } ### foreach my $user ( keys %users) } ### sub broadcast # 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; my $address = $_[HEAP]{remote_ip}; my $port = $_[HEAP]{remote_port}; my $heap = $_[HEAP]; #$users{$session_id} = 1; $poe_kernel->post( $session_id => send => "CONNECT: $address/$port\r\n" ); $poe_kernel->post( $session_id => send => "? " ); } ### sub client_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 { print "CLIENT ERROR\r\n"; my $session_id = $_[SESSION]->ID; delete $users{$session_id}; broadcast( $session_id, "disconnected." ); $_[KERNEL]->yield("shutdown"); } ### sub client_error # Broadcast client input to everyone in the chat room. sub client_input { my ( $kernel, $session, $input ) = @_[ KERNEL, SESSION, ARG0 ]; my $session_id = $session->ID; my $letter = $_[ARG0]; #Carriage Return if ( ( ord($letter) == 13 ) ) { my $line = $users{$session_id}{input}; $users{$session_id}{input} = ''; parseInput( $kernel, $session, $line ); } else { #Handle input and add to input buffer $users{$session_id}{input} .= $input; } } ### sub client_input sub parseInput { my ( $kernel, $session, $input ) = @_; my $session_id = $session->ID; broadcast( $session_id, "said: $input" ); }