Net::Serverをつかってswiftyをサーバ化

やってみた。
Net::Server使えば結構簡単にいろいろできるます
今回は色々やってないですが。

http://search.cpan.org/~rhandom/Net-Server/

もっとエラー処理だとか
なんだかんだでやってもいいとおもいますけど
とりあえずとりあえずで。

package Cache::Swifty::Server;
use strict;
use warnings;
use base qw/Net::Server::PreFork/;

sub process_request {
    my $self = shift;
    my $cache = $self->{server}->{cache};
    my $client = $self->{server}->{client};
    my $line = <$client>;
    $line =~ s/\r?\n$//;
    if ( $line =~ /^(set|get)\s(.+)/ ) {
        my $method = $1;
        my $key    = $2;
        if ( $method eq 'get' ) {
            my $value = $cache->get($key);
            $client->send($value."\r\n");
        } elsif ( $method eq 'set' ) {
            my $data = $self->get_client_send_data;
            $cache->set($key,$data);
        }
    }
}

sub get_client_send_data {
    my $self = shift;
    my $client = $self->{server}->{client};
    my @lines;
    while (defined(my $line = <$client>)) {
        $line =~ s/\r?\n$//;
        last unless $line;
        push @lines, $line;
    }
    return join "\n", @lines;
}

1;

server.pl

#! /usr/bin/perl
use strict;
use warnings;
use Cache::Swifty;
use Cache::Swifty::Server;
use Getopt::Long;
use Pod::Usage;

Getopt::Long::GetOptions(
    '--port=i'           => \my $port,
    '--cache_dir=s'      => \my $cache_dir,
    '--cache_lifetime=i' => \my $cache_lifetime,
    '--man'              => \my $man,
) or pod2usage(2);
Getopt::Long::Configure("bundling");
pod2usage if $man;
pod2usage unless $cache_dir;

my $cache = Cache::Swifty->new({
    dir      => $cache_dir,
    lifetime => $cache_lifetime,
}) or die "can't open cache dir\n";

Cache::Swifty::Server->new(
    {
        port  => $port,
        cache => $cache,
    }
)->run;

__END__
=head1 SYNOPSIS

    $ perl ./server.pl --port=3030 --cache_dir=/path/to/cache --cache_lifetime=10

    Options:
        --port             serverport number
        --cache_dir        swifty cache dier
        --cache_lifetime   swifty cache lifetime
        --man              man page

=head1 DESCRIPTION

    Cache::Swifty server daemon.

=cut

クライアント側も

package Cache::Swifty::Client;
use strict;
use warnings;
use base qw/Class::Accessor::Fast/;
use IO::Socket::INET;
use Storable ();

sub new {
    my ($class, $args) = @_;
    $args ||= {};
    bless {%$args}, $class;
}

sub set {
    my ($self, $key, $val) = @_;
    if ( ref $val ) {
        $val = Storable::nfreeze($val);
    }
    my $socket = $self->_client;
    $socket->send("set $key\r\n$val\r\n");
}

sub get {
    my ($self, $key) =@_;
    my $socket = $self->_client;
    $socket->send("get $key\r\n");

    my @bufs;
    while (defined( my $line = $socket->getline ) ) {
        $line =~ s/\r?\n$//;
        last unless $line;
        push @bufs, $line;
    }
    my $val = join "\n", @bufs;
    my $thawed_val;
    eval{$thawed_val = Storable::thaw($val)} ? $thawed_val : $val;
}

sub _client {
    my $self = shift;
    my $sock = IO::Socket::INET->new(
        PeerAddr => $self->{host} || 'localhost',
        PeerPort => $self->{port} || '3030',
        Proto    => 'tcp',
    ) or die $!;
}

1;

これでざっくりうごきます。

Swiftyは連続でがががーと

my $cache = Cache::Swifty->new({
    dir      => $cache_dir,
    lifetime => $cache_lifetime,
}) or die "can't open cache dir\n";

とかしまくると結構頻繁にファイル読み込みエラーで落ちました。
私の環境がしょぼいからかな。。

CodeReposにいれてもいいでしょうかしら。