#!/usr/bin/perl -w
# nonforker - server who multiplexes without forking

use strict;
use POSIX;
use IO::Socket::UNIX;
use IO::Select;
use Socket;
use Fcntl;
use Storable qw(freeze);
use Tie::RefHash;

use Data::Dumper;
use NOCpulse::Notif::EscalatorOperation;

sub dprint;
my $debug=1;

my $bailout;
$SIG{'INT'} = $SIG{'TERM'} = sub { $bailout = 1; };

# Determine the socket filename to use

my $SOCKET_FILENAME;
if (@ARGV) {
    $SOCKET_FILENAME=shift();
} else {
    $SOCKET_FILENAME="/tmp/mysock";
}
my $HEADER_BYTES=8;

# Listen to port.
unlink $SOCKET_FILENAME;
my $server = IO::Socket::UNIX->new(Local    => $SOCKET_FILENAME,
                                Type     => SOCK_STREAM,
                                Listen   => 10 )
  or die "Can't make server socket: $@\n";

# begin with empty buffers
my %inbuffer  = ();
my %outbuffer = ();
my %ready     = ();
my %inbytes   = ();

tie %ready, 'Tie::RefHash';

nonblock ($server);
my $select = IO::Select->new($server);

# Main loop: check reads/accepts, check writes, check ready to process
while (1) {

    if ($bailout) {
        dprint 1,"dying gracefully, as requested\n";
        exit(0);
    }

    my $client;
    my $rv;
    my $data;

    # check for new information on the connections we have

    # anything to read or accept?
    dprint 3,"anything to read or accept?\n";
    foreach $client  ($select->can_read(1)) {

        if ($client == $server) {
            # accept a new connection
            dprint 3,"accept a new connection\n";

            $client = $server->accept();
            $select->add($client);
             nonblock($client);
        } else {
            # read data
            dprint 3,"read data\n";
            $data = '';
            $rv = $client->recv($data, POSIX::BUFSIZ, 0);

            unless (defined ($rv) && length $data) {
                # This would be the end of file, so close the client
                dprint 3,"close the client\n";
                delete $inbuffer{$client};
                delete $outbuffer{$client};
                delete $ready{$client};
                delete $inbytes{$client};

                $select->remove($client);
                close $client;
                next;
            }

            $inbuffer{$client} .= $data;    

            # test whether the data in the buffer or the data we
            # just read means there is a complete request waiting
            # to be fulfilled. If there is, set $ready{$client}
            # to the requests waiting to be fulfilled.
            dprint 3,"test for completed request\n";

            unless ($inbytes{$client}) {
            # We don't know how many bytes we should have, figure it out
              if (length($inbuffer{$client}) >= $HEADER_BYTES) {
                $inbytes{$client} = substr($inbuffer{$client},0,$HEADER_BYTES);
                substr($inbuffer{$client},0,$HEADER_BYTES) = '';
              }
            }

            if (length($inbuffer{$client}) == $inbytes{$client}) {
              my $op = NOCpulse::Notif::EscalatorOperation->from_string(
                $inbuffer{$client});
              if ($op) {
                push( @{$ready{$client}}, $op );
              } else {
                die "Something went wrong reading from the client"
              }
            }
        }
    }

    # Any complete requests to process?
    dprint 3,"handle completed requests\n";
    foreach $client (keys %ready) {
        handle($client);
    }

    # Buffers to flush?
    dprint 3,"buffers to flush?\n";
    foreach $client ($select->can_write(1)) {
        # Skip this client if we have nothing to say
        next unless exists $outbuffer{$client};
        $rv = $client->send($outbuffer{$client}, 0);
        unless (defined $rv) {
            # Whine, but move on.
            warn "I was told I could write, but I can't.\n";
            next;
        }
if ($rv  == length $outbuffer{$client} || 
            $! == POSIX::EWOULDBLOCK) {
            substr($outbuffer{$client}, 0, $rv) = ' ';
            delete $outbuffer{$client} unless length $outbuffer{$client};
        } else {
            # Couldn't write all the data, and it wasn't because
            # it would have blocked. Shutdown and move on.
            dprint 3,"couldn't write all the data, shutdown and move on\n";
            delete $inbuffer{$client};
            delete $outbuffer{$client};
            delete $ready{$client};
            $select->remove($client);
            close($client);
            next;
        }
    }

# Out of band data?
dprint 3,"out of band data?\n";
foreach $client ($select->has_exception(0)) { # arg is timeout
        # Deal with out-of-band data here, if you want to.
    }
}

# handle ($socket) deals with all pending requests for $client
sub handle {
     # requests are in $ready{$client}
   # send output to $outbuffer{$client}
    dprint 3," ... handling request\n";
    my $client = shift;
    my $operation;

    foreach $operation (@{$ready{$client}}) {
        # $request is the text of the request
        # put text of reply into $outbuffer{$client}

        dprint 3,"operation: ", &Dumper($operation), "\n";
        my $t=localtime;
        $operation->results("result here: op ($t)");

        my $result = freeze($operation);
        my $length = length($result);
        my $string = sprintf("%${HEADER_BYTES}.${HEADER_BYTES}i%s",$length, $result);
        $outbuffer{$client} = $string;
}
    delete $ready{$client};
}

# nonblock ($socket) puts socket into nonblocking mode
sub nonblock {
    my $socket = shift;
    my $flags;

    $flags = fcntl ($socket, F_GETFL, 0)
            or die "Can't get flags for socket: $!\n";
    fcntl ($socket, F_SETFL, $flags | O_NONBLOCK)
            or die "Can't make socket nonblocking: $!\n";
}

sub dprint {
    my $level=shift;
    if ($level <= $debug) {
      my @params=@_;
      print "$$: ", @params;
    }
}
