Miscellany

package SM::Server;

use warnings;
use strict;

use POE qw(Component::Server::TCP);

POE::Component::Server::TCP->new
  ( Alias => "sm_server",
    Port               => 9500,
    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" );
}


=head1 NAME

SM::Server - The great new SM::Server!

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

Quick summary of what the module does.

Perhaps a little code snippet.

    use SM::Server;

    my $foo = SM::Server->new();
    ...

=head1 EXPORT

A list of functions that can be exported.  You can delete this section
if you don't export anything, such as for a purely object-oriented module.

=head1 FUNCTIONS

=head2 function1

=cut

sub function1 {
}

=head2 function2

=cut

sub function2 {
}

=head1 AUTHOR

Casey Banner, C<< <kcbanner at gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-sm-server at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=SM-Server>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc SM::Server

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/SM-Server>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/SM-Server>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SM-Server>

=item * Search CPAN

L<http://search.cpan.org/dist/SM-Server>

=back

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2007 Casey Banner, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of SM::Server