File Coverage

blib/lib/AnyEvent/SKKServ.pm

Criterion	Covered	Total	%
statement	18	43	41.8
branch	0	10	0.0
condition			n/a
subroutine	6	14	42.8
pod	2	2	100.0
total	26	69	37.6

package AnyEvent::SKKServ;
use strict;
use warnings;
use 5.008005;
our $VERSION = '0.01';

use AnyEvent::Handle;
use AnyEvent::Socket ();

use constant {
    CLIENT_END       => '0',
    CLIENT_REQUEST   => '1',
    CLIENT_VERSION   => '2',
    CLIENT_HOST      => '3',

    SERVER_ERROR     => '0',
    SERVER_FOUND     => '1',
    SERVER_NOT_FOUND => '4',
    SERVER_FULL      => '9',
};

sub new {
    my ($class, %args) = @_;
    return bless {
        host => undef,
        port => 55100,

        on_error => sub {
            $_[0]->push_write(SERVER_ERROR . "\n");
        },
        on_end => sub {
            undef $_[0];
        },
        on_version => sub {
            $_[0]->push_write("$VERSION:anyevent_skkserv ");
        },
        on_host => sub {
            # unimplemented
            $_[0]->push_write("hostname:addr:...: ");
        },
        on_request => sub {},
        %args,
    }, $class;
}

sub run {
    my $self = shift;
    AnyEvent::Socket::tcp_server $self->{host}, $self->{port}, sub {
        my ($fh, $host, $port) = @_ or die "connection failed: $!";
        my $hdl; $hdl = AnyEvent::Handle->new(
            fh => $fh,
            on_eof => sub {
                $_[0]->destroy;
            },
            on_error => sub {
                $_[0]->destroy;
            },
        );
        $hdl->on_read(sub {
            $hdl->push_read(chunk => 1, sub {
                my ($hdl, $command) = @_;
                if ($command eq CLIENT_END) {
                    $self->{on_end}->(@_);
                } elsif ($command eq CLIENT_REQUEST) {
                    $hdl->push_read(regex => qr/\x20/, sub {
                        chop $_[1];
                        $self->{on_request}->(@_);
                    });
                } elsif ($command eq CLIENT_VERSION) {
                    $self->{on_version}->(@_);
                } elsif ($command eq CLIENT_HOST) {
                    $self->{on_host}->(@_);
                } else {
                    $self->{on_error}->(@_);
                }
            });
        });
    };
}

1;
__END__