#!/opt/tcl/bin/sytcl
#!/opt0/tcl/bin/sytcl
#/usr/local/tcl74/bin/dbtcl
#
# set tclroot /usr/local/tcl74
set tclroot /opt/share/tcl
loadlibindex $tclroot/lib/ucodb/ucodb.tlib
loadlibindex $tclroot/lib/ucodb/memes.tlib
#
set dbpipe1 [sybOpen keck guest rsvp UCO-ASTRO]
set dbpipe2 [sybOpen keck guest rsvp UCO-ASTRO]
# puts $efp "got dbpipe $dbpipe1"
set loud 0
#
global sybmsg
#set sybmsg(nullvalue) 0
set target /local/www/de/deimos/Memes
set outfile MemeSanity.html
set tmpfile MemeSanity.work
set ds [clock format [clock seconds]]
set user [id user]
#
set efp [open $target/$outfile w]
puts $efp "<HTML><head><title>Memes World Sanity Report: $ds</title></head>"
puts $efp "<body><h2>Memes World Sanity Report: $ds</h2>"
puts $efp "<hr><h1>In Progress</h1><hr>"
puts $efp "The Memes World Sanity Checker was started at $ds by $user."
puts $efp "<p>Please wait about 5 minutes and Reload this document."
puts $efp "<p>If the Sanity Report does not appear within that time, talk to de@ucolick.org."
puts $efp "<hr></body></html>"
#
close $efp
set efp [open $target/$tmpfile w]
#
puts $efp "<HTML><head><title>Memes World Sanity Report: $ds</title></head>"
puts $efp "<body><h2>Memes World Sanity Report: $ds</h2>"
puts $efp "<hr>This report is automatically produced by a Tcl script called msanity.<hr>"
puts $efp "<pre>"
#
set memtbl keck.dbo.Memes
set mcotbl keck.dbo.Mcontexts
set mvatbl keck.dbo.Mvalues
set maptbl keck.dbo.Mmaps
set mebtbl keck.dbo.Mbundles
set meptbl keck.dbo.Mpaths
set agtbl  keck.dbo.Agents
#
#
# Impose some sanity rules on the Meme World:
#   (items marked with * are not yet implemented)
#
# Existence checks (gross data entry errors)
#
#		THE RULES
#
# all ctrl_mid and rpt_mid must exist in Memes ( ERR)
# all isa_mid must exist in Memes ( ERR) 
# all map_mid must exist in Memes ( ERR) 
# all emids and tmids in Mbundles must exist in Memes ( ERR)
# all res_mid and par_mid in Mmaps must exist in Memes ( ERR)
# all mids in Mpaths must exist in Memes ( ERR)
# all agentids in Mpaths must exist in Agents ( ERR)
#
# Completeness/validity checks
#
# all Memes should have context ( WARN)
# if not a header or table you must have a cfmt ( ERR)
# you must always have a syty and a ffmt ( ERR)
# your fortran format length should be known ( WARN)
# syty can only be one of its list of possible values ( ERR)
# maxv >= minv, nulv and defv between maxv and minv,
#	nmin <= nmax and nmin => min and nmax <= max ( WARN)
# endd >= startd
# if you have a rpt_mid you must have a separ ( ERR)
# your semantics should be filled in, not Unknown or blank (count these)
# if syty or ffmt is tuple, the other should be also
#
# Mapping Sanity Checks
#
# if isa_mid and no map_mid, then is a straight ISA
#	no mmaps allowed!
# if map_mid but no mmaps, then is a simple format conversion
#	isa_mid must be set (contexts s/b different, too?)
# if mmaps but no map_mid, then is a list of legit values
#	res_val must be not null!  par_mid and par_val must be null!
# if mmaps and map_mid and res_val then must be a table lookup and
#	have an isa_mid;  res_val and par_val not null!  also,
#	map_mid must point to TableLook (doublecheck) and
#	par_mid s/b null (WARN)
# if mmaps and par_mid then must be a computation
#	map meme must have mbundles.  emids in mbundles must be
#	same list as par_mids in Mmaps.  par_val not null, res_val null.
#
# Sense checks
#
# no duplicate meme names should exist in the same context ( ERR)
# only certain types listed in valtmids list are bundles and tmids 
#	must be of those types ( ERR)
# you can't contain yourself (tricky!) -- no recursion ( ERR)
# things in the context MapTypes should appear as map_mids elsewhere
# things in the context MapParmas should appear as par_mids in Mmaps
# all map_mid must be syty map ( WARN) 
# all map_mid should be context MapTypes ( WARN)
#
# no map_mid can be a tuple  ( ERR)
# no map_mid can be a tuple element either ( ERR)
# nothing can be both an isa target and a map ( ERR)
# no isa_mid can be a map ( ERR)
# no map_mid may have an ISA ( ERR)
# no map_mid may have a map_mid ( ERR)
# no par_mid may have an ISA ( ERR)
#
# no par_mid may be a map
#
# if you define a sybase table (table + alt_name) check the
#	table to see if it matches the definition
#
#
# -------------------------------------PROCS----------------------------------
#
proc getcols {} {

global owner base table sybmsg syb server 

	global cols types sizes nulls

	set cols ""
	set types ""
	set sizes ""
	set nulls ""

        set usr $owner
        set tbl $table

        set sqlcmd "select syscolumns.name, systypes.name,  syscolumns.length, syscolumns.status from syscolumns, sysobjects, systypes  where syscolumns.id = sysobjects.id and  sysobjects.name = '$tbl' and  sysobjects.uid = user_id('$usr') and  syscolumns.usertype = systypes.usertype"

#       set sqlcmd "select syscolumns.name, systypes.name,  # syscolumns.length, syscolumns.status from syscolumns, sysobjects, systypes  # where syscolumns.id = sysobjects.id and  # sysobjects.name = '$table' and  # syscolumns.usertype = systypes.usertype"


        set sqt "syscolumns/sysobjects/systypes"
        set res [doSQL 1]
        if {[lindex $res 0] == "ERROR"} {
                echo "Something went wrong here:"
                echo "$sqlcmd\n$sybmsg(msgno): $sybmsg(msgtext)"
                exit 1
        }

	set i 0
        while {1 == 1} {

                set line [sybNext 1]
                if {[lindex $line 0] == "ERROR"} {
                        echo "$sybmsg(msgno): $sybmsg(msgtext)"
                        break
                }

                if {$line == ""} {break}

#               column name
                set c [lindex $line 0]
#               data type
                set t [lindex $line 1]
#               length, 3rd field
                set s [lindex $line 2]
#               nulls permitted?
                set n [lindex $line 3]

                lappend cols [string tolower $c]
                lappend colnames $c
                lappend types $t
                lappend sizes $s
                lappend nulls $n

		incr i

        }

}
#
proc checkMap {mid isamid mapmid mmaps} {

	global maptbl memtbl mebtbl efp Mnames messages

#	Use syb channel 2

	set sqlcmd "select count(*) from $mebtbl where tmid = $mapmid"
	set sqt $mebtbl
	doSQL 2
	set bc [sybNext 2]

#	Is it a simple format conversion?
	if {$mapmid && !$mmaps} {
		set sqlcmd "select context from $memtbl where mid = $mapmid"
		set sqt $memtbl
		doSQL 2
		set mc [sybNext 2]
		if {$mc != "MapTypes"} {
			lappend messages(MAPCTX) "WARN : context of map $Mnames($mapmid) is $mc not MapTypes ($Mnames($mid) $mid)"
		}
		if {!$isamid} {
			lappend messages(NO_ISA) " ERR : NO_ISA  : No ISAmid for format conversion for $Mnames($mid) $mid"
		}
#
#	In point of fact you could have a bundle, think about the DATE memes
#		if {$bc} {
#			lappend messages(BADBUN) " ERR : BADBUN  : map $Mnames($mapmid) should not have a bundle ($Mnames($mid) $mid)"
#		}
		return
	}

#	OK, then is it a list, a table lookup, or a comp?  check map cols
	set sqt $maptbl
	set sqlcmd "select count(*) from $maptbl where res_mid = $mid and res_val is not null"
	set sqt $maptbl
	doSQL 2
	set rnnc [sybNext 2]	
	set sqlcmd "select count(*) from $maptbl where res_mid = $mid and res_val is null"
	doSQL 2
	set rnc [sybNext 2]
	set sqlcmd "select count(*) from $maptbl where res_mid = $mid and par_val is null"
	doSQL 2
	set pnc [sybNext 2]
	set sqlcmd "select count(*) from $maptbl where res_mid = $mid and par_val is not null"
	doSQL 2
	set pnnc [sybNext 2]
	set sqlcmd "select count(*) from $maptbl where res_mid = $mid and par_mid is not null"
	doSQL 2
	set pnnm [sybNext 2]
	set sqlcmd "select count(*) from $maptbl where res_mid = $mid and par_mid is null"
	doSQL 2
	set pnm [sybNext 2]

#	puts $efp "rnc $rnc rnnc $rnnc pnc $pnc pnnc $pnnc pnm $pnm pnnm $pnnm"

#	A legit value list
	if {$mmaps && !$mapmid} {
		if {$rnc} {
			lappend messages(NULRES) " ERR : NULRES  : Null result values for $Mnames($mid) $mid in lookup map."
		}
		if {$pnnc} {
			lappend messages(PARVAL) " ERR : PARVAL  : Legit value list for $Mnames($mid) $mid should not have par_vals"
		}
		if {$pnnm} {
			lappend messages(PARMID) " ERR : PARMID  : Simple table lookup for $Mnames($mid) $mid should not have par_mids"
		}
		if {$bc} {
			lappend messages(BADBUN) " ERR : BADBUN  : map $Mnames($mapmid) $mapmid should not have a bundle ($Mnames($mid) $mid)"
		}
		return
	}

#	OK, so it must be a table lookup or a comp.  which?

	if {!$rnc && $rnnc} {
#	then it must be a table lookup: no null res val 

#	in which case, 
	set sqlcmd "select name from $memtbl where mid = $mapmid"
	set sqt $memtbl
	doSQL 2
	set mn [sybNext 2]
	if {$mn != "TableLook"} {
		lappend messages(BADMAP) "WARN : BADMAP  : table lookup map meme not TableLook for $Mnames($mid) $mid"
	}
	if {!$isamid} {
		lappend messages(NO_ISA) " ERR : NO_ISA  : Table lookup for $Mnames($mid) $mid, but no ISAmid"
	}
	if {$pnnm} {
		lappend messages(PARMID) " ERR : PARMID  : Table lookup for $Mnames($mid) $mid should not have par_mids"
	}
	if {$pnc} {
		lappend messages(PARVAL) " ERR : PARVAL  : Table lookup for $Mnames($mid) $mid should not have null par_vals"
	}
#
# This test is bogus.
#	set sqlcmd "select context from $memtbl where mid = $isamid"
#	set sqt $memtbl
#	doSQL 2
#	set ic [sybNext 2]
#	if {[lindex [split $ic .] end] != "bin"} {
#		puts $efp "???? : ODDCON  : expected ISA mid $isamid context to end in .bin for a table lookup"
#	}
	if {$bc} {
		lappend messages(BADBUN) " ERR : BADBUN  : map $Mnames($mapmid) $mapmid should not have a bundle ($Mnames($mid) $mid)"
	}
	return

	} elseif {!$rnnc && $rnc} {
#	then it must be a computational lookup : no res val

	if {!$bc} {
		lappend messages(COMPMAP) " ERR : map $Mnames($mapmid) $mapmid must have a bundle to be used in a computational map"
	}
	if {$bc != $mmaps} {
		lappend messages(COMPMAP) " ERR : map $Mnames($mapmid) has $bc terms but $Mnames($mid) $mid has only $mmaps value records in mmaps"
	}
	set sqlcmd "select count(*) from $mebtbl where tmid = $mapmid and emid not in (select par_mid from $maptbl where res_mid = $mid)"
	set sqt $mebtbl
	doSQL 2
	set bb [sybNext 2]
	set sqlcmd "select count(*) from $maptbl where res_mid = $mid and par_mid not in (select emid from $mebtbl where tmid = $mapmid)"
	set sqt $maptbl
	doSQL 2
	set bm [sybNext 2]
	if {$bb} {
		lappend messages(BADMAP) " ERR : BADMAP : Found $bb params in bundle for map $Mnames($mapmid) $mapmid which were not in map for $Mnames($mid) $mid"
	}
	if {$bm} {
		lappend messages(BADMAP) " ERR : BADMAP : Found $bm params in map for $Mnames($mid) $mid which were not in bundle for $Mnames($mapmid) map $mapmid"
	}
	if {$pnm} {
		lappend messages(BADMAP) " ERR : BADMAP : Compute map cannot have null par_mids ($Mnames($mid) $mid)"
	}
	if {$pnc} {
		lappend messages(BADMAP) " ERR : BADMAP : Compute map cannot have null par_vals"
	}
	
	return

	} else {

#	we're out of our everlovin minds
		lappend messages(BOGUSMAP) " ERR : BOGUSMAP : some res_val null and others not null for mid $mid"

	}
	
}
#
proc traceDescent {tm} {

	global mebtbl found tmids efp Mnames noden memes parent gen messages
	global foreBears fct

#	don't bother to check anything that is not a tmid... it can't bite you
	if {[lsearch $tmids $tm] < 0} {
		return ""
	}
	set parnode $noden
#	puts $efp "  TRACE $tm ($Mnames($tm)) as node $noden"
	catch {unset foreBears}
	set fct 0
	findForebears $tm $noden
	set fmids ""
	loop i 1 $fct {
		set fn $foreBears($i) 
		lappend fmids $memes($fn)
		lappend fnods $fn
	}
##	puts $efp "    Forebears $fl"
	if {[lsearch $fmids $tm] >= 0} {
		lappend messages(BUNRECU) " ERR : BUNRECU : Found $Mnames($tm) $tm on its own line of descent inside $Mnames($memes(0)) $memes(0) :"
		set fnods [linsert $fnods 0 $parnode]
		foreach f $fnods {
			lappend messages(BUNRECU) "\tnode $f meme $memes($f) name $Mnames($memes($f)) child of node $parent($f)"
		}
#		puts stderr " ERR : BUNRECU : Found $Mnames($tm) $tm on its own line of descent inside $Mnames($memes(0)) $memes(0)"
		return
	}
#	Else, keep going and check its children
#
#	find all immediate children of that tmid and trace them.
        set sqlcmd "select emid from $mebtbl where tmid = $tm"
        doSQL 1
        set elist ""
	incr gen
        while {1} {
                set em [sybNext 1]
                if {$em == ""} {break}
		lappend elist $em
	}
	foreach em $elist {
		incr noden
		set parent($noden) $parnode
		set memes($noden) $em
#		puts $efp "    Trace child $em..."
		traceDescent $em
        }
#
}
#
proc findForebears {mid node} {

	global memes parent efp foreBears fct messages

#	puts $efp "      findForebears $mid $node"
	set pnode $parent($node)

	if {$pnode == -1} {return ""}

	incr fct

	set pmid $memes($pnode)

	set foreBears($fct) $pnode

#	puts $efp "      calls findForebears $pmid $pnode"
#	flush $efp
	findForebears $pmid $pnode

}
#
proc checkISA m {

	global isafied checkisa isarecurs

	if {![info exists isafied($m)]} {return 0}

#	puts stderr "   CHECKING list $m : $isafied($m) for $checkisa"
	if {[lsearch $isafied($m) $checkisa] >= 0} {
		set isarecurs 1
		return 1
	}

	foreach i $isafied($m) {
		set res [checkISA $i]
		if {$res} {
			set isarecurs 1
			return 1
		}
	}
	
	return 0

}
# -------------------------------------MAIN-----------------------------------
set sqlcmd "select mid from $memtbl where name = 'syty'"
set sqt $memtbl
doSQL 1
set smid [sybNext 1]
if {$smid == ""} {
	puts stderr "INSANE Memes schema.  No meme for field syty."
	puts stderr "BAIL."
	exit 1
}
set sqlcmd "select res_val from $maptbl where res_mid = $smid"
set sqt $maptbl
doSQL 1
set oksyty ""
while {1} {
	set st [sybNext 1]
	if {$st == ""} {break}
	lappend oksyty $st
}
if {[llength $oksyty] == 0} {
	puts stderr "INSANE Memes schema.  No legit values for syty."
	puts stderr "BAIL."
	exit 1
}
#
set sqlcmd "select mid, name from $memtbl order by mid"
set sqt $memtbl
doSQL 1
set Mnames(0) "--------"
while {1} {
        set line [sybNext 1]
        if {$line == ""} {break}
	lassign $line mid name
	set Mnames($mid) $name
}
################################################################################
# First the simple stuff
# Completeness checks, and save a little something along the way
#
# first set up list of tmids, which is widely used later
#
set sqlcmd "select distinct tmid from $mebtbl"
set sqt $mebtbl
doSQL 1
set tmids ""
while {1} {
        set tm [sybNext 1]
        if {$tm == ""} {break}
        lappend tmids $tm
}
set tmids [lsort -integer $tmids]
#
#
puts $efp "[clock format [clock seconds]] Checking basic data entry"
if {$loud} { puts stderr "Checking basic data entry..." }
set sqlcmd "select * from $memtbl order by name"
set sqt $memtbl
doSQL 1
set cols [sybCols 1]
#
set tuples ""
set tables ""
set headers ""
set nosemct 0
set nolenct 0
set nolimct 0
set valtmids "table header file tuple map schema"
set reqtmids "table header file schema"
set isas ""
#
while {1} {

	set line [sybNext 1]
	if {$line == ""} {break}
	eval lassign \$line $cols
	foreach i {map_mid isa_mid ctrl_mid rpt_mid} {
		if {[set $i] == ""} {set $i 0}
	}

	case $syty in {
		{table} {
			lappend tables $mid
		}
		{header} {
			lappend headers $mid
		}
		{tuple} {
			if {$rpt_mid} {lappend rtuples $mid}
			lappend tuples $mid
		}
		{file} {
			lappend files $mid
		}
		{schema} {
			lappend schemata $mid
		}
		{map} {
			lappend maps $mid
		}
	}

	set sqlcmd "select count(*) from $maptbl where res_mid = $mid"
	set sqt $maptbl
	doSQL 2
	set mmaps [sybNext 2]

	if {($mmaps) || ($map_mid)} {
		checkMap $mid $isa_mid $map_mid $mmaps
	}

	if {$isa_mid} {
		lappend isafied($isa_mid) $mid
	}
#	Just a plain ISA and not taken care of by mapCheck
	if {$isa_mid && !$mmaps && !$map_mid} {
		lappend isas $mid
	}

	if {$context == ""} {
		lappend messages(MISCONT) "WARN : MISCONT : Missing context for meme $mid $name"
	}
	if {$syty == ""} {
		lappend messages(MISSYTY) " ERR : MISSYTY : Missing sybase type for meme $mid $name"
	}
	if {$ffmt == ""} {
		lappend messages(MISFFMT) " ERR : MISFFMT : Missing ffmt for meme $mid $name"
	}
	if {($syty == "tuple") || ($ffmt == "tuple")} {
		if {($syty != "tuple") || ($ffmt != "tuple")} {
			lappend messages(MISTUPLE) " ERR : MISTUPLE : meme $mid $name syty $sytye but ffmt $ffmt"
		}
	}
	if {[lsearch $valtmids $syty] < 0} {
		if {$cfmt == ""} {
			lappend messages(MISCFMT) " ERR : MISCFMT : Missing cfmt for meme $mid $name $syty"
		}
	} 
	if {[lsearch $reqtmids $syty] >= 0} {
		if {$cfmt != ""} {
			lappend messages(BOGUFMT) " ERR : BOGUFMT : Meme $mid $name is a $syty, can't have cfmt $cfmt"
		}
	}
	if {($syty == "map") && ($cfmt == "") && ($separ == "")} {
		lappend messages(BADMFMT) " ERR : BADMFMT : Meme $mid $name is a map with no cfmt and no separ"
	}
	if {[clength $ffmt] == 1} {
		incr nolenct
#		lappend messages(MISFLEN) "WARN : MISFLEN : Fortran format $ffmt incomplete for meme $mid $name"
	}
	if {$map_mid} {
		lappend mapped($map_mid) $mid
	}
	if {$rpt_mid > 0} {
		lappend repeated($rpt_mid) $mid
		if {($separ == "") && !$map_mid} {
			lappend messages(MISSEPR) " ERR : MISSEPR : Missing separ for repeating meme $mid $name (no map)"
		}
	}
	if {$ctrl_mid != 0} {
		foreach c $ctrl_mid {
		lappend indexed($c) $mid
		}
	}
	if {($semantics == "Unknown") || ($semantics == "")} {
		incr nosemct
	}

	set syty [lindex [split $syty (] 0]
	if {[lsearch $oksyty $syty] < 0} {
		lappend messages(BADSYTY) " ERR : BADSYTY : syty $syty invalid for meme $mid $name"
	}

	if {($syty == "float") || ($syty == "real")}  {

	if {($maxv == 0) && ($minv == 0)} {
		incr nolimct
	} else {
	if {[expr $maxv - $minv] == 0} {
		lappend messages(BADLIMS) " ERR : BADLIMS : max and min vals the same $maxv $minv for meme $mid $name"
	}
	if {$maxv < $minv} {
		lappend messages(BADLIMS) " ERR : BADLIMS : maxv $maxv is less than minv $minv for meme $mid $name"
	}
	if {$defv != ""} {
	if {($defv > $maxv) || ($defv < $minv)} {
		lappend messages(BADDEFV) " ERR : BADDEFV : defv $defv is not between min and max for meme $mid $name"
	}
	}
	if {$nulv != ""} {
	if {($nulv <= $maxv) && ($nulv >= $minv)} {
		lappend messages(BADNULV) " ERR : BADNULV : nulv $nulv is between min and max for meme $mid $name"
	}
	}
	if {$nmin != ""} {
	if {$nmin < $minv} {
		lappend messages(BADNMIN) "WARN : BADNMIN : nmin $nmin is not greater than min for meme $mid $name"
	}
	}
	if {$nmax != ""} {
	if {$nmax >= $maxv} {
		lappend messages(BADNMAX) "WARN : BADNMAX : nmax $nmax is not less than max for meme $mid $name"
	}
	}
	}

	}

}
#
if {$nolenct} {
	lappend messages(MISFLEN) "WARN : MISFLEN : No length in fortran format for $nolenct memes"
}
if {$nosemct} {
	lappend messages(MISSEMN) "WARN : MISSEMN : Missing semantics for $nosemct memes"
}
if {$nolimct} {
	lappend messages(MISLIMI) "WARN : MISLIMI : Missing limits for $nolimct numeric memes"
}
#
# DATE checks
#
puts $efp "[clock format [clock seconds]] Checking dates"
if {$loud} { puts stderr "Checking dates..."}
set sqlcmd "select * from $memtbl where endd is not null and startd is not null and endd !> startd"
set sqt $memtbl
doSQL 1
set badatect 0
set badate ""
while {1} {
	set line [sybNext 1]
	if {$line == ""} {break}
	eval lassign \$line $cols
	append badate "\t$name $mid\n"
	incr badatect
}
if {$badatect} {
	lappend messages(BADDATE) "WARN : BADDATE : start and end dates wrong for $badatect memes:"
	lappend messages(BADDATE) "$badate"
}
#
puts $efp "[clock format [clock seconds]] Checking for health of Mbundles"
if {$loud} { puts stderr "Checking for health of Mbundles..." }
#
set sqlcmd "select * from $memtbl where mid in ([join $tmids ,])"
doSQL 1
set cols [sybCols 1]
while {1} {
	set line [sybNext 1]
        if {$line == ""} {break}
        eval lassign \$line $cols
	if {[lsearch $valtmids $syty] < 0} {
		lappend messages(BADTMID) " ERR : BADTMID : Tmid $mid $name appears in Mbundles but is a $syty in Memes"
	}
}
#
set sqlcmd "select * from $memtbl where syty in ('[join $reqtmids "','"]')"
doSQL 1
while {1} {
        set line [sybNext 1]
        if {$line == ""} {break}
        eval lassign \$line $cols
	if {[lsearch $tmids $mid] < 0} {
		if {$syty != "map"} {
		lappend messages(BADMEME) " ERR : BADMEME : Meme $mid $name is a $syty but is not a tmid in Mbundles"
		}
	}
}
#
foreach tm $tmids {
#	puts stderr "... Checking bundle $Mnames($tm) $tm for count and dups"
	if {![info exists Mnames($tm)]} {
		lappend messages(NOSUCHB) " ERR : NOSUCHB : Meme $tm does not exist yet is a bundle!"
		continue
	}
	set sqlcmd "select count(*) from $mebtbl where tmid = $tm"
	doSQL 1
	set ect [sybNext 1]
# this query is simply too unwieldy for large bundles.  let's go back to
# manipulation of lists instead.
#	set sqlcmd "select emid,eordr from $mebtbl a where tmid = $tm and ( (select count(*) from $mebtbl where emid = a.emid and tmid = $tm) > 1 or (select count(*) from $mebtbl where eordr = a.eordr and tmid = $tm) > 1)"
	set sqlcmd "select emid,eordr from $mebtbl where tmid = $tm"
	set sqt $mebtbl
	doSQL 1
	set elems ""
	set ordrs ""
	while {1} {
		set line [sybNext 1]
		if {$line == ""} {break}
		lassign $line em eo
		lappend elems $em
		lappend ordrs $eo
	}
#
	if {[lsearch $isas $tm] >= 0} {
		lappend messages(ISATMID) " ERR : ISATMID : mid $tm ISA, yet is a tmid"
	}
#
	if {$ect == 1} {
		lappend messages(MONOBUN) " ERR : MONOBUN : tmid $tm has only one element"
	}
#
	set els [lsort -integer $elems]
	set dupes ""
	loop j 1 [llength $els] {
		set this [lindex $els $j]
		set last [lindex $els [expr $j - 1]]
		if {$this == $last} {
			lappend dupes $this
		}
	}
	set ors [lsort -integer $ordrs]
	set dupos ""
	loop j 1 [llength $ors] {
		set this [lindex $ors $j]
		set last [lindex $ors [expr $j - 1]]
		if {$this == $last} {
			lappend dupos $this
		}
	}
	set bogus ""
	loop j 1 [llength $elems] {
		set em [lindex $elems $j]
		set eo [lindex $ordrs $j]
		if {([lsearch $dupes $em] >= 0) || ([lsearch $dupos $eo] >=0)} {
		lappend bogus "$em $eo"
		}
	}
	if {![lempty $bogus]} {
		lappend messages(BUNDUPS) " ERR : BUNDUPS : Duplicate emid or eordr in table $Mnames($tm) $tm:"
		foreach b $bogus {
			lassign $b em eo
			lappend messages(BUNDUPS) "\t$Mnames($em) $em # $eo"
		}
	}
}
#
#
if {$loud} { puts stderr "Checking appropriate bundle typing..." }
puts $efp "[clock format [clock seconds]] Checking appropriate bundle typing"
# tmids have to be tables, tuples, maps, files, schemata, or headers
lvarcat allpar $tables $headers $schemata $files
lassign [intersect3 $tmids $allpar] junk common missing
unset allpar
lvarcat allpar $tables $headers $tuples $schemata $maps $files
lassign [intersect3 $tmids $allpar] egreg common junk
if {$egreg != ""} {
	lappend messages(BADTMID) " ERR : BADTMID : Not [join $valtmids /] yet is a tmid:"
	foreach e $egreg {
		if {[catch {lappend messages(BADTMID) "\t$Mnames($e) $e"}]} {
			lappend messages(BADTMID) "\t$e isn't even a real Meme!"
		}
	}
}
if {$missing != ""} {
	lappend messages(MISTMID) "WARN : MISTMID : [join $reqtmids /] but not a tmid:"
	foreach m $missing {
		lappend messages(MISTMID) "\t$Mnames($m) $m"
	}
}
#
# check tuples specially because they are tricky
#
lassign [intersect3 $tmids $tuples] junk com miss
lassign [intersect3 $miss $rtuples] miss ok outside
if {![lempty $miss] > 0} {
	lappend messages(TUPNOBU) " ERR : TUPNOBU : Tuple with no Bundle and no Rpt_mid:"
	foreach m $miss {
	lappend messages(TUPNOBU) "\t$Mnames($m) $m"
	}
}
#
set sqlcmd "select mid from $memtbl where exists (select * from $maptbl where par_mid = $memtbl.mid) and not exists (select * from $mebtbl where emid = $memtbl.mid)"
set sqt "$memtbl $maptbl $mebtbl"
doSQL 1
set badm ""
while {1} {
	set m [sybNext 1]
        if {$m == ""} {break}
	lappend badm $m
}
if {[llength $badm] > 0} {
	lappend messages(COMNOBU) " ERR : COMNOBU : must be computational Map Param (Res_mid) yet no Mbundle:"
	foreach m $badm {
		lappend messages(COMNOBU) "\t$Mnames($m) $m"
	}
}
#
set sqlcmd "select * from $memtbl a where a.isa_mid > 0 and syty = 'tuple' and a.syty = (select syty from $memtbl where mid = a.isa_mid)"
set sqt $memtbl
doSQL 1
set cols [sybCols 1]
set rts ""
while {1} {
	set line [sybNext 1]
	if {$line == ""} {break}
	eval lassign \$line $cols
	if {$rpt_mid == ""} {set rpt_mid 0}
	lappend messages(ISATUPL) "WARN : ISATUPL : $name $mid tuple ISA $Mnames($isa_mid) $isa_mid also a tuple"
}
#
# Existence checks
#
puts $efp "[clock format [clock seconds]] Checking existence"
#
if {$loud} { puts stderr "Checking existence..." }
set emsg(indexed) " ERR : BADCTRM : Control MID"
set emsg(repeated) " ERR : BADRPTM : Rpt MID"
set emsg(mapped) " ERR : BADMAPM : Map MID"
set emsg(isafied) " ERR : BADISAM : ISA MID"
#
foreach t {repeated indexed mapped isafied} {
#
puts $efp "[clock format [clock seconds]] Checking $t meme controls"
if {$loud} { puts stderr "Checking $t meme controls  ..." }
#
	set errstr "$emsg($t)"
	set errcod [lindex $errstr 2]
	if {![info exists $t]} {continue}
#
	set ms [array names $t]
	set sqlcmd "select mid from $memtbl where mid in ([join $ms ,])"
	doSQL 1
	set fm ""
	while {1} {
		set m [sybNext 1]
		if {$m == ""} {break}
		lappend fm $m
	}
	lassign [intersect3 $ms $fm] egreg ok imposs
	foreach e $egreg {
		set rms [set [set t]($e)]
		lappend messages($errcod) "$errstr $e does not exist, used by:"
		foreach m $rms {
			lappend messages($errcod) "\t$Mnames($m) $m"
		}
	}
}
#
set emsg(BADMPME) "Meme \$mid in Mpaths does not exist in Memes"
set emsg(BADEMID) "Meme \$Mnames(\$emid) \$emid of \$Mnames(\$tmid) \$tmid in Mbundles does not exist in Memes"
set emsg(BADTMID) "Meme \$Mnames(\$tmid) \$tmid (tmid) in Mbundles does not exist in Memes"
set emsg(BADTYPE) "Meme \$Mnames(\$isa_mid) \$isa_mid ISA of \$Mnames(\$mid) \$mid does not exist in Memes"
set sqlc(BADMPME) "select * from $meptbl where ptype = 'M' and mid not in (select mid from $memtbl)"
set sqlc(BADEMID) "select * from $mebtbl where emid not in (select mid from $memtbl)"
set sqlc(BADTMID) "select * from $mebtbl where tmid not in (select mid from $memtbl)"
set sqlc(BADTYPE) "select * from $memtbl where isa_mid > 0 and isa_mid not in (select mid from $memtbl)"
set sqt "$meptbl $mebtbl $memtbl"
foreach ertype {BADMPME BADEMID BADTMID BADTYPE} {
if {$loud} { puts stderr "  Checking for $ertype ..." }
set sqlcmd $sqlc($ertype)
doSQL 1
set cols [sybCols 1]
while {1} {
	set line [sybNext 1]
        if {$line == ""} {break}
        eval lassign \$line $cols
	catch {eval lappend messages($ertype) \" ERR : $ertype : $emsg($ertype)\"}
}
}
#
#
puts $efp "[clock format [clock seconds]] Checking for bad agents"
if {$loud} { puts stderr "Checking for bad agents ..." }
set sqlcmd "select mpid, sendr, rcvr, ctrlr from $meptbl"
set sqt $meptbl
doSQL 1
while {1} {
	set mis 0
	set line [sybNext 1]
        if {$line == ""} {break}
	lassign $line mpid sendr rcvr ctrlr
	lappend pagents $sendr
	lappend pagents $rcvr
	lappend pagents $ctrlr
	if {$sendr == ""} {
		set misag Sender
		set mis 1
	}
	if {$rcvr == ""} {
		set misag Receiver
		set mis 1
	}
	if {$ctrlr == ""} {
		set misag Controller
		set mis 1
	}
	lappend mpids($sendr) $mpid
	lappend mpids($rcvr) $mpid
	lappend mpids($ctrlr) $mpid
	if {$mis} {
	lappend messages(MISAGNT) " ERR : MISAGNT : BLANK $misag AGENT ID found in Mpaths $mpid!"
	}
}
set pagents [lrmdups $pagents]
#
set sqlcmd "select agentid from $agtbl"
set sqt $agtbl
doSQL 1
while {1} {
	set aid [sybNext 1]
	if {$aid == ""} {break}
	lappend aids $aid
}
#
lassign [intersect3 $pagents $aids] egreg ok imposs
#
foreach e $egreg {
	lappend messages(UNDAGNT) " ERR : UNDAGNT : Agent ID $e appears in Mpaths $mpids($e) but not in Agents"
}
#
#
puts $efp "[clock format [clock seconds]] Checking for dup meme names"
if {$loud} { puts stderr "Checking for dup meme names..." }
set sqlcmd "select distinct context from $memtbl"
set sqt $memtbl
doSQL 1
while {1} {
	set mc [sybNext 1]
	if {$mc == ""} {break}
	lappend mcs $mc
}
#
foreach c $mcs {
	set sqlcmd "select count(*) from $mcotbl where mcontext = '$c'"
	doSQL 1
	set cc [sybNext 1]
	if {!$cc} {
		lappend messages(UNDFCONT) " ERR : UNDFCONT : Context $c found in Memes not in Mcontexts"
	}
	if {!$cc > 1} {
		lappend messages(DUPLCONT) " ERR : DUPLCONT : Context $c found $cc times in Mcontexts"
	}
	set sqlcmd "select name from $memtbl where context = '$c'"
	doSQL 1
	set mns ""
	while {1} {
		set mn [sybNext 1]
		if {$mn == ""} {break}
		lappend mns $mn
	}
#	puts $efp "memes for context $c are : $mns"
	set mnu [lrmdups $mns]
	if {[llength $mnu] < [llength $mns]} {
	catch {unset ct}
	catch {unset bad}
	foreach m $mns {
#		puts $efp "   Check meme $m for dups in $c"
		if {![info exists ct($m)]} {
			set ct($m) 1
			} else {
			incr ct($m)
			}
			if {[set ct($m)] > 1} {
				set bad($m) [set ct($m)]
			}
	}
	foreach m [array names bad] {
	lappend messages(DUPNAME) " ERR : DUPNAME : Meme name $m occurs $bad($m) times in context $c"
	}
	}
}
catch {unset ct}
#
#
#
# And now for the really clever stuff!
# Recurse or iterate... let's recurse...
#
puts $efp "[clock format [clock seconds]] Checking for recursive inclusion"
if {$loud} { puts stderr "Checking for recursive inclusion..." }
set sqlcmd "select count (distinct tmid) from $mebtbl"
set sqt $mebtbl
doSQL 1
set bc [sybNext 1]
if {$bc != [llength $tmids]} {
	lappend messages(MISMAT) "WHAT : MISMAT  : Got [llength $tmids] tmids, but there are $bc bundles in $mebtbl"
}
set ct 1
foreach tm $tmids {
#	puts $efp "*** BUNDLE CHECK $ct : check bundle $tm  $Mnames($tm) ***"
	catch {unset nodes}
	catch {unset parent}
	set noden 0
	set gen 0
	set memes($noden) $tm
	set parent($noden) -1
#	This sets up the arrays nodes and parent, checking for recursion
	traceDescent $tm
	incr ct
}
#
#
puts $efp "[clock format [clock seconds]] Checking for recursive ISA"
foreach i [array names isafied] {
#	puts stderr "checking ISA $i : $isafied($i)"
	set checkisa $i
	set isarecurs 0
	set res [checkISA $i]
	if {$isarecurs} {
		lappend messages(ISARECU) " ERR : ISARECU : somewhere ISA $i chain is recursive!"
	}
}
#
#	Maps sanity
#
if {$loud} { puts stderr "Checking Map/ISA Sanity..." }
puts $efp "[clock format [clock seconds]] Checking Map/ISA Sanity"
#
set sqlcmd "select mid,isa_mid,map_mid from $memtbl where mid in (select distinct map_mid from $memtbl) and (isnull(map_mid,0) > 0 or isnull(isa_mid,0) > 0)"
set sqt $memtbl
doSQL 1
set ms ""
while {1} {
	set line [sybNext 1]
	if {$line == ""} {break}
	lappend ms $line
}
if {![lempty $ms]} {
	lappend messages(MAPISAMAP) " ERR :MAPISAMAP: Maps cannot have isa or map:"
	foreach m $ms {
		lassign $m mid isa map
		lappend messages(MAPISAMAP) "\t$Mnames($mid) $mid  ISA $Mnames($isa) $isa  MAP $Mnames($map) $map"
	}
}
#
set sqlcmd "select mid from $memtbl where mid in (select distinct isa_mid from $memtbl) and mid in (select distinct map_mid from $memtbl)"
set sqt $memtbl
doSQL 1
set ms ""
while {1} {
	set line [sybNext 1]
	if {$line == ""} {break}
	lappend ms $line
}
if {![lempty $ms]} {
	lappend messages(MAPISA) " ERR : MAPISA  : You can't be both a map and an ISA:"
	foreach m $ms {
		lappend messages(MAPISA) "\t$Mnames($m) $m" 
	}
}
#
set sqlcmd "select mid,syty,context from $memtbl where mid in (select distinct map_mid from $memtbl) and (context != 'MapTypes' or syty != 'map')"
doSQL 1
set ms ""
while {1} {
	set line [sybNext 1]
	if {$line == ""} {break}
	lappend ms $line
}
#
if {![lempty $ms]} {
	lappend messages(MAPTYPE) " ERR : MAPTYPE : Map memes must be of context MapTypes and type map"
	foreach m $ms {
		lassign $m mid ty ctx
		lappend messages(MAPTYPE) "\t$Mnames($mid) $mid is type $ty in $ctx"
	}
}
#
set sqlcmd "select mid from $memtbl where mid in (select distinct map_mid from $memtbl) and mid in (select distinct emid from $mebtbl)"
doSQL 1
set ms ""
while {1} {
	set m [sybNext 1]
	if {$m == ""} {break}
	lappend ms $m
}
if {![lempty $ms]} {
	lappend messages(MAPEMID) " ERR : MAPEMID : Map memes cannot be tuple elements:"
	foreach m $ms {
		lappend messages(MAPEMID) "\t$Mnames($m) $m is an emid in Mbundles."
	}
}
#
set sqlcmd "select mid,isa_mid,map_mid from $memtbl where mid in (select distinct par_mid from $maptbl) and (isnull(isa_mid,0) > 0 or isnull(map_mid,0) > 0)"
doSQL 1
while {1} {
	set line [sybNext 1]
	if {$line == ""} {break}
	lappend ms $line
}
if {![lempty $ms]} {
	lappend messages(PARISAMAP) " ERR :PARISAMAP: Param MIDs can't have ISA or MAP:"
	foreach m $ms {
		lassign $m mid isa map
		lappend messages(PARISAMAP) "\tPAR $Mnames($mid) $mid ISA $Mnames($isa) $isa MAP $Mnames($map) $map"
	}
}
#
#
puts $efp "[clock format [clock seconds]] Checking on any Sybase table definitions"
if {$loud} { puts stderr "Checking on any Sybase table definitions..." }
#
set sqlcmd "select mid,name,alt_name from $memtbl where syty = 'table'"
set sqt $memtbl
doSQL 1
while {1} {
	set line [sybNext 1]
	if {$line == ""} {break}
	lassign $line mid name aname
	if {$aname != ""} {
	keylset stables($mid) name $name tname $aname
#	puts stderr "   check table $aname"
	}
}
#
foreach tm [array names stables] {

	set tn [keylget stables($tm) tname]
	set mn [keylget stables($tm) name]
#	puts stderr "   check table $tn"
	lassign [split $tn .] base owner table
	getcols

	set sqlcmd "select count(*) from $mebtbl where emid = $tm"
	doSQL 1
	set sct [sybNext 1]
	if {!$sct} {
	lappend messages(SYNOSCHEM) "WARN : NOSCHEM : The table $tn does not appear in any schema"
	}
	
	if {[lempty $cols]} {
		lappend messages(SYNOSTABL) "WARN : NOSTABL : No Sybase table exists for Meme table $mn"
		continue
	}

	set sqlcmd "select * from $memtbl where mid in (select emid from $mebtbl where tmid = $tm)"
	set sqt "$memtbl $mebtbl"
	doSQL 1
	set cc [sybCols 1]

	set mcols ""
	while {1} {
		set line [sybNext 1]
		if {$line == ""} {break}
		eval lassign \$line $cc
		lassign [split $syty (] st sl
		set sl [string trimright $sl )]
		set ci [lsearch $cols $name]
		lappend mcols $name
		if {$ci < 0} {continue}
		set cl [lindex $sizes $ci]
		set ct [lindex $types $ci]
		if {$ct != $st} {
		lappend messages(SYBADTYPE) " ERR : BADTYPE : Table $tn col $name is type $ct, but meme table says $st"
		}
		if {$sl != ""} {
		if {$cl != $sl} {
		lappend messages(SYBADLENG) " ERR : BADLENG : Table $tn col $name is a $ct $cl, but meme table says $st $sl"
		}
		}
	}
	if {[lempty $mcols]} {
		lappend messages(SYNOMTABL) " ERR : NOMTABL : No Meme bundle entries for Sybase table $tn ($mn)"
		continue
	}
	set cols [string tolower $cols]
	set mcols [string tolower $mcols]
	lassign [intersect3 $cols $mcols] insyb ok inmem
	if {[llength $insyb] > 0} {
		lappend messages(SYBADTABL) " ERR : BADTABL : Sybase table $tn contains columns $insyb not found in Memes table $mn"
	}
	if {[llength $inmem] > 0} {
		lappend messages(SYBADTABL) " ERR : BADTABL : Meme table $mn contains columns $inmem not found in Sybase table $tn"
	}
}
#
foreach e [lsort [array names messages]] {
puts $efp "\n\n$e ============================================================= $e\n"
foreach m $messages($e) {
	puts $efp "$m"
}
}
puts $efp "\nNOTE : Table column tests are case-insensitized"
#
puts $efp "</pre>"
puts $efp "<hr>"
puts $efp "Questions about this report?  talk to de@ucolick.org"
puts $efp "</body></html>"
close $efp
#
unlink $target/$outfile
frename $target/$tmpfile $target/$outfile
#
