#!/bin/sh

## SeqInsert - client/server utility to guarantee sequential execution of
##               metadata insertions
## Version 7.0
## Written May 2001 by Peter Shawhan
## Updated Sep 2001 by Peter Shawhan: submit can specify database; added purge
## Updated Oct 2001 by Peter Shawhan to add "hold" command
## Updated Jun 2002 by Peter Shawhan to add "error_exec" command
## Updated Dec 2002 by Peter Shawhan for robustness improvements
## Updated Sep 2005 by Peter Shawhan to allow connecting to a server running
##                                       on a different host
## Updated Jul 2006 by Peter Shawhan to use the ldasjob library instead of dfm

## The next line tells sh to execute the script using tclsh \
exec tclsh "$0" ${1+"$@"}

set auto_path "/ldas/lib $auto_path"
package require ldasjob

catch { source /ldas_usr/ldas/test/bin/AllTest.rsc }
;## override some defaults
if	{ [ file exist AllTest.rsc ] } {
	source AllTest.rsc
} 

;## override GSI and globus settings via env
if	{ [ info exist ::env(USE_GLOBUS_CHANNEL) ] } {
	set  ::USE_GLOBUS_CHANNEL [ set ::env(USE_GLOBUS_CHANNEL) ]
}

if	{ [ info exist ::env(USE_GSI) ] } {
	set  ::USE_GSI [ set ::env(USE_GSI) ]
}

##=========================================================================
## Name: Main
##
## The ::state variable is the key to the sequencing.  Its values are:
##   init - Means the process is starting up.  Clients can connect and send
##            input during this period, but the requests will just be queued
##            and no jobs will be submitted to LDAS yet.
##   idle - No job is currently running.  This state persists if and only if
##            the queue is empty.
##   hold - No job is currently running, and job submission is suspended.
##            Jobs will still be queued.
##   pend - The queue has at least one item in it, and a call to SubmitOne
##            has been scheduled.
##   run - A job has been submitted to LDAS, and we are waiting for it to
##            complete.
##   error - An error has occurred.  No more jobs will be submitted to LDAS.
##   shutdown - In the shutdown sequence, waiting for an LDAS job to finish
##            and/or one or more clients to finish their transactions.
##
## SeqInsert is entirely event-driven and non-blocking, so clients can connect
## and send input regardless of the current ::state.

proc Main {} {

    global argc argv hostname

    ;##- Set default host name - may be overridden on the command line
    set hostname [info hostname]

    ;##- Check whether a hostname was specified
    set host_specified 0
    set iarg [lsearch -exact $argv "-host"]
    if { $iarg >= 0 && $iarg < $argc-1 } {
	set host_specified 1
	#-- Pick out the specified host name
	set hostname [lindex $argv [expr {$iarg+1}]]
	#-- Remove the host specification from the argument list
	set argv [lreplace $argv $iarg [expr {$iarg+1}]]
	incr argc -2
    }

    ;##- Check whether debug flag was specified
    set ::debug 0
    set iarg [lsearch -exact $argv "-d"]
    if { $iarg >= 0 } {
	set ::debug 1
	#-- Remove the flag from the argument list
	set argv [lreplace $argv $iarg $iarg]
	incr argc -1
    }

    ;##- Trim away the domain, if any, from the hostname
    regsub {\..*} $hostname {} hostname

    ;##- Parse command-line arguments
    if { $argc == 0 } {
	puts "Usage:"
	puts "  SeqInsert server <database> \[<ldasuser>\]"
	puts "     <database> examples:  dev, lho, lho:lho_test, myhost:10001,"
	puts "         myhost.caltech.edu:10001, myhost:10001:lho_test"
	puts "     <ldasuser> is an LDAS username; if omitted, the\
		'default' username in"
	puts "         ~/.ldaspw is used.  The password is read from\
		~/.ldaspw in any case."
	puts "  SeqInsert submit <file> \[<database>\]     --\
		Submits a file to be inserted"
	puts "     If <database> is specified, it overrides the value\
		specified when the"
	puts "         server was started.  In addition to the forms\
		above, you can specify"
	puts "         just the database instance name,\
		e.g. ':lho_test' or ':%s_test' ;"
	puts "         in the latter form, %s is replaced by the base name\
		of the database"
	puts "         that was specified when the server was started,\
		e.g. 'lho'"
	puts "  SeqInsert check \[<user>\]      -- Reports state of SeqInsert"
	puts "     <user> is a unix username (if other than yourself)"
	puts "  SeqInsert error_exec \[<cmd>\]  --\
		Registers a shell command to be executed"
	puts "                                  \
		(e.g. to send email) when SeqInsert requires"
	puts "                                  \
		human intervention.  If <cmd> is omitted, any"
	puts "                                  \
		currently registered command is deleted."
	puts "  SeqInsert hold \[<user>\]       -- Suspends submission of\
		LDAS jobs until"
	puts "                                   'SeqInsert continue' is\
		invoked"
	puts "  SeqInsert retry \[<user>\]      -- If in error state,\
		resubmits same file"
	puts "  SeqInsert continue \[<user>\]   -- If in error state,\
		goes on to next file;"
	puts "                                   if in 'hold' state, continues\
		with next file"
	puts "  SeqInsert shutdown   -- Shut down gracefully"
	puts "  SeqInsert drain      -- Wait for all queued jobs to run,\
		then shut down"
	puts "  SeqInsert purge      -- Purge all files from queue"
	puts ""
	puts "For all client operations (i.e. all subcommands except 'server'), you can"
	puts "connect to a server running on a different host by specifying '-host <host>'"
	puts "on the command line.  However, the server host must have the same home"
	puts "filesystem as the machine you are running the command on."
	exit 1
    }

    set operation [lindex $::argv 0]
    set unixuser ""
    set error_exec_arg ""
    if { $operation == "server" } {
	if { $argc < 2 } {
	    puts "Missing database specification --\
		    type 'SeqInsert' alone for syntax info"
	    exit 1
	} elseif { $host_specified } {
	    puts "Host cannot be specified when starting server --\
		    type 'SeqInsert' alone for syntax info"
	    exit 1
	} elseif { $argc > 3 } {
	    puts "Too many arguments -- type 'SeqInsert' alone for syntax info"
	    exit 1
	}
    } elseif { $operation == "submit" } {
	if { $argc == 1 } {
	    puts "Missing filename to insert --\
		    type 'SeqInsert' alone for syntax info"
	    exit 1
	} elseif { $argc > 3 } {
	    puts "Too many arguments -- type 'SeqInsert' alone for syntax info"
	    exit 1
	}
    } elseif { $argc > 2 } {
	puts "Too many arguments -- type 'SeqInsert' alone for syntax info"
	exit 1
    } elseif { $argc > 1 } {
	if { $operation == "shutdown" || $operation == "drain" } {
	    puts "*** Error: you cannot shut down someone else's\
		    SeqInsert server"
	    exit 1
	} elseif { $operation == "purge" } {
	    puts "*** Error: you cannot purge someone else's SeqInsert queue"
	    exit 1
	} elseif { $operation == "error_exec" } {
	    set error_exec_arg [lindex $::argv 1]
	} else {
	    set unixuser [lindex $::argv 1]
	}
    }

    ;##- Initialize some global variables 
    set ::shutdownFlag 0
    set ::shutdownClients {}
    set ::drainClients {}
    set ::holdFlag 0
    set ::clientConnections 0
    set ::queue {}
    set ::queuedb {}
    set ::queueFile ~${unixuser}/.SeqInsertQueue.$hostname
    set ::registerFile ~${unixuser}/.SeqInsertRegister.$hostname
    if $::debug {
	puts "Register file is $::registerFile (exists?\
	    [file exists $::registerFile])"
    }
    set ::state "init"
    set ::currentFile ""
    set ::currentFiledb ""
    set ::retryCounter 0
    set ::error_exec_cmd ""

    ;##- Connect to SeqInsert server, if it is already running on this node
    if $::debug {puts "Connecting to server"}
    set sock [ConnectSeqInsert]

    ;##- If operation is anything other than "server", do it now
    if { $operation != "server" } {

	;##- If operation is "submit", then we can execute it whether or
	;##- not SeqInsert is currently running
	if { $operation == "submit" } {

	    ;##- Get the name of the input file, with full path
	    set infile [lindex $::argv 1]
	    if { [file pathtype $infile] == "relative" } {
		set infile [file join [pwd] $infile]
	    }

	    ;##- Make sure that file exists and is readable
	    if { ! [file readable $infile] } {
		puts "*** Error: file does not exist or is not readable:\
			$infile"
		exit 1
	    }

	    ;##- See if a database was explicitly specified
	    if { [llength $::argv] > 2 } {
		set database [lindex $::argv 2]
	    } else {
		set database ""
	    }

	    if { $sock == "" } {
		;##- SeqInsert is not running; just append to the queue file
		if { [catch {open $::queueFile a} fid] } {
		    puts "*** Error: cannot open queue file for appending"
		    exit 1
		}
		puts $fid "submit $infile $database"
		close $fid
	    } else {
		;##- Tell SeqInsert to submit the file
		puts $sock "submit $infile $database"
		flush $sock
		close $sock
	    }

	    exit 0
	}

	;##- If we get here, then the operation is not "server" or "submit"

	;##- If server is not running, we handle the "purge" command ourself
	if { $sock == "" && $operation == "purge" } {
	    ;##- Just delete the queue file, if any
	    if { [file exists $::queueFile] } {
		if { [catch {file delete $::queueFile}] } {
		    puts "*** Error deleting queue file"
		    exit 1
		}
	    }
	    exit 0
	}

	;##- Any other operation requires the server to be running
	if { $sock == "" } {
	    if { $unixuser == "" } {
		puts "SeqInsert server is not being run by you on $hostname"
	    } else {
		puts "SeqInsert server is not being run on $hostname\
			by user $unixuser"
	    }
	    exit 1
	}

##	puts "SeqInsert server is running"

	switch -glob -- $operation {

	    error_exec {
		puts $sock [list "SeqInsertErrorExec" $error_exec_arg]
		flush $sock
	    }

	    check {
		puts $sock "EchoSeqInsertState" ; flush $sock
		if { [gets $sock line] >= 0 } {
		    puts "State is $line"
		}
	    }

	    hold {
		puts $sock "SeqInsertHold" ; flush $sock
		if { [gets $sock line] >= 0 } {
		    puts $line
		}
	    }

	    retry {
		puts $sock "SeqInsertRetry" ; flush $sock
	    }

	    cont* {
		puts $sock "SeqInsertContinue" ; flush $sock
	    }

	    purge {
		puts $sock "SeqInsertPurge" ; flush $sock
	    }

	    shutdown {
		puts $sock "SeqInsertShutdown" ; flush $sock
		;##- Block until SeqInsert closes this socket
		set ignore [read $sock]
		puts "SeqInsert has been shut down"
	    }

	    drain {
		puts $sock "SeqInsertDrain" ; flush $sock
		;##- Block until SeqInsert responds and closes this socket
		set msg [read $sock]
		if { [regexp {^drained} $msg] } {
		    catch {exec SeqInsert shutdown} msg
		    puts $msg
		} else {
		    puts $msg
		}
	    }

	    default {
		puts "Invalid operation '$operation' --\
			type 'SeqInsert' alone for syntax info"
		exit 1
	    }
	}

	catch { close $sock }
	exit 0
    }

    ;##- If we get to this point, then the operation is "server"

    if { $sock != "" } {
	puts "SeqInsert server is already running on $hostname"
	puts stderr "SeqInsert server is already running on $hostname"
	catch { close $sock }
	exit 1
    }
    puts "Verified that you are not running any other SeqInsert server\
	    on this node"

    ;##- Parse arguments
    set database [string tolower [lindex $::argv 1]]
    if { $argc > 2 } {
	set ::ldasuser [lindex $::argv 2]
	puts "Using LDAS username $::ldasuser"
    } else {
	set ::ldasuser ""
	puts "Using default LDAS username from ~/.ldaspw"
    }

    puts "SeqInsert server started on $hostname\
	    at [clock format [clock seconds]]"
    puts "Will insert into database $database unless overridden"

    ;##- Separate the "database", as specified by the user, into the LDAS
    ;##- manager and the database instance name, if specified.
    if { ! [regexp {^(.+):(\D[^:]*)$} $database match ::manager ::dbname] } {
	set ::manager $database
	set ::dbname ""
    }

    ;##- Open a listening socket
    set ::port [OpenListen 0 ClientConnect]
    if { $::port == 0 } {
	puts "*** Error opening listening socket"
	puts stderr "SeqInsert error opening listening socket"
	exit 1
    }
    puts "Opened listening socket on port $::port"

    ;##- Write out the register file
    if { [catch {open $::registerFile w} fid] } {
	puts "*** Error opening $::registerFile for writing"
	puts stderr "SeqInsert error opening $::registerFile for writing"
	exit 1
    }
    set ::key [clock clicks]
    if { $::key < 0 } { set ::key [expr {-$::key}] }
    puts $fid "$::port $::key"
    close $fid
    puts "Wrote register file"

    ;##- Set up an event to check the queue file, after a brief delay (to
    ;##- allow an overlap period during which clients can either connect
    ;##- to SeqInsert or append to the queue file, with the same result).
    ;##- CheckQueueFile updates ::state to either "idle" or "pend"
    after 1000 CheckQueueFile

    ;##- Now enter the event loop
    vwait ::SHUTDOWN

    puts "SeqInsert server shutdown at [clock format [clock seconds]]"

    ;##- Explicitly close any "shutdown" client connections
    foreach sock $::shutdownClients {
	catch { close $sock }
    }

    exit 0
}


##=========================================================================
## Name: ConnectSeqInsert
##
## Returns socket ID if connection succeeds, otherwise returns ""

proc ConnectSeqInsert {} {
    if $::debug {puts "In ConnectSeqInsert"}

    ;##- Try to open the register file and read a line out of it
    if { [catch {open $::registerFile r} fid] } { return "" }
    if { [gets $fid line] < 0 } { return "" }
    close $fid

    ;##- Break up the line into the port and key
    if { ! [regexp {^(\d+)\s+(\d+)} $line match port key] } { return "" }
    if $::debug {puts "Checking port $port with key $key"}

    ;##- Try to connect to the SeqInsert server
    if { [catch {socket $::hostname $port} sid] } {
	if $::debug {
	    puts "Attempt to connect to socket $::hostname $port\
                  failed with message: $sid"
	}
	return ""
    }
    if $::debug { puts "Sending EchoSeqInsertKey" }
    puts $sid "EchoSeqInsertKey"
    flush $sid

    ;##- Setup a fileevent and a timeout timer
    set ::connectSeqInsert ""
    fileevent $sid r "set ::connectSeqInsert \[gets $sid\]"
    set evtid [after 5000 "set ::connectSeqInsert timeout"]

    ;##- Wait for a response, or for a timeout
    vwait ::connectSeqInsert
    if $::debug { puts "::connectSeqInsert is $::connectSeqInsert" }

    after cancel $evtid
    set retkey $::connectSeqInsert
    unset ::connectSeqInsert

    ;##- Check whether a timeout occurred, or if key doesn't match
    if { $retkey == "timeout" || \
	    ! [string equal $retkey $key] } {
	catch { close $sid }
	return ""
    }

    ;##- SeqInsert is alive and well!
    return $sid
}


##=========================================================================
## Name: CheckQueueFile
##

proc CheckQueueFile {} {

    ;##- If any files have been added to the in-memory queue, we will need
    ;##- to refresh the queue file after merging the two
    if { [llength $::queue] > 0 } {
	set update 1
    } else {
	set update 0
    }

    ;##- If a queue file exists, read its contents
    set prequeue {}
    set prequeuedb {}
    if { ! [catch {open $::queueFile r} fid] } {
	while { [gets $fid line] >= 0 } {
	    if { [regexp {^submit\s+(\S+)(.*)$} $line match file database] } {
		lappend prequeue $file
		lappend prequeuedb [string trim $database]
	    }
	}
	close $fid
    }

    ;##- If any files were read from the file, stick them at the BEGINNING
    ;##- of the queue.
    set ::queue [concat $prequeue $::queue]
    set ::queuedb [concat $prequeuedb $::queuedb]

    ;##- If necessary, rewrite the queue file
    if { [llength $::queue] == 0 } {
	if { [file exists $::queueFile] } {
	    if { [catch {file delete $::queueFile}] } {
		puts "*** Error deleting queue file"
		puts stderr "SeqInsert error deleting queue file"
		exit 1
	    }
	}
    } elseif { $update } {
	if { [catch {open $::queueFile w} fid] } {
	    puts "*** Error updating queue file"
	    puts stderr "SeqInsert error updating queue file"
	    exit 1
	}
	foreach qfile $::queue qdb $::queuedb {
	    puts $fid "submit $qfile $qdb"
	}
	close $fid
    }

    ;##- Make entries in the log file
    foreach qfile $::queue qdb $::queuedb {
	puts "[Timestamp] queued $qfile $qdb"
    }

    ;##- Change the state from "init" to something else
    set ::state "idle"

    ;##- Check whether we should enter the 'hold' state
    HoldCheck

    ;##- Check whether anyone is waiting for the queue to drain
    DrainCheck

    ;##- Check whether we should shut down now
    if { [ShutdownCheck] } { return }

    ;##- If the queue is not empty, schedule a call to submit a file.
    if { $::state == "idle" && [llength $::queue] > 0 } {
	after 0 SubmitOne
	set ::state "pend"
    }

    return
}


##=========================================================================
## Name: OpenListen
##

proc OpenListen { port connector } {

    if { [catch {socket -server $connector $port} ::listenSock] } {
        return 0
    }

    set portinfo [fconfigure $::listenSock -sockname]
    set port [lindex $portinfo 2]

    return $port
}


##=========================================================================
## Name: ClientConnect
##
## Sets up a callback to ClientInput to handle data arriving on the socket.

proc ClientConnect { clisock addr port } {

##    puts "ClientConnect: accepted $clisock from $addr port $port\
##	    at [clock format [clock seconds]]"

    incr ::clientConnections

    ;##- Configure the socket
    fconfigure $clisock -buffering line -blocking 0

    ;##- Set up a fileevent to handle input on the socket
    fileevent $clisock readable "ClientInput $clisock"

    return
}


##=========================================================================
## Name: ClientInput
##

proc ClientInput { clisock } {

    set close 0

    if { [eof $clisock] } {
	set close 1
    } elseif { [catch {gets $clisock line} nchars] || $nchars == 0 } {
	set close 1
    }

    ;##- If the socket data is complete, do something
    if { $close == 1 } {
##	puts "Closing $clisock"
	close $clisock

	;##- Decrement number of client connections, unless this is a
	;##- "shutdown" or "drain" client
	set i [lsearch -exact $::shutdownClients $clisock]
	set j [lsearch -exact $::drainClients $clisock]
	if { $i > -1 } {
	    ;##- Remove this from the list of "shutdown" clients
	    set ::shutdownClients [lreplace $::shutdownClients $i $i]
	} elseif { $j > -1 } {
	    ;##- Remove this from the list of "drain" clients
	    set ::drainClients [lreplace $::drainClients $j $j]
	} else {
	    incr ::clientConnections -1
	}

	;##- Check whether we should shut down now
	ShutdownCheck

	return
    }

    ;##- If we get to this point, then we successfully read a line
##    puts "On client $clisock, received $line."

    ;##- If this is a "shutdown" or "drain" client, ignore any input
    if { [lsearch -exact $::shutdownClients $clisock] > -1 } { return }
    if { [lsearch -exact $::drainClients $clisock] > -1 } { return }

    ;##- Handle the error_exec case first
    if { [regexp {SeqInsertErrorExec} $line] } {
	set newcmd [lindex $line 1]

	;##- If we are currently in the error state, and no command was
	;##- registered before now, then execute the command
	if { $::state == "error" && [string is space $::error_exec_cmd] \
		&& ! [string is space $newcmd] } {
	    catch { eval exec $newcmd }
	}

	set ::error_exec_cmd $newcmd

	if { [string is space $newcmd] } {
	    puts "Deregistered error_exec command"
	} else {
	    puts "Registered error_exec command: $newcmd"
	}
	return
    }

    switch -- $line {

	"EchoSeqInsertKey" {
	    catch { puts $clisock $::key ; flush $clisock }
	}

	"EchoSeqInsertState" {
	    catch { puts $clisock $::state ; flush $clisock }
	}

	"SeqInsertHold" {
	    ;##- Cancel any pending retry
	    CancelRetry

	    if { $::state == "error" } {
		set msg "Already holding due to error"
	    } elseif { $::state == "hold" } {
		set msg "Already in hold state"
	    } elseif { $::holdFlag == 1 } {
		set msg "Hold flag has already been set"
	    } else {

		set ::holdFlag 1
		puts "Received 'hold' instruction at [Timestamp]"
		;##- Check whether we should enter the 'hold' state right now
		HoldCheck
		switch -- $::state {
		    "hold" { set msg "State is now 'hold'" }
		    "pend" -
		    "run" { set msg "Will hold when current job finishes" }
		    default { set msg "Current state is $::state;\
			    will hold when state becomes 'idle'" }
		}
	    }
	    catch { puts $clisock $msg; flush $clisock }
	}

	"SeqInsertRetry" {
	    if { $::state == "error" } {
		;##- Cancel any pending retry
		CancelRetry

		puts "Retrying $::currentFile $::currentFiledb"
		after 0 SubmitOne $::currentFile $::currentFiledb
		set ::state "pend"
	    } else {
		puts "Ignored 'retry' instruction since not in error state"
	    }
	}

	"SeqInsertContinue" {
	    if { $::state == "error" || $::state == "hold" } {
		;##- Cancel any pending retry
		CancelRetry

		if { $::state == "error" } {
		    puts "Continuing, despite error inserting\
			    $::currentFile $::currentFiledb"
		    puts "[Timestamp] skip   $::currentFile $::currentFiledb"
		} else {
		    puts "Continuing at [Timestamp]"
		}
		set ::state "idle"
		set ::currentFile ""
		set ::currentFiledb ""

		;##- Check whether we should enter the 'hold' state
		HoldCheck

		;##- Check whether anyone is waiting for the queue to drain
		DrainCheck

		;##- Get ready to submit next file in the queue, if any
		if { $::state == "idle" && [llength $::queue] > 0 } {
		    after 0 SubmitOne
		    set ::state "pend"
		}

	    } else {
		puts "Ignored 'continue' instruction since not in\
			error or hold state"
	    }
	}

	"SeqInsertPurge" {
	    puts "Received 'purge' instruction at [Timestamp]"
	    foreach qfile $::queue qdb $::queuedb {
		puts "[Timestamp] purge  $qfile $qdb"
	    }
	    set ::queue {}
	    set ::queuedb {}
	    ;##- Delete the queue file
	    if { [file exists $::queueFile] } {
		if { [catch {file delete $::queueFile}] } {
		    puts "*** Error deleting queue file"
		    puts stderr "SeqInsert error deleting queue file"
		    exit 1
		}
	    }
	}

	"SeqInsertShutdown" {

	    ;##- Cancel any pending retry
	    CancelRetry

	    puts "Received 'shutdown' instruction at [Timestamp]"

	    ;##- Delete the register file
	    catch { file delete $::registerFile }

	    ;##- Close the listening socket immediately, to prevent any new
	    ;##- client connections
	    if { [info exists ::listenSock] } {
		close $::listenSock
		unset ::listenSock
		puts "Closed listening socket"
	    }

	    ;##- Mark this client socket as being a "shutdown" client, and
	    ;##- decrement the effective number of client connections --
	    ;##- because we don't have to wait for this one to be closed!
	    lappend ::shutdownClients $clisock
	    incr ::clientConnections -1

	    ;##- If a shutdown instruction has already been received, return
	    if { $::shutdownFlag } { return }

	    set ::shutdownFlag 1

	    ;##- Check whether we should shut down immediately, or later
	    if { [ShutdownCheck] } {
		;##- Shut down immediately
		return
	    } else {
		;##- Deferred shutdown.  Any running job will be allowed to
		;##- finish, and any currently-connected clients will be
		;##- allowed to finish their transactions, but no new LDAS
		;##- jobs will be submitted.

		if { $::state != "idle" && $::state != "hold" \
			&& $::state != "error" } {
		    puts "Waiting for the state to become\
			    'idle', 'hold', or 'error'"
		}
		if { $::clientConnections > 0 } {
		    puts "Waiting for $::clientConnections clients\
			    to finish their transactions"
		}
	    }
	}

	"SeqInsertDrain" {

	    puts "A 'drain' client connected at [Timestamp]"

	    ;##- Mark this client socket as being a "drain" client, and
	    ;##- decrement the effective number of client connections --
	    ;##- because we don't have to wait for this one to be closed!
	    lappend ::drainClients $clisock
	    incr ::clientConnections -1

	    ;##- Check whether we are already drained
	    DrainCheck

	}

	default {
	    if { [regexp {^submit\s+(\S+)(.*)$} $line match file database] } {
		set database [string trim $database]
		;##- Queue this file for insertion
		Queue $file $database
	    }
	}
    }

    return
}


##=========================================================================
## Name: Queue
##

proc Queue { file {database ""} } {

##    puts "In Queue $file $database"

    ;##- If we're idle, go ahead and schedule this file for submission.

    if { $::state == "idle" } {
	after 0 SubmitOne $file $database
	set ::state "pend"
	return
    }

    ;##- If we get here, then we're not idle.  So add the file to the
    ;##- queue list.

    lappend ::queue $file
    lappend ::queuedb $database

    ;##- If we're still in the init state, then we're really just "pre-queuing"
    ;##- this file; print a log message and return
    if { $::state == "init" } {
	puts "[Timestamp] buffer $file $database"
	return
    }

    ;##- Append to the queue file
    if { [catch {open $::queueFile a} fid] } {
	puts "*** Error updating queue file"
	puts stderr "SeqInsert error updating queue file"
	exit 1
    }
    puts $fid "submit $file $database"
    close $fid

    ;##- Make entry in the log file
    puts "[Timestamp] queued $file $database"

    return
}


##=========================================================================
## Name: SubmitOne
##
## If called with an argument, submits that file.  If called without any
## arguments, gets the first file from the queue list.

proc SubmitOne { {file ""} {database ""} } {

###    puts "In SubmitOne"

    if { $file == "" } {
	if { [llength $::queue] == 0 } {

	    set ::state "idle"

	    ;##- Check whether we should enter the 'hold' state
	    HoldCheck

	    ;##- Check whether anyone is waiting for the queue to drain
	    DrainCheck

	    ;##- Check whether we should shut down now
	    ShutdownCheck

	    return
	}

	;##- Pick off the first entry in the queue
	set file [lindex $::queue 0]
	set ::queue [lrange $::queue 1 end]
	set database [lindex $::queuedb 0]
	set ::queuedb [lrange $::queuedb 1 end]

	if { [llength $::queue] == 0 } {
	    ;##- Delete the queue file, if it exists
	    if { [file exists $::queueFile] } {
		if { [catch {file delete $::queueFile}] } {
		    puts "*** Error deleting queue file"
		    puts stderr "SeqInsert error deleting queue file"
		    exit 1
		}
	    }
	} else {
	    ;##- Rewrite the queue file
	    if { [catch {open $::queueFile w} fid] } {
		puts "*** Error updating queue file"
		puts stderr "SeqInsert error updating queue file"
		exit 1
	    }
	    foreach qfile $::queue qdb $::queuedb {
		puts $fid "submit $qfile $qdb"
	    }
	    close $fid
	}
    }

    ;##- Make a log entry (either submit, or resubmit)
    if { $::currentFile != $file || $::currentFiledb != $database } {
	puts "[Timestamp] submit $file $database"
    } else {
	puts "[Timestamp] resub  $file $database"
    }

    set ::currentFile $file
    set ::currentFiledb $database

    ;##- Check that the file is readable.  If not, go into error state
    if { ! [file readable $file] } {
	puts "[Timestamp] error  $file"
	puts "Error: file does not exist or is not readable"
	puts stderr "SeqInsert error ingesting $file:"
	puts stderr "Error: file does not exist or is not readable"
	set ::state "error"
	set ::holdFlag 0
	if { $::shutdownFlag } {
	    puts "SeqInsert is now in 'error' state."
	} else {
	    puts "SeqInsert is now in 'error' state. \
		    Use 'SeqInsert retry' or 'SeqInsert cont'"
	}

	;##- If an error_exec command has been registered, exec it
	if { ! [string is space $::error_exec_cmd] } {
	    catch { eval exec $::error_exec_cmd }
	}

	;##- Check whether we should shut down now
	ShutdownCheck

	return
    }

    set ::state "run"

    ;##- Submit job (normally returns immediately after setting up
    ;##- event-driven code, but at startup it can take a while)
    JobSubmit $file $database

    return
}


##=========================================================================
## Name: JobSubmit
##
## Optional "database" argument overrides database specified on the
##   "SeqInsert server <database>" command line that was used to start
##   the server.

proc JobSubmit { file {database ""} } {

    set manager $::manager
    set dbname $::dbname

    ;##- If database argument is present, override the global defaults
    if { $database != "" } {

	;##- Separate the "database", as specified by the user, into the LDAS
	;##- manager and the database instance name, if specified.
	if { [regexp {^(.*):(.*)$} $database match mgrname dbname] } {
	    if { ! [string is space $mgrname] } { set manager $mgrname }
	} else {
	    set manager $database
	    set dbname ""
	}

	;##- Substitute the site name into the database instance name if needed
	if { [regexp {^[^:\d]+} $manager sitename] } {
	    switch -- $sitename {
		dev -
		test {
		    set basename "cit"
		}
		default {
		    set basename $sitename
		}
	    }
	    regsub {%s} $dbname $basename dbname
	}

    }

    ;##- Construct the LDAS job command
    set corecmd "putMetaData -returnprotocol file:out.txt\
            -ingestdata %FILE($file)"
    if [string length $dbname] { append corecmd " -database $dbname" }

    ;##- Submit the LDAS job asynchronously
    if [string is space $::ldasuser] {
	   if	{ [ info exist ::LDAS_VERSION_8 ] } {
	   		catch { LJrun job1 -manager $manager -nowait $corecmd } err
	   } else {
			catch { LJrun job1 -globus $::USE_GLOBUS_CHANNEL -gsi $::USE_GSI -manager $manager -nowait $corecmd } err
	   }
	   puts "SeqInsert LJrun: $err"
    } else {
		if	{ [ info exist ::LDAS_VERSION_8 ] } {
			catch { LJrun job1 -manager $manager -user $::ldasuser -nowait $corecmd } err
		} else {
			catch { LJrun job1 -globus $::USE_GLOBUS_CHANNEL -gsi $::USE_GSI -manager $manager -user $::ldasuser -nowait $corecmd } err
		}
		puts "SeqInsert LJrun: $err"
    }

    ;##- Start polling for job to finish
    after 0 [list JobPoll job1 $file 850 JobDone]

    return 
}


##=========================================================================
## Name: JobPoll
##

proc JobPoll { jobname file interval doneproc } {

    #-- Check the status of the job
    switch -- [LJstatus $jobname] {
	"done" - "error" {
	    #-- Queue a call to the procedure to handle the job
	    after 0 [list $doneproc $jobname $file]
	}
	default {
	    #-- Schedule another poll
	    after $interval [list JobPoll $jobname $file $interval $doneproc]
	}
    }

    return
}


##=========================================================================
## Name: JobDone
##

proc JobDone { jobname file } {

    upvar #0 $jobname jobarr

    if { $jobarr(status) == "error" } {

	puts "[Timestamp] error  $file"
	set errmsg $jobarr(error)
	puts "Error: $errmsg"

	;##- Check whether this is a "duplicate row" error
	set dupl_err [regexp {duplicate rows} $errmsg]

	;##- Enter the "error" state, UNLESS this is a "duplicate row"
	;##- error on a retry, indicating that the insertion was
	;##- successful after all.
	if { ! ($dupl_err && $::retryCounter>0) } {

	    puts stderr "SeqInsert error ingesting $file:"
	    puts stderr "Error: $errmsg"
	    set ::state "error"
	    set ::holdFlag 0
	    puts "SeqInsert is now in 'error' state. \
		    Use 'SeqInsert retry' or 'SeqInsert cont'"

	    ;##- Check whether we should shut down now
	    if { [ShutdownCheck] } { return }

	    ;##- Schedule an automatic retry, UNLESS this is a
	    ;##- "duplicate row" error and we have not yet retried
	    if { $dupl_err && ($::retryCounter==0) } {
		;##- Retrying won't cure this error
		;##- If an error_exec command has been registered, exec it
		if { ! [string is space $::error_exec_cmd] } {
		    catch { eval exec $::error_exec_cmd }
		}
	    } else {
		ScheduleRetry
	    }

	    LJdelete $jobname
	    return
	}
    }

    puts "[Timestamp] finish $file"
    LJdelete $jobname

    set ::state "idle"
    set ::currentFile ""
    set ::currentFiledb ""

    ;##- Cancel any pending retry
    CancelRetry

    ;##- Check whether we should enter the 'hold' state
    HoldCheck

    ;##- Check whether anyone is waiting for the queue to drain
    DrainCheck

    ;##- Check whether we should shut down now
    if { [ShutdownCheck] } { return }

    ;##- Get ready to submit next file in the queue, if any
    if { $::state == "idle" && [llength $::queue] > 0 } {
	after 0 SubmitOne
	set ::state "pend"
    }

    return
}


##=========================================================================
## Name: ScheduleRetry
##
## Sets up a retry at a future time

proc ScheduleRetry {} {

    ;##- Decide how long to wait before retrying.  'delay' is in seconds!
    incr ::retryCounter
    switch $::retryCounter {
	1 { set delay 20 }
	2 { set delay 120 }
	3 { set delay 600 }
	4 { set delay 3600 }
	default {
	    puts "Reached maximum number of retries;\
		    waiting for human intervention"

	    ;##- If an error_exec command has been registered, exec it now
	    if { ! [string is space $::error_exec_cmd] } {
		catch { eval exec $::error_exec_cmd }
	    }

	    return
	}
    }

    puts "Will auto-retry in $delay seconds"

    ;##- Set up a timer event to do the retry
    ;##- (If user intervenes first, this event will be canceled)
    set ::retryEvent [after [expr {$delay*1000}] AutoRetry]

    return
}


##=========================================================================
## Name: CancelRetry
##
## Cancels any pending retry

proc CancelRetry {} {
    if { [info exists ::retryEvent] } {
	after cancel $::retryEvent
	unset ::retryEvent
    }
    set ::retryCounter 0
    return
}


##=========================================================================
## Name: AutoRetry
##
## Resubmits a file that previously generated an error

proc AutoRetry {} {
    unset ::retryEvent

    if { $::state == "error" } {
	puts "Auto-retrying $::currentFile $::currentFiledb"
	after 0 SubmitOne $::currentFile $::currentFiledb
	set ::state "pend"
    } else {
	puts "Skipping auto-retry since not in error state"
    }
    return
}



##=========================================================================
## Name: HoldCheck
##
## Checks whether we should change state from "idle" to "hold"

proc HoldCheck {} {

    if { $::state != "idle" } { return }
    if { $::holdFlag == 0 } { return }

    puts "Holding at [Timestamp]"
    set ::state "hold"
    set ::holdFlag 0
    puts "SeqInsert is now in 'hold' state.  Use 'SeqInsert cont'"

    return
}


##=========================================================================
## Name: ShutdownCheck
##
## If we should shut down now, this sets ::SHUTDOWN and returns 1

proc ShutdownCheck {} {

##    puts "In ShutdownCheck with flag=$::shutdownFlag, state=$::state,\
##	    conn=$::clientConnections"

    if { $::shutdownFlag && \
	    ($::state=="idle" || $::state=="hold" || $::state=="error") } {
	set ::state "shutdown"
    }

    if { $::state == "shutdown" && $::clientConnections == 0 } {
	;##- Time to shut down!
	set ::SHUTDOWN 1
	return 1
    }

    return 0
}


##=========================================================================
## Name: DrainCheck
##
## If the queue is drained, this sends a message to all "drain" clients.

proc DrainCheck {} {

##    puts "In DrainCheck with flag=$::shutdownFlag, state=$::state,\
##	    conn=$::clientConnections"

    if { $::state == "idle" && [llength $::queue] == 0 } {
	;##- The queue is drained
	;##- Tell all the "drain" clients
	foreach sock $::drainClients {
	    catch { puts $sock "drained" }
	    catch { close $sock }
	}
	set ::drainClients {}

	return 1
    }

    return 0
}


##=========================================================================
## Name: Timestamp
##

proc Timestamp {} {
    return [clock format [clock seconds] -format "%D %T UTC" -gmt 1]
}


##=========================================================================
## Name: bgerror  (Routine to handle background errors)
##

proc bgerror { err } {

    global errorInfo

    if { [string is space $errorInfo] } {
	puts "\nTcl background error dump! \
		Please send this to shawhan_p@ligo.caltech.edu\n$err\n"
    } else {
	puts "\nTcl background error dump! \
		Please send this to shawhan_p@ligo.caltech.edu\n$errorInfo\n"
    }

    puts stderr "SeqInsert Tcl error!"

    return
}


##=========================================================================
## Name: main
##
## Comments:
##   OK, we've defined all the procs, including Main.  Now run it!

;#barecode
Main
