#!/nw/dev/usr/bin/perl -w

use strict;
package osperlserver;
use ObjStore::NoInit ':ADV';
use vars qw($VERSION @DB $DAEMON $Loop $LoopMeth %Debug $Shutdown $AutoReloader);
$VERSION = '1.01';
$DAEMON = 1;
$LoopMeth = 'defaultLoop';
my $default_server = 'ObjStore::ServerDB';

for (my $arg=0; $arg < @ARGV; $arg++) {
    my $o = $ARGV[$arg];
    if ($o =~ m/^ -d(ebug)? $/x) {
	warn "debug will no flags\n";
	&usage;
    } elsif ($o =~ m/^ -F (ore(ground)?)? $/x) {
	$DAEMON = 0;
	warn "please use the '-dF' option instead\n";
    } elsif ($o =~ m/^-d(\w+)$/) {
	# this style is preferred
	for my $d (split / */, $1) {
	    if ($d eq 'F') {
		$DAEMON = 0;
	    } elsif ($d eq 'n') {
		#ok
	    } elsif ($d eq 'b') {
		#ok
	    } else {
		warn "unrecognized debug option '$d' (ignored)\n";
	    }
	    ++$Debug{$d};
	}
    } elsif ($o =~ m/^ \- (M|m) ([\w:]+) (\=\w+)? $/x ) {
	my ($way,$m,@im) = ($1,$2,$3?substr($3,1):());
        eval "require $m";
	warn, next if $@;
	if ($way eq 'M') {
	    $m->import(@im);
	} else {
	    $m->unimport(@im);
	}
    } elsif ($o =~ m/^-loop$/) {
	$LoopMeth = $ARGV[++$arg];

    } elsif ($o =~ m/^-I (\S*) $/x) {
	my $dir = $1;
	$dir = $ARGV[++$arg]
	    if !$dir;
	if ($dir =~ m{^ \/ }x) {
	    unshift @INC, $dir;
	} else {
	    require FindBin;
	    die "osperlserver: can't find myself" if !$FindBin::Bin;
	    unshift(@INC, "$FindBin::Bin/$dir");
	}
    } elsif ($o =~ m/^-shutdown/) {
	$Shutdown = $ARGV[++$arg];
    } elsif ($o =~ m/^-((no)?)reload/) {
	$AutoReloader = $1 eq 'no'? 0 : 1;
    } elsif ($o !~ m/^-/) {
#	warn "osperlserver: database.db is boring" if $o =~ m/\.db$/;
	push @DB, $o;
    } elsif ($o =~ m/^-v$/) {
	require ObjStore;
	print "osperlserver $VERSION ($ObjStore::VERSION)\n";
	exit;
    } elsif ($o =~ m/^-h(elp)?$/) {
	&usage;
    } else {
	warn "unknown option '$o' (-h for usage)\n";
    }
}
&usage if @DB==0;

open(STDOUT, ">&STDERR") or die "can't redirect STDOUT: $!";
if ($DAEMON) {
    # all forking must happen before ObjStore::initialize!
    require Proc::Daemon;
    Proc::Daemon::init();
}
$SIG{HUP} = $DAEMON ? 'IGNORE' : sub { warn "SIGHUP" };

for (@DB) {
    # Not foolproof... Hm.
    if (m/^(.*) \= (.*) \+ (.*)$/x) {
	# depreciated?
	$_ = [$1,$2,$3];

    } elsif (m/^(.*) \+\= (.*)$/x) {
	$_ = [$1,$default_server,$2];

    } elsif (m/^(.*) \= (.*)$/x) {
	# depreciated?
	$_ = [$1,$2,''];

    } else {
	$_ = [$_,$default_server,''];
    }
}

ObjStore::fatal_exceptions(0);
$ObjStore::CLIENT_NAME = 
    "osperl[".join(',',map { $_->[0] =~ m,/([^/]+)$, ? $1:$_->[0] } @DB)."]";

ObjStore::initialize();
require ObjStore::Server;
for (@DB) {
    no strict 'refs';
    my $class = $_->[1];
    unless (defined %{"$class\::"}) {
	my $file = $class;
	$file =~ s,::,/,g;
	require "$file.pm";
    }

    my $DB = $class->new($_->[0], 'update');
    $DB->subscribe();
    bless $DB, $class if
	$class ne $default_server || blessed $DB eq 'ObjStore::Database';

    begin 'update', sub {
	# hostile takeover
	$DB->hash->{'ObjStore::Server'} = ObjStore::Server->new($DB);
    };
    die if $@;

    begin 'update', sub {
	my $top = $DB->hash;
	bless $top, $class.'::Top' if
	    $class ne $default_server || blessed $top eq 'ObjStore::HV';
	my @boot = split /,/, $_->[2];
	$top->boot(@boot);
	$top->restart() if $top->can('restart'); #dubious
	
	# Restart top level objects until no more are created.
	# Is order important?
	my %objs;
	while (1) {
	    my $more = 0;
	    for my $z (values %$top) {
		next if !blessed $z || exists $objs{ $z };
		++$more;
		$objs{$z} = $z;
	    }
	    last if !$more;
	    for my $k (keys %objs) {
		my $o = $objs{$k};
		next if !ref $o;
		$o->restart() if $o->can('restart');
		$objs{$k} = undef;

		# allow override of default event loop stuff
		$Loop = ref $o if !$Loop && $o->isa('osperlserver'); #?
	    }
	}

	# default to our built-in event dispatch service
	if (!$Loop) {
	    $Loop = 'ObjStore::Serve';
	    $top->do_boot_class($Loop)->restart;
	}
    };
    die if $@;
}

# checkpoint timer should be a command line option?

if ($AutoReloader) {
    require Module::Reload;
    $Module::Reload::Debug = $Module::Reload::Debug = 1;
    Event->timer(interval => 1, callback => sub { Module::Reload->check });
}
if ($Shutdown) {
    require Date::Manip;
    Date::Manip->import();
    my $at = ParseDate($Shutdown);
    warn "osperlserver: do not understand -shutdown '$Shutdown' (ignored)\n"
	if !$at;
    # assumes that Event is in control... XXX
    Event->timer(interval => 60, callback => sub {
		     my $d = DateCalc('now',$at);
		     if ($d !~ m/^\+/) {
			 warn "shutdown at ".UnixDate($at,"%u")."\n";
			 kill 'TERM', $$;  #dangerous? XXX
		     }
		 });
}

my $why;

eval q[ END{ warn $why || 'exiting...'; } ];
warn '@ARGV = '.join(' ',@ARGV)."\n";
warn "Started!!\n";

eval {
    if ($Loop->can('Loop')) {
	$why = $Loop->Loop();
    } elsif ($Loop->can($LoopMeth)) {
	$why = $Loop->$LoopMeth()
    } else {
	die "fatal: $Loop can't Loop or '$LoopMeth'";
    }
};
$why = $@ if $@;

sub usage {
    print "
Usage: osperlserver [switches] database[=Class[+Class[,Class,..]]] [databases..]
  -d\\w+
     b              enable boot diagnostics
     n              print notifications to STDERR
     F              do not fork
  -Idirectory       specify \@INC directory (may be used more than once)
  -loop <method>    use a different event loop method [defaultLoop]
  -[mM]module..     executes `use/no module...' (just like perl)
  -(no)reload       run Module::Reload every second (requires Event)
  -shutdown <when>  exit at <when> (requires Event & Date::Manip)
  -v                print version number (and exit)

    server:/full/path/to/database
       $default_server->new(...); boot();

    server:/full/path/to/database+=My::Class1,My::Class2
       $default_server->new(...); boot('My::Class1','My::Class2')

";
    exit;
}
