Tcl Source Code

Artifact [864e5ae356]
Login

Artifact 864e5ae3563c9cfb5a60d338c338257b57acbe77:

Attachment "Team" to ticket [462317ffff] added by kogorman 2001-09-18 07:21:28.
#!/usr/bin/expect --
# Middleware emulator: take some streams and execute them on some simulated
#            servers. Attempt to form cooperating "teams".
#
# The streams are pre-packaged, in the PARAMS subdirectory.
# The servers are just SQL*Plus subprocesses controlled by this driver.
#
# USAGE:
#   Team <option>... <streams> <prefix> <teams> [<spare servers>]
#   where: streams is the number of streams (the lowest-numbered ones are used)
#          prefix is the first component of the name of the stream files
#          teams is the number of teams to form.
#          spare_servers is the number of additional SQL*Plus processes to
#             start (in addition to one per team).
#     and option is one of
#      -N  set all tables NOCACHE before starting
#      -C  set all tables CACHE (default)
#      -T  enables "big" teams (obsolete)
#     -CL  set LINEITEM table to CACHE
#     -CO  set ORDERS table to CACHE
#    -CPS  set PARTSUPP table to CACHE
#     -CC  set CUSTOMER table to CACHE
#     -CP  set PART table to CACHE
#     -CS  set SUPPLIER table to CACHE
#    -NTC  disables built-in "big" team rule {3 8 12 14}
#    -NSQ  disables same-query rule
#    -NQT  enable formation of new query teams
#  -NTG g  set new team group to g, enable it, disable all other affinities
#    -P p  set prefix for log files
#      -U  run an Update stream (of refresh functions) as a background
#      -D  enable the general debugging code
#   -DFIN  enable debugging commands for the end of SQL statements
# -DSTATE  enable state-change debugging

# Explanation:
#	The real action here is in the expect_after scripting, which amounts to
#	multiple event-driven automata.  The expect command proper contains only the
#	timeout event, for which a small bit of trickery is required.  The array
#	$expires($server) contains the timestamp of the expiry for each server,
#	rather than a timeout amount, because the actual timeout has to be recomputed
#	for each event.

# XXX:  TODO
# Control the CACHE property of LINEITEM (and maybe others).  Turn it on and off
# as teams need (or do not need) the property.
#
# Test same-query matching coming after similar-query.

set DEBUG 0
set DEBUGSYNC 0
set DEBUGSQL 0
set DEBUGSTATE 0
set DEBUGTIME 0
set DEBUGTEAM 0
set DEBUGSPARES 0
set DEBUGPIPE 0
set DEBUGECHO 0
set DEBUGFIN 0
set DEBUGEXPECT 0
set DEBUGFDS 0
set DEBUGUPDATE 0
set TEAMGROUPS {{7 8 20} {2 11 16 17} {12 14 15} {1 4 5 9} {16 19}}

if $DEBUGECHO {set DEBUGPIPE 1}

set Id "\\\$Id"
send_user "Running $Id: Team,v 1.38 2001/09/10 11:01:09 kogorman Exp $\n"
set arglist [join $argv " "]
set command "$argv0 $arglist"
send_user "Command: $command\n"

############################################################################ trace_array
proc trace_array {array element type} {
	global DEBUGTIME
	upvar [set array]($element) var

	if $DEBUGTIME {
		send_user "    New value of [set array]($element) is $var ([expr $var-[timestamp]])\n"
	}
}

############################################################################ timeof
proc timeof {when} {
	global basetime

	return [expr $when - $basetime]
}

############################################################################ ourtime
proc ourtime {} {
	return [timeof [timestamp]]
}

############################################################################ report
proc report {server message} {
	global reportfile
	puts $reportfile($server) "Server $server at [ourtime]: $message"
}


############################################################################ flushrep
proc flushrep {server} {
	global reportfile
	flush $reportfile($server)
}

############################################################################ reportstate
proc reportstate {server state} {
	global states
	global DEBUGSTATE

	set states($server) $state
	if $DEBUGSTATE {
		send_user "************************ Server $server entering WAIT$state at [ourtime]\n"
	}
	report $server "Entering WAIT$state"
}

############################################################################ closeall
proc closeall {} {
	global SERVERS
	global reportfile

	for {set server 1} {$server <= $SERVERS} {incr server} {
		close $reportfile($server)
	}
}

############################################################################ waitsql
proc waitsql {server} {
	global DEBUG
	global DEBUGSYNC
	global timeout
	global servers
	global spawn2x
    expect {
		timeout {
			send_user "Timeout ($timeout) in waitsql\n"
			report $server "TIMEOUT"
			send_user "Buffer is:\n$expect_out(buffer)\n"
			closeall
			exit 1
		}
		-i $servers($server) "SQL> " {
			set me $expect_out(spawn_id)	;# WAITSQL
			set server $spawn2x($me)
			if {$DEBUG || $DEBUGSYNC} {
				report $server "waitsql Prompt: $expect_out(buffer)\n"
				send_user "Server $server waitsql Prompt: $expect_out(buffer)\n"
			}
			flushrep $server
			set result "$expect_out(buffer)\n"
		}
	}
	if $DEBUGSYNC {
		expect -i $servers($server)  "*" {
			set trail $expect_out(buffer)
		}
		if {$trail != ""} {
			send_user "Server $server trail is: $trail\n"
			report $server "Trail is: $trail\n"
			flushrep $server
		}
	}
	return $result
}

############################################################################ showsql
# Like sendsql, but reports results even without DEBUG defined
proc showsql {server str} {
	global DEBUG
	global timeout
	global servers
	global spawn2x

	set sql [join [split $str "\n"] "\n        "]
	send_user -- "  Server $server SQL: $sql\n"
	report $server "sendsql: $sql"
	flushrep $server
	send -i $servers($server) -- "$str"
    expect {
		timeout {
			send_user "Timeout ($timeout) in waitsql\n"
			report $server "TIMEOUT"
			send_user "Buffer is:\n$expect_out(buffer)\n"
			closeall
			exit 1
		}
		-i $servers($server) -re "^(\[^\r\n]*)\r*\n" {
			set me $expect_out(spawn_id)	;# SHOWSQL
			set server $spawn2x($me)
			report $server "Result: $expect_out(1,string)\n"
			send_user --  "Result: $expect_out(1,string)\n"
			exp_continue
		}
		-i $servers($server) -ex "SQL> " {
			set me $expect_out(spawn_id)	;# SHOWSQL
			set server $spawn2x($me)
			send_user -- "showsql Prompt: $expect_out(buffer)\n"
			report $server "showsql Prompt: $expect_out(buffer)\n"
			flushrep $server
		}
	}
}

############################################################################ sendsql
proc sendsql {server str} {
	global DEBUG
	global DEBUGSQL
	global timeout
	global servers

	set sql [join [split $str "\n"] "\n        "]
	if {$DEBUG || $DEBUGSQL} {
		send_user -- "  Server $server SQL: $sql\n"
		report $server "sendsql: $sql"
		flushrep $server
	}
	send -i $servers($server) -- "$str"
	waitsql $server
}

############################################################################ settimer
proc settimer {server howmuch} {
	global expires
	global realtimer
	global DEBUGTIME

	if $DEBUGTIME {
		send_user "   Call: settimer $server $howmuch (now [timestamp])\n"
	}
	set realtimer($server) $howmuch
	if {$howmuch == 0} {
		set expires($server) 0
	} else {
		set expires($server) [expr [timestamp] + $howmuch]
	}
}

############################################################################ enqueue
proc enqueue {stream} {
	global queue
	global pfiles
	global DEBUG

	if {[gets $pfiles($stream) paramline] != -1} {
		lappend queue [list $stream [timestamp] $paramline]
	} else {
		send_user "   Stream $stream at EOF\n"
	}
}

############################################################################ serve
proc serve {server team} {
	global TEAMCOUNT
	global BIGTEAM
	global servers
	global queue
	global pool
	global teams
	global DEBUG
	global DEBUGUPDATE
	global DEBUGTEAM
	global DEBUGTIME
	global DEBUGFIN
	global TEAMCOMPAT
	global SAMEQUERY
	global NEWQUERYTEAMS
	global TEAMGROUPS

	if $DEBUG {
		send_user "*** serve $server\n"
		send_user "    queue is $queue\n"
	}

	if {[llength $queue] > 0} {
		set entry [lindex $queue 0]
		set stream [lindex $entry 0]
		set qtime  [expr [timestamp] - [lindex $entry 1]]
		set paramline [lindex $entry 2]
		if $DEBUG {
			send_user "    stream is $stream\n"
			send_user "       query line: $paramline at [ourtime]\n"
		}
		set queue [lrange $queue 1 100]
	} else {
		# queue is empty -- nothing for this server to do
		# kill it off.
		if {$DEBUGTIME || $DEBUGFIN} {
			send_user "   Service ends on server $server\n"
		}
		settimer $server 0
		waitfin $server
		report $server "Streams ended"
		send_user "Server $server finishing\n"
		set xa [expect_after_info]
		if {$xa == ""} {
			if $DEBUGFIN {
				send_user "All automata quiet -- I guess everything's done\n"
			}
			return 0		;# Should terminate expect command
		}
		if $DEBUG {
			set x [expect_format $xa]
			if {$UPDATES && $DEBUGUPDATE} {
				set xb [expect_format $xb[expect_before_info]]
				report $server "Expect_before is now\n$xb\n]\n"
				send_user "Expect_before is now\n$xb\n"
			}
			report $server "Expect_after is now:\n    $x]\n"
			send_user "Expect_after is now:\n    $x\n"
		}
		return 1
	}
	startserve $server $stream $qtime $paramline
	if $DEBUGTEAM {
		send_user "Queue is $queue\n"
		send_user "Pool is $pool\n"
	}
	set querynum [lindex [split $paramline "\t"] 0]
	set members $server
	# First, loop for queries of the same kind.
	# Cannot use 'foreach' because $queue is being modified
	# progress is made by either shortening $queue or incrementing $cursor
	if $SAMEQUERY {
		for {set cursor 0} {$cursor < [llength $queue]} {} {
			if {$pool == {}} {break}
			set entry [lindex $queue $cursor]
			set entryquerynum [lindex [split [lindex $entry 2] "\t"] 0]
			if $DEBUGTEAM {
				send_user "   ---> Compare $entryquerynum to $querynum\n"
			}
			if {$entryquerynum == $querynum} {
				send_user "Server $server pulled item $cursor (same query)\n"
				set queue [lreplace $queue $cursor $cursor]
				set spareserver [lindex $pool 0]
				set pool [lrange $pool 1 1000]
				set sparestream [lindex $entry 0]
				set spareqtime  [expr [timestamp] - [lindex $entry 1]]
				set spareparms  [lindex $entry 2]
				startserve $spareserver $sparestream $spareqtime $spareparms
				lappend members $spareserver
			} else {
				incr cursor
			}
		}
	}
	# Now loop for queries of compatible kinds
	if $TEAMCOMPAT {
		for {set cursor 0} {$cursor < [llength $queue]} {} {
			if {$pool == {}} {break}
			if {$BIGTEAM == 0} {break}
			if {[lsearch {3 8 12 14} $querynum] < 0} {break}
			set entry [lindex $queue $cursor]
			set entryquerynum [lindex [split [lindex $entry 2] "\t"] 0]
			if $DEBUGTEAM {
				send_user "   ---> Compare $entryquerynum to $querynum\n"
			}
			if {[lsearch {3 8 12 14} $entryquerynum] >= 0} {
				send_user "Server $server pulled item $cursor (compatible query)\n"
				set queue [lreplace $queue $cursor $cursor]
				set spareserver [lindex $pool 0]
				set pool [lrange $pool 1 1000]
				set sparestream [lindex $entry 0]
				set spareqtime  [expr [timestamp] - [lindex $entry 1]]
				set spareparms  [lindex $entry 2]
				startserve $spareserver $sparestream $spareqtime $spareparms
				lappend members $spareserver
			} else {
				incr cursor
			}
		}
	}
	if $NEWQUERYTEAMS {
		set mygroup {}
		foreach group $TEAMGROUPS {
			if {[lsearch $group $querynum] >= 0} {
				set mygroup $group
				break
			}
		}
		if {$mygroup != {} && $pool != {}} {
			if $DEBUGTEAM {
				send_user "   ---> My query group is $mygroup\n"
				send_user "      > Queue is $queue\n"
			}
			for {set cursor 0} {$cursor < [llength $queue]} {} {
				set entry [lindex $queue $cursor]
				set entryquerynum [lindex [split [lindex $entry 2] "\t"] 0]
				if {[lsearch $group $entryquerynum] >= 0} {
					send_user "Server $server pulled item $cursor (compatible query: $entryquerynum in $mygroup)\n"
					set queue [lreplace $queue $cursor $cursor]
					set spareserver [lindex $pool 0]
					set pool [lrange $pool 1 1000]
					set sparestream [lindex $entry 0]
					set spareqtime  [expr [timestamp] - [lindex $entry 1]]
					set spareparms  [lindex $entry 2]
					startserve $spareserver $sparestream $spareqtime $spareparms
					lappend members $spareserver
					break
				} else {
					incr cursor
				}
			}
		} else {
			if $DEBUGTEAM {
				send_user "   ---> No chance of teammates\n"
				send_user "      > Pool is $pool\n"
				send_user "      > Mygroup is $mygroup\n"
			}
		}
	}
	foreach member $members {
		set teams($member) $team
	}
	set teams($team) $members
	return 1
}

############################################################################ startserve
proc startserve {server stream qtime paramline} {
	global servers
	global streams
	global querynums
	global starttimes
	global limits
	global DEBUG

	set sep "' '"

	set streams($server) $stream
	set fields [split $paramline "\t"]
	set querynum [lindex $fields 0]
	set query [format "Q%2.2dp" $querynum]
	set querynums($server) $querynum

	# Send the command, and expect to see the echo
	set sql "@$query $stream '[join [lrange $fields 1 100] $sep]'\r"
	waitecho $server
	send -i $servers($server) $sql
	set starttimes($server) [timestamp]
	send_user "Server $server id $servers($server) stream $stream qtime $qtime query $querynum at [timeof $starttimes($server)]: $sql\n"
	report $server $sql

	set limit 1000				;# no more than 1000 from anything!
	if {$querynum == 2} {
		set limit 100
	}
	if {$querynum == 3} {
		set limit 10
	}
	if {$querynum == 10} {
		set limit 20
	}
	if {$querynum == 18} {
		set limit 100
	}
	if {$querynum == 21} {
		set limit 100
	}
	set limits($server) $limit
}

############################################################################ startupdate
proc startupdate {server} {
	global servers
	global starttimes
	global limits
	global updateseq

	# Send the command, and expect to see the echo
	incr updateseq
	set sql "@REFRESH/update_$updateseq.sql\r"
	if {$updateseq == 80} {set updateseq 0}
	waitechoupd $server
	send -i $servers($server) $sql
	set starttimes($server) [timestamp]
	send_user "Update server $server id $servers($server) at [timeof $starttimes($server)]: $sql\n"
	report $server $sql

	set limit 2000				;# limit for an update request is large: a bit over 30 minutes
	set limits($server) $limit
}

############################################################################ new_stamp
proc new_stamp {} {
	global endtime
	global shorttimer
	global expires
	global timeout
	global SERVERS
	global DEBUG
	global DEBUGTIME
	global DEBUGFIN
	global UPDATES

	# Here's a frequent and opportune place to zonk any zombies
	wait -nowait

	set last $SERVERS
	if $UPDATES {incr last}
	set endtime $expires(1)
	set shorttimer 1
	for {set server 2} {$server <= $last} {incr server} {
		if { ($endtime > $expires($server) && $expires($server) != 0) || $endtime == 0 } {
			set endtime $expires($server)
			set shorttimer $server
		}
	}
	if {$endtime == 0} {
		send_user "ERROR: bad timeout values\n"
		if $DEBUG {
			for {set server 1} {$server <= $last} {incr server} {
				send_user "Server $server ends at $expires($server)\n"
			}
		}
		closeall
		exit 1
	}
	set timeout [expr $endtime - [timestamp]]
	# Don't let the expect command see a non-positive timeout
	if {$timeout < 1} {set timeout 1}
	if {$DEBUGTIME} {
		send_user "************************ Timeout is $timeout (for server $shorttimer)\n"
	}
}

############################################################################ waitecho
proc waitecho {server} {
	global servers
	global DEBUG

	reportstate $server "ECHO"
	if $DEBUG {
		send_user "   Waiting on server $server ($servers($server))\n"
	}
	settimer $server 60
	expect_after  -i $servers($server) \
		-re "^(\[^\r\n]*)\r*\n" {
			set me $expect_out(spawn_id)	;# WAITECHO
			set server $spawn2x($me)
			report $server "SQL echo: $expect_out(1,string)"
			if $DEBUGSPARES {
				send_user "ECHO $server: $expect_out(1,string)\n"
			}
			waitsep $server
			new_stamp
			exp_continue
		}
}

############################################################################ waitechoupd
proc waitechoupd {server} {
	global servers
	global DEBUG

	reportstate $server "ECHOUPD"
	if $DEBUG {
		send_user "   Waiting on update server $server ($servers($server))\n"
	}
	settimer $server 60
	expect_before  -i $servers($server) \
		-re "^(\[^\r\n]*)\r*\n" {
			set me $expect_out(spawn_id)	;# WAITECHO
			set server $spawn2x($me)
			report $server "SQL echo: $expect_out(1,string)"
			waitfinupd $server
			new_stamp
			exp_continue
		}
}

############################################################################ waitsep
proc waitsep {server} {
	global servers
	global errorseen
	global DEBUG

	reportstate $server "SEP"
	settimer $server 9000
	expect_after \
	 	-i $servers($server) -re "^SQL> " {
			set me $expect_out(spawn_id)	;# WAITSEP SQL
			set server $spawn2x($me)
			set t $streams($server)
			report $server "Error"
			flushrep $server
			send_user "Server $server stream $t trailer ERROR in WAITSEP\n"
			set errorseen 1
			set DEBUG 1
		} \
		-i $servers($server) -re "(\[^\r\n]*)\r*\n" {
			set me $expect_out(spawn_id)	;# WAITSEP
			set server $spawn2x($me)
			set what $expect_out(1,string)
			report $server $what
			if {[string range $what 0 4] ==  "SQL> "} { # this one doesn't seem to fire
				send_user "Error on server $server\n"
				report $server "Error seen in WAITSEP\n"
				set errorseen 1
				set DEBUG 1
			} {
				if {[string first "---" $what] > -1} {
					waitlim $server
				}
				new_stamp
				exp_continue
			}
		}
}

############################################################################ waitlim
proc waitlim {server} {
	global servers
	global limits

	reportstate $server "LIM"
	settimer $server 245
	expect_after -i $servers($server) \
		-re "^\r*\n" {						;# WAITLIM BLANK LINE
			set me $expect_out(spawn_id)	;# beware of scope!
			set server $spawn2x($me)
			waitrest $server
			new_stamp
			exp_continue
		} \
		-i $servers($server) \
		-re "^(\[^\r\n]+)\r*\n" {			;# WAITLIM NONBLANK LINE
			set me $expect_out(spawn_id)	;# beware of scope!
			set server $spawn2x($me)
			if {$limits($server) > 0} {
				incr limits($server) -1
				report $server "$expect_out(1,string)"
			}
			settimer $server 245
			new_stamp
			exp_continue
		}
}

############################################################################ waitrest
# wait for the rest of the output (autotrace stuff, mostly)
# use a largish timeout because some of the autotrace things
# can go slowly when there's contention.

proc waitrest {server} {
	global starttimes
	global endtimes
	global servers
	global streams
	global querynums

	set endtimes($server) [timestamp]		;# capture the end time
	reportstate $server "REST"
	set s $starttimes($server)
	set e $endtimes($server)
	set l [expr $e - $s]
	set t $streams($server)
	set q $querynums($server)
	report $server "Start [timeof $s], end [timeof $e] Elapsed time: $l seconds"
	send_user "Server $server stream $t query $q: start [timeof $s], end [timeof $e] Elapsed time: $l seconds\n"
	settimer $server 120
	expect_after -i $servers($server) \
		-re "^SQL> " {
			set me $expect_out(spawn_id)	;# WAITREST SQL
			set server $spawn2x($me)
			set t $streams($server)
			report $server "Ended (prompt seen)"
			flushrep $server
			send_user "Server $server stream $t trailer done at [timeof [timestamp]]\n"
			enqueue $streams($server)		;# release the stream immediately
			set r [finish $server]			;# the server's more complicated
			report $server "    WAITREST ends with return-value=$r\n"
			if $DEBUGFIN {
				flushrep $server
				send_user "    WAITREST ends with return-value=$r\n"
			}
			if $r {							;# do this or the job's over now
				new_stamp
				report $server "    WAITREST continues.  Timeout is $timeout.\n"
				flushrep $server
				if $DEBUGFIN {
					send_user "    WAITREST continues.  Timeout is $timeout.\n"
				}
			} else {
				report $server "     WAITREST ends the run.\n"
				flushrep $server
				if $DEBUGFIN {
					send_user "     WAITREST ends the run.\n"
				}
			}
		} \
		-i $servers($server) \
		-re "^( *(\[0-9]+) *(consistent gets|physical reads))\r*\n" {
			set me $expect_out(spawn_id)	;# WAITREST STATISTICAL LINE
			set server $spawn2x($me)
			set t $streams($server)
			set q $querynums($server)
			report $server "$expect_out(1,string)"
			flushrep $server
			send_user "Server $server stream $t query $q: $expect_out(1,string)\n"
			settimer $server 120
			new_stamp
			exp_continue
		}\
		-i $servers($server) \
		-re "^(\[^\r\n]*)\r*\n" {			;# WAITREST OTHER LINES
			set me $expect_out(spawn_id)	;# beware of scope!
			set server $spawn2x($me)
			report $server "$expect_out(1,string)"
			settimer $server 120
			new_stamp
			exp_continue
		}
}

############################################################################ waitfinupd
# wait for the rest of the output
# Timeouts are 240 because 120 was seen to be too small (T160), and because
# (unlike queries) the outputs are occasional throughout each execution.

proc waitfinupd {server} {
	global starttimes
	global endtimes
	global servers
	global shutdown
	global DEBUGUPDATE

	reportstate $server "FINUPD"
	settimer $server 240
	expect_before -i $servers($server) \
		-re "^SQL> " {
			set me $expect_out(spawn_id)	;# WAITFINUPD SQL
			set server $spawn2x($me)
			set endtimes($server) [timestamp]		;# capture the end time
			set s $starttimes($server)
			set e $endtimes($server)
			set l [expr $e - $s]
			report $server "Update start [timeof $s], end [timeof $e] Elapsed time: $l seconds"
			flushrep $server
			send_user "Update server $server WAITFINUPD call: start [timeof $s], end [timeof $e] Elapsed time: $l seconds\n"
			expect_before -i $servers($server)
			report $server "Ended"
			send_user "Update server $server trailer done at [timeof [timestamp]]\n"
			if $DEBUGFIN {
				send_user "    WAITFINUPD ends with return-value=$r\n"
			}
			new_stamp
			if {$shutdown} {
				send_user "    WAITFINUPD -- that's all folks\n"
			} {
				startupdate $server
			}
		} \
		-i $servers($server) \
		-re "^\r*\n" {						;# WAITREST BLANK LINES
			set me $expect_out(spawn_id)	;# beware of scope!
			set server $spawn2x($me)
			settimer $server 240
			new_stamp
			exp_continue
		} \
		-i $servers($server) \
		-re "^(\[^\r\n]*)\r*\n" {			;# WAITREST OTHER LINES
			global DEBUGUPDATE
			set me $expect_out(spawn_id)	;# beware of scope!
			set server $spawn2x($me)
			if $DEBUGUPDATE {report $server "$expect_out(1,string)"}
			settimer $server 240
			new_stamp
			exp_continue
		}
}

############################################################################ waitfin
proc waitfin {server} {
	global servers

#	send -i $servers($server) "quit\r"
#	expect_after -i $servers($server) \
#	eof {
#			set me $expect_out(spawn_id)	;# WAITFIN
#			set server $spawn2x($me)
#			expect_after -i $servers($server)
#			send_user "EOF seen on server $server\n" 
#			exp_continue
#	}
}

############################################################################ finish
# Finish of a query.  Remove this server from the team.  If the team is now
# empty (all servers finished), use this server to start the team on some new work.
proc finish {server} {
	global teams
	global pool
	global servers
	global expires
	global TEAMCOUNT
	global DEBUGTIME
	global DEBUGFIN
	global DEBUGEXPECT

	# Assume this one's going to stop
	if $DEBUGTIME {
		send_user "   Service may pause on server $server\n"
	}
	expect_after -i $servers($server)
	set expires($server) 0
	if $DEBUGFIN {
		if $DEBUGEXPECT {
			send_user "Server $server gone: expect_after is now\n    [expect_format [expect_after_info]]\n"
		} else {
			send_user "Server $server gone.\n"
		}
	}

	# Remove this server from the team.
	# Don't start anything else until all team members finish.  So the last
	# member finishing is responsible for serving the leader.
	set team $teams($server)
	set members $teams($team)
	set place [lsearch $members $server]
	set r [lreplace $members $place $place]
	set teams($server) {}
	set teams($team) $r
	if {$r == {}} {
		# I'm last of the team -- try to start another
		set rv [serve $server $team] 
		if $DEBUGFIN {
			if $DEBUGEXPECT {
				send_user "    Finish: serve leader returned $rv; expect_after is now:\n     [expect_format [expect_after_info]]\n"
			} else {
				send_user "    Finish: serve leader returned $rv.\n"
			}
		}
		return $rv
	} else {
		# I'm a spare -- just go back to the queue
		lappend pool $server
		return 1
	}
}

############################################################################ expect_before_info
proc expect_before_info {} {
	set s [expect_before -info -all]
	return $s
}

############################################################################ expect_after_info
proc expect_after_info {} {
	set s [expect_after -info -all]
	return $s
}

############################################################################ expect_format
proc expect_format {str} {
	set o {}

	set reflag 0
	foreach f $str {
		if $reflag {
			while {[string first "\r" $f] >= 0} {
				set i [string first "\r" $f]
				set f "[string range $f 0 [expr $i-1]]\\r[string range $f [expr $i+1] end]"
			}
			while {[string first "\n" $f] >= 0} {
				set i [string first "\n" $f]
				set f "[string range $f 0 [expr $i-1]]\\n[string range $f [expr $i+1] end]"
			}
		}
		set reflag 0
		if {$f == {-re}} { set reflag 1 }
		lappend o $f
	}
	set cont [join [split $o "\n"] "\n          "]
	return "         $cont"
}

############################################################################ show_globals
# Show most globals, except those with underscores or Capital Letters.
# A few others are explicitly eliminated.
proc show_globals {} {
	set sg_nams [lsort [info globals]]
	foreach sg_nam $sg_nams {
		if {[string first "_" $sg_nam] >= 0} {continue}
		if {[string tolower $sg_nam] != $sg_nam} {continue}
#		if {$sg_nam == "argv"} {continue}
#		if {$sg_nam == "argc"} {continue}
		if {$sg_nam == "argv0"} {continue}
		if {$sg_nam == "env"} {continue}
		upvar #0 [set sg_nam] sg_v
		if {[array size sg_v] > 20} {
			send_user "Array $sg_nam size [array size sg_v]\n"
			set sg_id [array startsearch sg_v]
			while {[array anymore sg_v $sg_id]} {
				set sg_elem [array nextelement sg_v $sg_id]
				send_user "      ${sg_nam}($sg_elem)=$sg_v($sg_elem)\n"
			}
		} elseif {[array size sg_v] > 0} {
			send_user "Array $sg_nam size [array size sg_v]\n"
			foreach sg_elem [lsort [array names sg_v]] {
				send_user "      ${sg_nam}($sg_elem)=$sg_v($sg_elem)\n"
			}
		} else {
			send_user "Variable $sg_nam=$sg_v\n"
		}
	}
}

# ############################################################################### MAIN
# ############################################################################### MAIN
# ############################################################################### MAIN
log_user 0
if $DEBUGTIME {trace variable expires w trace_array}

set CACHE 1
set BIGTEAM 0
set CACHEITEMS 0
set CACHEORDERS 0
set CACHEPS 0
set CACHECUST 0
set CACHEPART 0
set CACHESUPP 0
set TEAMCOMPAT 1
set SAMEQUERY 1
set NEWQUERYTEAMS 0
set UPDATES 0
set prefix ""
set errorseen 0

while {[string index $argv 0] == "-"} {
	set arg1 [lindex $argv 0]
	set argv [lrange $argv 1 1000]
	if    { $arg1 == "-N" } { set CACHE 0 } \
	elseif { $arg1 == "-C" } { set CACHE 1 } \
	elseif { $arg1 == "-T" } { set BIGTEAM 1 } \
	elseif { $arg1 == "-CL" } { set CACHEITEMS 1 } \
	elseif { $arg1 == "-CO" } { set CACHEORDERS 1 } \
	elseif { $arg1 == "-CPS" } { set CACHEPS 1 } \
	elseif { $arg1 == "-CC" } { set CACHECUST 1 } \
	elseif { $arg1 == "-CP" } { set CACHEPART 1 } \
	elseif { $arg1 == "-CS" } { set CACHESUPP 1 } \
	elseif { $arg1 == "-CS" } { set CACHESUPP 1 } \
	elseif { $arg1 == "-NTC" } { set TEAMCOMPAT 0 } \
	elseif { $arg1 == "-NSQ" } { set SAMEQUERY 0 } \
	elseif { $arg1 == "-NQT" } { set NEWQUERYTEAMS 1; set BIGTEAM 1 } \
	elseif { $arg1 == "-NTG" } {
			set TEAMGROUPS [lindex $argv 0]
			set NEWQUERYTEAMS 1
			set SAMEQUERY 0
			set TEAMCOMPAT 0
			set BIGTEAM 0
			set argv [lrange $argv 1 1000]
	} elseif { $arg1 == "-P" } {
			set prefix [lindex $argv 0]
			set argv [lrange $argv 1 1000]
	} elseif { $arg1 == "-U" } { set UPDATES 1 } \
	elseif { $arg1 == "-D" } { set DEBUG 1 } \
	elseif { $arg1 == "-DFIN" } { set DEBUGFIN 1 } \
	elseif { $arg1 == "-DSTATE" } { set DEBUGSTATE 1 } \
	else {
		send_user "Bad argument $arg1\n"
		exit 1
	}
}

if {[llength $argv] < 3 || [llength $argv] >4} {
	send_user "USAGE: $argv0 <option>... <streams> <prefix> <servers> [<spare servers>]\n"
	closeall
	exit 1
}
set STREAMS [lindex $argv 0]
set PREFIX [lindex $argv 1]
set TEAMCOUNT [lindex $argv 2]
set SPARE1 [expr $TEAMCOUNT+1]
if {[llength $argv] == 4} {
	set SPARES [lindex $argv 3]
} else {
	set SPARES 0
}
set SERVERS [expr $TEAMCOUNT + $SPARES]

set basetime 0								;# temporarily for initial debugging reports

send_user "set DEBUG $DEBUG\n"
send_user "set DEBUGSQL $DEBUGSQL\n"
send_user "set DEBUGSTATE $DEBUGSTATE\n"
send_user "set DEBUGTIME $DEBUGTIME\n"
send_user "set DEBUGTEAM $DEBUGTEAM\n"
send_user "set DEBUGSPARES $DEBUGSPARES\n"
send_user "set DEBUGPIPE $DEBUGPIPE\n"
send_user "set DEBUGECHO $DEBUGECHO\n"
send_user "set DEBUGFIN $DEBUGFIN\n"
send_user "set DEBUGEXPECT $DEBUGEXPECT\n"
send_user "set DEBUGFDS $DEBUGFDS\n"
send_user "set DEBUGUPDATE $DEBUGUPDATE\n"
send_user "set TEAMGROUPS $TEAMGROUPS\n"

# Let's start the servers, and set some properties we want
for {set server 1} {$server <= $SERVERS} {incr server} {
	if $DEBUGECHO {
		set spawnpid($server) [spawn ./echoall]
	} elseif $DEBUGPIPE {
		set spawnpid($server) [spawn ./sqlplus-debug /]
	} else {
		set spawnpid($server) [spawn sqlplus /]
	}
	set servers($server) $spawn_id
	expect_before  -i $servers($server) -exact "NOTHING"
	set sample($spawn_id) [expect_before -info -i $servers($server)]
	expect_before  -i $servers($server)
	if $DEBUG {send_user "Set: servers($server) = $servers($server)\n"}
	set spawn2x($spawn_id) $server
	if $DEBUG {send_user "Set: spawn2x($spawn_id) = $spawn2x($spawn_id)\n"}
	set reportfile($server) [open "${prefix}server_$server.log" "w"]
	set timeout 300
	waitsql $server
	set timeout 10
	if $DEBUGPIPE {
		sendsql $server "-- You are server $server id $servers($server)\r"
	}
	sendsql $server "set linesize 600\r"	;# so lines don't fold
	sendsql $server "set pagesize 50000\r"	;# as large as allowed
	sendsql $server "set newpage 0\r"		;# use formfeed
	sendsql $server "set verify off\r"		;# quiet argument substitution
	sendsql $server "set autotrace on\r"	;# all the info we can get
}
if $DEBUG {send_user "================================================ servers initialization done\n"}

if $UPDATES {
	set server [expr $SERVERS + 1]
	set update_server $server
	set spawnpid($server) [spawn sqlplus /]
	set servers($server) $spawn_id
	if $DEBUG {send_user "Set: servers($server) = $servers($server)\n"}
	set spawn2x($spawn_id) $server
	if $DEBUG {send_user "Set: spawn2x($spawn_id) = $spawn2x($spawn_id)\n"}
	set reportfile($server) [open "${prefix}server_$server.log" "w"]
	set timeout 300
	waitsql $server
	set timeout 10
	if $DEBUGPIPE {
		sendsql $server "-- You are server $server id $servers($server)\r"
	}
	sendsql $server "set linesize 600\r"	;# so lines don't fold
	sendsql $server "set pagesize 50000\r"	;# as large as allowed
	sendsql $server "set newpage 0\r"		;# use formfeed
	sendsql $server "set verify off\r"		;# quiet argument substitution
	sendsql $server "set autotrace off\r"	;# Don't have any use for that info on updates
	if $DEBUG {send_user "================================================ update server initialization done\n"}
}

# Now use one stream to clear out any cruft that may be left
# from prior failed runs.  These can take a long time.
for {set stream 1} {$stream <= $STREAMS} {incr stream} {
	set timeout 600
	sendsql 1 "drop view revenue$stream;\r"
	sendsql 1 "commit;\r"
}

# Make sure we're at the start of the updates cycle
if $UPDATES {
	set timeout 9500
	sendsql 1 "! ./shouldrestore.sh\r"
	set timeout 600
}

# Set up the run -- use the right synonyms and fill the 
# buffer pool with stuff from another schema.
sendsql 1 "@synonym_raw\r"
sendsql 1 "@wipe_raw\r"

#Now use the same stream to set the CACHE/NOCACHE attribute
# of all of the tables.
if $CACHE {
	set how "CACHE"
	send_user "All streams CACHE\n"
} else {
	set how "NOCACHE"
	send_user "All streams NOCACHE\n"
}
sendsql 1 "alter table lineitem_raw $how;\r"
sendsql 1 "alter table partsupp_raw $how;\r"
sendsql 1 "alter table supplier_raw $how;\r"
sendsql 1 "alter table part_raw     $how;\r"
sendsql 1 "alter table orders_raw   $how;\r"
sendsql 1 "alter table customer_raw $how;\r"
sendsql 1 "alter table nation_raw   $how;\r"
sendsql 1 "alter table region_raw   $how;\r"

if $CACHEITEMS {
sendsql 1 "alter table lineitem_raw CACHE;\r"
}
if $CACHEORDERS {
sendsql 1 "alter table orders_raw   CACHE;\r"
}
if $CACHEPS {
sendsql 1 "alter table partsupp_raw CACHE;\r"
}
if $CACHECUST {
sendsql 1 "alter table customer_raw CACHE;\r"
}
if $CACHEPART {
sendsql 1 "alter table part_raw     CACHE;\r"
}
if $CACHESUPP {
sendsql 1 "alter table supplier_raw CACHE;\r"
}

# Set each spare server into a pool
set pool {}
for {set server $SPARE1} {$server <= $SERVERS} {incr server} {
	lappend pool $server
	set expires($server) 0
}

if $DEBUG {send_user "================================================ Set up the reporting environment\n"}

# set up the stream files
set queue {}
for {set stream 1} {$stream <= $STREAMS} {incr stream} {
	set filename "PARAMS/$PREFIX.$stream"
	set pfiles($stream) [open $filename "r"]
	enqueue $stream
	if $DEBUG {
		send_user "Stream $stream is $filename\n"
	}
}

if $DEBUG {send_user "================================================ Gather starting statistics\n"}

# Use the same stream to get some info about the Oracle environment
sendsql 1 "set autotrace off;\r"
showsql 1 "show sga;\r"
showsql 1 "select name,value from v\$sysstat order by name;\r"
showsql 1 "column filename format a50;\r"
showsql 1 "select name as filename,phyrds,phywrts,phyblkrd,phyblkwrt from v\$filestat fs, v\$datafile df where df.file#=fs.file# order by name;\r"
sendsql 1 "set autotrace on;\r"

# Also get info about Linux overall
showsql 1 "!cat /proc/stat\r"

if $DEBUG {send_user "================================================ Start the run\n"}

if $UPDATES {
	set shutdown 0
	set updateseq 0
	startupdate $update_server
}

set basetime [timestamp]
# Start each team with a query from the pool
for {set server 1} {$server <= $TEAMCOUNT} {incr server} {
	serve $server [string index ".ABCDEFGHIJKLMNOPQRSTUVWXYZ" $server]
}

# Now the main thing is this 'expect' command.  The real action
# is in the associated expect_after commands, so this just
# handles timeouts and things that change expect_after.
# When it is finished, that means that the
# last server has ended normally.
new_stamp						;# set the timeout

set firsttime 1
while { ! $errorseen && [expect_after_info] != {}} {
	if {$DEBUG || $DEBUGFDS} {
		send_user "Timeout is $timeout\n"
		if $UPDATES {send_user "Expect_before is\n[expect_format [expect_before_info]]\n"}
		send_user "Expect_after is\n[expect_format [expect_after_info]]\n"
	}
	if {$DEBUG && ! $firsttime} show_globals
	if {$DEBUG} {
		send_user "Running the main 'expect' command at [ouritme] ([timestamp]).\n"
	} {
		send_user "Running the main 'expect' command.\n"
	}
	set firsttime 0
	expect {
		timeout {
			send_user "\n\n******* TIMEOUT for server $shorttimer at [ourtime] ([timestamp])\n"
			send_user "        spawn_id is $servers($shorttimer) ---> $spawn2x($servers($shorttimer))\n"
			send_user "        was waiting on $states($shorttimer) for $realtimer($shorttimer) seconds\n"
			if $UPDATES {
				send_user "Executing with expect_before:\n[expect_format [expect_before_info]]\n"
			}
			send_user "Executing with expect_after:\n[expect_format [expect_after_info]]\n"
			send_user "Pool is $pool\n"
			send_user "Expires array:\n"
			set elimit $SERVERS
			if $UPDATES {incr elimit}
			for {set server 1} {$server <= $elimit} {incr server} {
				if {[catch {set e $expires($server)} err]} {
					send_user "Error on server $server: $err\n"
				} else {
					send_user "Server $server: $e\n"
				}
			}
			send_user "================================================================================\n"
			for {set server 1} {$server <= $elimit} {incr server} {
				send_user "server $server spawn-id $servers($server) buffer:"
				expect -i $servers($server) *
				send_user "$expect_out(buffer)\n"
				send_user "================================================================================\n"
			}
			show_globals
			closeall
			exit 1
		}
	}
#		-i $any_spawn_id eof {
#			set me $expect_out(spawn_id)	;# ANY EOF
#			set server $spawn2x($me)
#			send_user "EOF seen from server $server\n"
#			exp_continue
#		}
}
if $DEBUGFIN {
	send_user "All is done:  expect_after is now\n    [expect_format [expect_after_info]]\n"
	show_globals
}

# may need to drain the update server too.
if {! $errorseen && $UPDATES} {
	set shutdown 1
	while {[expect_before_info] != {} } {
		if {$DEBUG} {
			send_user "Draining update stream.\n"
		}
		send_user "Shutting down the update stream.\n"
		expect {
			timeout {
				send_user "\n\n******* TIMEOUT for server $shorttimer at [ourtime] ([timestamp])\n"
				send_user "        spawn_id is $servers($shorttimer) ---> $spawn2x($servers($shorttimer))\n"
				send_user "        was waiting on $states($shorttimer) for $realtimer($shorttimer) seconds\n"
			}
		}
	}
}

set endtime [ourtime]
send_user "Done at [ourtime]\n"
if $DEBUG {send_user "================================================ Gather ending statistics\n"}
# Show a finishing snapshot of Linux state
expect_after
expect_before
sendsql 1 "set autotrace off;\r"
showsql 1 "select name,value from v\$sysstat order by name;\r"
showsql 1 "select name as filename,phyrds,phywrts,phyblkrd,phyblkwrt from v\$filestat fs, v\$datafile df where df.file#=fs.file# order by name;\r"
showsql 1 "!cat /proc/stat\r"
closeall
send_user "Finished at $endtime\n"