A simple chat server in AnyEvent

Node.js でつくってるやつ をみて同じくらいで書けそうだなと思ったので試しに AnyEvent で書き直してみた。

#!/usr/bin/perl

use strict;
use warnings;

use AnyEvent::Socket;
use AnyEvent::Handle;

my @clients;

tcp_server undef, 7000, sub {
    my ($fh) = @_ or die $!;
    my $h = AnyEvent::Handle->new( fh => $fh );

    my $leave = sub {
        my $client = delete $clients[ fileno($fh) ];
        for my $c (grep { defined } @clients) {
            $c->{handle}->push_write("$client->{name} has left.\n");
        }
    };

    $h->on_read(sub {
        shift->push_read( line => sub {
            my ($h, $line) = @_;

            my $client = $clients[ fileno($fh) ];

            unless (defined $client->{name}) {
                if ($line =~ /(\S+)/) {
                    $client->{name} = $1;
                    $h->push_write("===========\n");

                    for my $client (grep { defined } @clients) {
                        next if $client->{handle} eq $h;
                        $client->{handle}
                            ->push_write( "$client->{name} has joined.\n" );
                    }
                }
                return;
            }

            my ($command) = $line =~ m!^/(.+)!;
            if ($command) {
                if ($command eq 'users') {
                    $h->push_write("- $_->{name}\n") for grep { defined } @clients;
                }
                elsif ($command eq 'quit') {
                    $leave->();
                }
                return;
            }

            for my $c (grep { defined } @clients) {
                next if $c->{handle} eq $h;
                $c->{handle}->push_write( "$client->{name}: $line\n" );
            }
        });
    });

    $h->on_error(sub {
        my ($h, $fatal, $msg) = @_;
        $leave->();
        $h->destroy;
    });

    $clients[ fileno($fh) ] = {
        name   => undef,
        handle => $h,
    };

    $h->push_write("Welcome, enter your username:\n");
};

AE::cv->wait;

行数的にはほぼ同じくらい。

追記@2009-12-08T10:36:37+09:00: left なメッセージがおかしかったので直した。

by typester / at 2009-12-07T20:38:00 / perl · anyevent / Comments(0)