Perl: Chat Server
Jump to navigation
Jump to search
Sumber: http://poe.perl.org/?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"); }