#!/opt/bin/perl

##########################################################################
## All portions of this code are copyright (c) 2003,2004 nethype GmbH   ##
##########################################################################
## Using, reading, modifying or copying this code requires a LICENSE    ##
## from nethype GmbH, Franz-Werfel-Str. 11, 74078 Heilbronn,            ##
## Germany. If you happen to have questions, feel free to contact us at ##
## license@nethype.de.                                                  ##
##########################################################################

use Getopt::Long ();
use common::sense;
use EV;
use AnyEvent ();
use AnyEvent::Socket ();
use AnyEvent::Fork ();

sub usage {
   print <<EOF;
Usage: $0 [opts...]
       -h | --help                  this list
       -v | --verbose               be more verbose
       -q | --quiet                 be very quiet
       -V | --version               show version

       -l | --listen /unix/domain/socket
       -l | --listen ip:port        bind on given port

       -p | --preload-obj PATH/GID  preload the given object
       -n | --preload-ns  PATH/GID  preload objects from namespace

       -r | --refresh seconds       agni refresh interval

       -m | --max-worker integer    maximum worker number
       --max-idle integer           maximum number of idle workers
       --idle seconds               idle timeout

EOF
   exit $_[0];
}

@ARGV or usage 0;

our $VERSION    = 0.1;

our $VERBOSE    = 1;
our $MAX_WORKER = 8;
our $IDLE_TIME  = 600;
our $MAX_IDLE   = 2;
our $REFRESH    = 50; # call agni_refresh every 60s

our $LISTEN;
our @PRELOAD_OBJ;
our @PRELOAD_NS;

Getopt::Long::Configure "bundling", "no_ignore_case";
Getopt::Long::GetOptions
      "help|h"     => sub { usage 0 },
      "verbose|v"  => sub { ++$VERBOSE },
      "quiet|q"    => sub { --$VERBOSE },
      "version|V"  => sub { print "$VERSION\n"; exit 0 },

      "listen|l=s"      => \$LISTEN,
      "preload-obj|p=s" => \@PRELOAD_OBJ,
      "preload-ns|n=s"  => \@PRELOAD_NS,

      "max-worker|m=i"  => \$MAX_WORKER,
      "refresh=i"       => \$REFRESH,
      "max-idle=i"      => \$MAX_IDLE,
      "idle=i"          => \$IDLE_TIME,
;

my $fork;
my $fork_refresh;
my $idle;
my %idle;
my $idler;
my $worker;
my %worker;
my $idlecheck;

sub idlecheck {
   print "idlecheck $idle $MAX_IDLE\n";
   warn "[$$] run.\n";

   if ($idle <= $MAX_IDLE) {
      undef $idlecheck;
   } else {
      my $next = 1e99;

      while (my ($k, $v) = each %idle) {
         if ($v->[0] + $IDLE_TIME <= AE::now) {
            print "[$$] reaping idle worker.\n" if $VERBOSE >= 2;
            $v->[1]();
            $next = AE::now + 1 - $IDLE_TIME;
            keys %idle; # reset iterator
            last;
         } else {
            $next = $v->[0] if $v->[0] < $next;
         }
      }

      warn "next idlecheck in ", $next + $IDLE_TIME - AE::now;#d#
      $idlecheck = AE::timer $next + $IDLE_TIME - AE::now, 0, \&idlecheck;
   }
}

sub add_workers;

sub add_worker {
   if ($worker >= $MAX_WORKER) {
      print "[$$] maximum number of workers reached.\n" if $VERBOSE;
      return;
   }

   ++$worker;
   ++$idle;

   print "[$$] adding worker $worker, $idle.\n" if $VERBOSE >= 2;

   $fork->fork->run ("PApp::SCGI::run", sub {
      my $fh = shift
         or die "$!: unable to start master worker.\n";

      my $rw;
      my $state = "i";

      my $stop = sub {
         print "[$$] $fh worker stopped.\n" if $VERBOSE >= 2;
         undef $rw;
         --$idle if delete $idle{$fh};
         --$worker;
      };

      $idle{$fh} = [AE::now, $stop];

      $rw = AE::io $fh, 0, sub {
         if (sysread $fh, my $buf, 1) {
            if ($state ne $buf) {
               $state = $buf;

               if ($state eq "i") {
                  print "[$$] worker became idle.\n" if $VERBOSE >= 4;
                  $idle{$fh} = [AE::now, $stop];

                  $idlecheck ||= AE::timer $IDLE_TIME, 0, \&idlecheck
                     if ++$idle > $MAX_IDLE;

               } elsif ($state eq "b") {
                  delete $idle{$fh};
                  --$idle;
                  add_workers;
               }
            }

         } elsif ($! != Errno::EINTR) {
            print "[$$] $fh worker error: $!.\n" if $VERBOSE;
            $stop->();
            add_workers;
         }
      };
   });
}

sub add_workers {
   add_worker
      while !$idle && $worker < $MAX_WORKER;
}

{
   my ($host, $port) = AnyEvent::Socket::parse_hostport $LISTEN
      or die "$LISTEN: cannot parse bind specification (try host:port or /unix/socket)\n";

   AnyEvent::Socket::tcp_bind $host, $port, sub {
      $LISTEN = shift;

      $fork = AnyEvent::Fork
         ->new_exec
         ->require ("PApp::SCGI")
         ->eval ("&PApp::SCGI::master_init", $VERBOSE)
         ->eval ("&PApp::SCGI::master_preload_obj", @PRELOAD_OBJ)
         ->eval ("&PApp::SCGI::master_preload_ns" , @PRELOAD_NS )
         ->send_fh ($LISTEN)
         ->send_arg ($REFRESH);

      $fork_refresh = AE::timer $REFRESH, $REFRESH, sub {
         $fork->eval ("PApp::SCGI::master_refresh")
      };

      print "[$$] up and running.\n" if $VERBOSE;

      add_workers;
   };
}

EV::loop;


