package Spline::Socketmap;

use strict;
use warnings;
use base qw(Net::Server::PreFork);

use base 'Exporter';
our @EXPORT = qw( );
our @EXPORT_OK = qw( );

our $timeout = 10;
our $handler = undef; 


sub call_handler($@) {
    die 'No handler configured' unless ref($handler) eq 'CODE';

    return &$handler(@_);
}

sub handle_request($$) {
    my $self = shift;
    my ($data) = @_;

    my ($map, $key) = split(/ /, $data, 2);
    my $result = call_handler($map, $key);
    if (defined $result) {
        $self->reply($result);
    }
    else {
        $self->reply('TEMP Protocol error');
    }
}

sub netstring_read_length($) {
    my $fd = shift;
    my $length;

    local $/ = ':';
    $length = <$fd>;
    die "Cannot read netstring length" unless defined($length);
    chomp $length;

    return $length;
}

sub netstring_read($) {
    my $fd = shift;
    my ($length, $data);

    $length = netstring_read_length($fd);
    if (read($fd, $data, $length) == $length) {
        (getc() eq ',') or die "Closing , missing";
    }
    else {
        die 'Received only ' . length($data) . " of $length bytes";
    }

    return $data;
}

sub netstring_write($$) {
    my ($fd, $data) = @_;

    print $fd length($data).':'.$data.',';
}

sub process_request($) {
    my $self = shift;

    eval {
        local $SIG{'ALRM'} = sub { die "Timed Out!\n" };
        alarm($timeout);

        $self->handle_request(netstring_read(*STDIN));
        alarm(0);
    };
    my $err = $@;
    alarm(0);


    if ($err) {
        if ($err =~ /timed out/i) {
            $self->reply('TEMP Timeout');
        }
        else {
            chomp $err;
            $self->reply("TEMP $err");
        }
    }
}

sub reply($$) {
    my $self = shift;
    my ($data) = @_;

    $self->log(2, $data);
    netstring_write(*STDOUT, $data);
}

1;

# vim: set et ts=4: