Rhythm & Biology

Engineering, Science, et al.

Perlで手軽に非同期TCPサーバ

yokohama.pmに行ってきて、またperl熱が上がってきたので、久しぶりにコード書いてみた。

AnyEvent::TCPServer

AnyEvent::Socketを使って非同期サーバ書こうとすると色々面倒くさかったりするので、もっと手軽に書けるモジュールを作ってみました。こんな感じで非同期のechoサーバを書けます。

use strict;                                                                                                                        
use warnings;
use 5.010;

use AnyEvent::TCPServer;

on_connect(sub {
  say "connection accepted";
});

on_read(line => sub {
  my ($handle, $line) = @_; 
  say "got line: $line";
  $handle->push_write("$line\n");
});

on_eof(sub {
  say "connection closed";
});

on_error(sub {
  my ($handle, $fatal, $message) = @_; 
  say "error: $message";
});

server->run(
  host => undef,
  port => 1986,
);

各イベントの処理を追加していって、最後にrunでサーバを起動します。
handleをdestroyするといった処理はモジュール側でやってしまうので書く必要はありません。

今後

今だと簡単な処理しか扱えないので、on_drainなどの処理を登録できるようにするのが当面の目標です。AnyEvent::Handleのイベントは一通り網羅できたほうがいいでしょう。

ソース

小さいモジュールだし、githubにリポジトリ作るほど作り込んでないので、モジュールのソース貼っておきます。

package AnyEvent::TCPServer;                                                                                                       
use strict;
use warnings;

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

sub import {
  my $class = shift;
  my $app = $class->new;

  $SIG{PIPE} = "IGNORE";

  no strict 'refs';
  my $caller = caller;
  push @{"${caller}::ISA"}, $class;

  no warnings 'redefine';
  *{"${caller}::new"} = *{"${caller}::server"} = sub { $app };
  *{"${caller}::on_connect"} = sub (@) { $app->register_on_connect(shift) };
  *{"${caller}::on_read"}    = sub (%) { $app->register_on_read(@_) };
  *{"${caller}::on_eof"}     = sub (@) { $app->register_on_eof(shift) };
  *{"${caller}::on_error"}   = sub (@) { $app->register_on_error(shift) };

  strict->import;
  warnings->import;
}

sub new {
  my $class = shift;
  bless {
    on_connect => undef,
    on_read    => undef,
    on_eof     => undef,
    on_error   => undef,
    handles    => +{},
  }, $class;
}

sub run {
  my ($self, %config) = @_;

  my $cv = AE::cv;
  tcp_server $config{host}, $config{port}, sub {
    my ($fh) = @_;

    my $handle; $handle = AnyEvent::Handle->new(
      fh => $fh,
      on_read => sub {
        $handle->push_read(%{$self->{on_read}}) if defined $self->{on_read};
      },
      on_eof => sub {
        $self->{on_eof}->(@_) if defined $self->{on_eof};
        $handle->destroy;
        delete $self->{handles}->{$fh};
      },
      on_error => sub {
        $self->{on_error}->(@_) if defined $self->{on_error};
        $handle->destroy;
        $cv->send;
      },
    );
    $self->{handles}->{$fh} = $handle;
    $self->{on_connect}->($handle) if defined $self->{on_connect};
  };
  $cv->recv;
}

sub register_on_connect {
  my ($self, $on_connect) = @_;
  $self->{on_connect} = $on_connect;
}

sub register_on_read {
  my ($self, %on_read) = @_;
  $self->{on_read} = \%on_read;
}

sub register_on_eof {
  my ($self, $on_eof) = @_;
  $self->{on_eof} = $on_eof;
}

sub register_on_error {
  my ($self, $on_error) = @_;
  $self->{on_error} = $on_error;
}

1;

アドバイス等頂けると幸いです。