1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use IO::Async::Loop; 7use IO::Async::Stream; 8 9my $PORT = 12345; 10 11my $loop = IO::Async::Loop->new; 12 13my $listener = ChatListener->new; 14 15$loop->add( $listener ); 16 17$listener->listen( 18 service => $PORT, 19 socktype => 'stream', 20)->on_done( sub { 21 my ( $listener ) = @_; 22 my $socket = $listener->read_handle; 23 24 printf STDERR "Listening on %s:%d\n", $socket->sockhost, $socket->sockport; 25})->get; 26 27$loop->run; 28 29package ChatListener; 30use base qw( IO::Async::Listener ); 31 32my @clients; 33 34sub on_stream 35{ 36 my $self = shift; 37 my ( $stream ) = @_; 38 39 # $socket is just an IO::Socket reference 40 my $socket = $stream->read_handle; 41 my $peeraddr = $socket->peerhost . ":" . $socket->peerport; 42 43 # Inform the others 44 $_->write( "$peeraddr joins\n" ) for @clients; 45 46 $stream->configure( 47 on_read => sub { 48 my ( $self, $buffref, $eof ) = @_; 49 50 while( $$buffref =~ s/^(.*\n)// ) { 51 # eat a line from the stream input 52 53 # Reflect it to all but the stream who wrote it 54 $_ == $self or $_->write( "$peeraddr: $1" ) for @clients; 55 } 56 57 return 0; 58 }, 59 60 on_closed => sub { 61 my ( $self ) = @_; 62 @clients = grep { $_ != $self } @clients; 63 64 # Inform the others 65 $_->write( "$peeraddr leaves\n" ) for @clients; 66 }, 67 ); 68 69 $loop->add( $stream ); 70 push @clients, $stream; 71} 72