1 files changed, 74 insertions, 29 deletions

diff --git a/Spline/Socketmap.pm b/Spline/Socketmap.pm
index d677166..af31c31 100644
--- a/Spline/Socketmap.pm
+++ b/Spline/Socketmap.pm
@@ -2,34 +2,29 @@ package Spline::Socketmap;
 
 use strict;
 use warnings;
-use base qw(Net::Server::PreFork);
+use Scalar::Util qw( openhandle );
 
-use base 'Exporter';
+use base qw( Exporter Net::Server::PreFork );
 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(@_);
+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) = @_;
+    my $data = shift;
 
     my ($map, $key) = split(/ /, $data, 2);
-    my $result = call_handler($map, $key);
-    if (defined $result) {
-        $self->reply($result);
-    }
-    else {
-        $self->reply('TEMP Protocol error');
-    }
+    return $self->lookup($map, $key);
 }
 
 sub netstring_read_length($) {
@@ -38,9 +33,10 @@ sub netstring_read_length($) {
 
     local $/ = ':';
     $length = <$fd>;
-    die "Cannot read netstring length" unless defined($length);
+    die 'Cannot read netstring length' unless defined($length);
     chomp $length;
 
+    die 'Invalid length' unless $length =~ m/\A\d+\z/;
     return $length;
 }
 
@@ -48,9 +44,12 @@ 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) {
-        (getc() eq ',') or die "Closing , missing";
+        my $char = getc($fd);
+        die "Closing , missing" if not defined $char or $char ne ',';
     }
     else {
         die 'Received only ' . length($data) . " of $length bytes";
@@ -65,32 +64,47 @@ sub netstring_write($$) {
     print $fd length($data).':'.$data.',';
 }
 
-sub process_request($) {
+sub socketmap_protocol($$) {
     my $self = shift;
+    my $input = shift;
+    my $result;
 
     eval {
         local $SIG{'ALRM'} = sub { die "Timed Out!\n" };
-        alarm($timeout);
+        alarm($self->{server}->{timeout} // 0);
 
-        $self->handle_request(netstring_read(*STDIN));
+        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) {
-            $self->reply('TEMP Timeout');
+            return 'TEMP Timeout';
         }
         else {
             chomp $err;
-            $self->reply("TEMP $err");
+            return "TEMP $err";
         }
     }
+    else {
+        return $result;
+    }
 }
 
-sub reply($$) {
+sub recv($) {
+    my $self = shift;
+
+    my $input = netstring_read(*STDIN);
+    $self->log(3, $input);
+    return $input;
+}
+
+sub send($$) {
     my $self = shift;
     my ($data) = @_;
 
@@ -98,6 +112,37 @@ sub reply($$) {
     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: