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