#!/usr/bin/perl

use warnings;
use strict;

use Socket;
use Data::Dumper;

use ARDB::SiteConfig;

my $config = ARDB::SiteConfig -> new;
my $path =  $config -> daemon_socket;

my $uaddr = sockaddr_un $path;
my $proto = getprotobyname 'tcp';

socket Server, PF_UNIX, SOCK_STREAM, 0
 or die "\nunable to create socket: $!\n";

unlink $path;
bind Server, $uaddr
 or die "\nunable to bind socket: $!\n";

listen Server, SOMAXCONN;

print "[ ", scalar ( localtime ), " ] server started on '$path'\n";

for ( ; my $paddr = accept ( Client, Server ); close Client )
 {
  print "[ ", scalar ( localtime ), " ] connection on '$path'\n";

  $| = 1;
  
  my %request;

  while ( 1 )
   {
    my $request = <Client>;
    $request =~ s/\n|\r//g;
    last
     unless $request;
    my ( $key, $value ) = ( $request =~ /^([A-Z]+)\s(.*)$/ );
    $request {$key} = $value;
   }
  
  my $source     = $request {SOURCE};
  my $collection = $request {COLLECTION};
  my $update     = $request {UPDATE};
  
  print "[ ", scalar ( localtime ), " ] request:\n source: $source\n collection: $collection\n update: $update\n";
 
 }



__END__

my $ux_sock_addr = '/tmp/control_daemon';



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

unlink $ux_sock_addr;

$server -> bind ( $ux_sock_addr );

die Dumper $server;

print "[", scalar localtime, "] control daemon started\n";

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

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)
 {
  my $client;
  my $rv;
  my $data;

  # check for new information on the connections we have

  # anything to read or accept?
  foreach $client ( $select -> can_read ( 1 ) )
   {

    if ( $client == $server )
     {
      # accept a new connection

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

      unless ( defined ( $rv ) && length $data )
       {
        # This would be the end of file, so close the client
        delete  $inbuffer { $client };
        delete $outbuffer { $client };
        delete     $ready { $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.
      while ( $inbuffer { $client } =~ s/(.*\n)// )
       {
        push( @{ $ready{ $client } }, $1 );
       }
     }
   }

  # Any complete requests to process?
  foreach $client ( keys %ready )
   {
    handle( $client );
   }

  # Buffers to flush?
  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.
      delete $inbuffer { $client };
      delete $outbuffer { $client };
      delete $ready { $client };

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

  # Out of band data?
  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}
  my $client = shift;

  foreach my $request ( @{ $ready { $client } } )
   {
    # $request is the text of the request
    # put text of reply into $outbuffer{$client}
    my $localtime = scalar localtime;
    print "[$localtime] received '$request' request\n";
   }
  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";
 }
