: # use perl
eval 'exec perl -S $0 "$@"'
if 0;

require "spawn.pl" ; 
require "pf2.pl" ;
require "getopts.pl" ;
 
if ( ! &Getopts('nv') || $#ARGV != 0 )
    { die ( "Usage: $0 [-n] [-v] database\n" ) ; }
 
open ( XHOST, "xhost |" ) ;
while ( <XHOST> ) {
    if ( /access control enabled/ ) { next ; }
    chop ;
    push(@xhosts, $_ ) ;
}
close XHOST ;

if ( @xhosts > 0 ) { 
    die "\nError: xhost enabled for @xhosts.\n\tYou must disable before running dbloc.\n" ; 
}

$busy = "" ; 
&init_params ;
&start_processes ;

&sp_wait ; 


print STDERR "Should never happen: Quitting..\n" ; 
exit 1 ; 


sub commands { 
    local ($src, $msg) = @_ ; 
    print STDERR "$src : $msg\n" ; 
    if ( $msg =~ /quit/ ) { 
	&quit ; 
    } elsif ( $msg =~ /bkg (.*)/ ) { 
	&bkg ( $1 ) ; 
    } elsif ( $msg =~ /log (.*)/ ) { 
	print STDERR "$1\n" ; 
    } elsif ( $msg =~ /start (.*)/ ) { 
	&start($1) ; 
    } elsif ($src eq "buttons") { 
	local ( $dst ) ; 
	($dst, $dmsg) = split ( ' ', $msg, 2 ) ; 
	if ( ! defined $Ran{$dst} ) { 
	    &start($dst) ; 
	}
	if ( $dst eq "group" || $dst eq "assoc" || $dst eq "dblocsat2" || $dst eq "dbgenloc") { 
	    if ( $busy eq "" ) {
		$busy = $dst ;
		print STDERR "sending $src: $msg" ; 
		&sp_print ( $dst, $dmsg ) ; 
	    } else { 
		print STDERR "queuing $src: $msg" ; 
		push (@queue, $src) ; 
		push (@queue, $msg) ; 
	    }
	} else {
	    &sp_print ( $dst, $dmsg ) ; 
	}
    } else { 
	system ( "tksend -p dbloc_buttons 'if { [catch {$msg} result] } { tkerror \$result }' >&2 " ) ;
	if ( $busy eq $src ) { 
	    $busy = "" ; 
	    if ( $#queue > 0 ) {
		$src = shift @queue ; 
		$msg = shift @queue ; 
		print STDERR "unqueuing $src: $msg" ;
		&commands ($src, $msg) ;
	    }
	}
    }
}

sub quit { 
    print "\n\nQuitting\n" ;
    print STDERR "\nQuitting\n\n" ; 
    # print "\n\nCrunching out any null records in database\n\n" ; 
    # system ( "dbcrunch $Input_database origin origerr assoc remark event" ) ; 
    &sp_die ;
    exit 0 ; 
    }

sub start {
    local ( $i ) = @_ ; 
    local ( $cmd ) ; 
    if ( defined $Processes{$i} ) {
	$cmd = $Processes{$i} ; 
	eval ( "\$cmd = \"$cmd\";" ) ; 
	print STDERR "starting $i: $cmd\n" ; 
	&spawn ( $i, $cmd ) ; 
	$Ran{$i} = 1 ;
    } else { 
	print STDERR "No execution line for '$i'\n" ; 
    }
}
    
sub start_processes {
    local ( $i, $cmd ) ; 
    system ( "unregister dbloc_buttons > /dev/null 2>&1 " ) ;
    system ( "unregister dbloc_dbpick > /dev/null 2>&1 " ) ;
    foreach $i ( keys %Processes ) {
	if ( $Run{$i} > 0 ) {
	    &start($i) ; 
	}
    }
    $SIG{'INT'} = "quit" ; 
}
    
sub init_params { 
    local ($editor, $result, $lastidfile, $input ) ; 

    $Input_database = $ARGV[0] ; 

    $nsite = `echo "count()" | dbcalc $Input_database.site` ; 
    chop $nsite ; 
    if ( $nsite < 1 ) 
	{ die ( "No records in $Input_database site table.\n" ) ; }
    $narrival = `echo "count()" | dbcalc $Input_database.arrival` ; 
    chop $narrival ; 
    if ( $narrival < 1 ) 
	{ die ( "No records in $Input_database arrival table.\n" ) ; }

    &copy_pf ( "dbloc2.pf", "edit" ) ; 

    &eval_pf ( "dbloc2.pf" ) ; 

    unlink "$Define{Work_dir}/dbpick_window" ;

    $Trial_database = "$Define{Work_dir}/$Define{Temporary_db}";

    if ( ! -d $Define{"Work_dir"} ) {
	$result = system ( "dbnextid $Input_database orid ; dbnextid $Input_database evid ; dbnextid $Input_database commid" ) ; 
	if ( $result != 0 ) {
	    die ( "Can't update the lastid table -- try 'touch $Input_database.lastid'\n" ) ; 
	    }

	mkdir($Define{"Work_dir"}, 0775 ) ; 
	system ( "dbcp -d $Input_database $Trial_database" ) ; 
	foreach $table ( "origin", "origerr", "assoc", "event", "remark" ) {
	    system ( "touch $Trial_database.$table" ) ;
	}

	if ( ! -d "$Results_dir" ) { 
	    mkdir("$Results_dir", 0775 ) ; 
	}

    } 

    unlink "$Define{Work_dir}/log" ;
    open ( STDERR, ">>$Define{Work_dir}/log" ) ; 

    }

sub my_death_of_child { 
    my ( $name, $pid, $sig, $result ) = @_ ; 
    if ( $name eq "buttons") {
	print STDERR "Forced quit from dbloc_buttons.\n">
	&quit ;
    } else { # look for location programs
	foreach $program ( @location_programs ) { 
	    $program =~ s/[ \t]+.*// ; 
	    if ( $program eq $name ) { 
		&commands ($name, "location_solution: no_solution : $name died\n" ) ; 
	    }
	}
    }
    return ; 
}


# $Id: dbloc2.sh,v 1.5 1998/06/05 21:00:34 danq Exp $ 
