package Spline::Socketmap;

use strict;
use warnings;
use Scalar::Util qw( openhandle );

use base qw( Exporter Net::Server::PreFork );
our @EXPORT = qw( );
our @EXPORT_OK = qw(
    lookup
    handle_request
    netstring_read
    netstring_write
    process_request
    socketmap_protocol
);

sub lookup($$$) {
    die 'Not implemented';
}

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

    my ($map, $key) = split(/ /, $data, 2);
    return $self->lookup($map, $key);
}

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

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

    die 'Invalid length' unless $length =~ m/\A\d+\z/;
    return $length;
}

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

    die 'Filehandle required' unless openhandle($fd);

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

    return $data;
}

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

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

sub socketmap_protocol($$) {
    my $self = shift;
    my $input = shift;
    my $result;

    eval {
        local $SIG{'ALRM'} = sub { die "Timed Out!\n" };
        alarm($self->{server}->{timeout} // 0);

        if (ref($input) eq 'CODE') {
            $input = &$input;
        }
        $result = $self->handle_request($input);
        alarm(0);
    };
    my $err = $@;
    alarm(0);

    if ($err) {
        if ($err =~ /timed out/i) {
            return 'TEMP Timeout';
        }
        else {
            chomp $err;
            return "TEMP $err";
        }
    }
    else {
        return $result;
    }
}

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

    my $input = netstring_read(*STDIN);
    $self->log(3, $input);
    return $input;
}

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

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

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

    my $recv = sub { return $self->recv() };
    $self->send($self->socketmap_protocol($recv) // 'TEMP Protocol error');
}

sub options($$) {
    my $self     = shift;
    my $prop     = $self->{'server'};
    my $template = shift;

    $self->SUPER::options($template);

    # Timeout for one request
    $prop->{'timeout'} ||= undef;
    $template->{'timeout'} = \$prop->{'timeout'};
}

sub post_configure_hook {
    my $self = shift;
    my $prop = $self->{'server'};

    if (!defined($prop->{'timeout'}) || $prop->{'timeout'} !~ /^\d+$/) {
        $prop->{'timeout'} = 10;
    }
    elsif ($prop->{'timeout'} < 0) {
        $prop->{'timeout'} = 0;
    }
}

1;

# vim: set et ts=4: