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

use strict;
package osperlserver;
use ObjStore::NoInit ':ADV';
use vars qw($VERSION @DB $DAEMON);
$VERSION = '0.02';
$DAEMON = 1;
my $default_server = 'ObjStore::ServerDB';

for (my $arg=0; $arg < @ARGV; $arg++) {
    my $o = $ARGV[$arg];
    if ($o =~ m/^ -d (ebug)? $/x) {
	# different flavors?
	++$ObjStore::Notification::DEBUG_RECEIVE;
    } elsif ($o =~ m/^ -F (ore(ground)?)? $/x) {
	$DAEMON = 0;
    } 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/^-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/^-/) {
#	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) {
    require Proc::Daemon;          #available via CPAN
    Proc::Daemon::init();
}
$SIG{HUP} = sub { warn "SIGHUP" if !$DAEMON };

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

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

ObjStore::initialize();
require ObjStore::Process;
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::Process'} =
	    ObjStore::Process->new($DB);  #inheritance? XXX
    };
    die if $@;

    begin 'update', sub {
	my $top = $DB->hash;
	bless $top, $class.'::Top' if
	    $class ne $default_server || blessed $top eq 'ObjStore::HV';
	$top->boot(split /,/, $_->[2]);
	my %objs;
	for (values %$top) { $objs{$_} = $_ if blessed $_ }
	for (values %objs) {
	    # not much point in checking is_evolved...
	    $_->evolve();
	}
	$top->restart() if $top->can('restart');
	for (values %objs) {
	    $_->restart() if $_->can('restart');
	}
    };
    die if $@;
}

ObjStore::Process->set_mode('update');
ObjStore::Process->autonotify();

eval q{ END{ warn "exiting...\n"; } }; #otherwise confusing
warn "Started!!\n";
ObjStore::Process->Loop();

sub usage {
    print "
Usage: osperlserver [switches] database[=Class[+Class[,Class]]] [databases...]
  -F[oreground]    do not fork
  -Idirectory      specify @INC directory (may be used more than once)
  -[mM]module..    executes `use/no module...' (just like perl)
  -v               print version number and patchlevel of osperlserver

    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')

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

";
    exit;
}
