# SLITMASK tlib
# procs for manipulating slitmask design files and
# the ingested data from same
#



#@package: FITSFILE eatFits fitsSanity getHDUKval ISOtoSybDate checkType 

proc eatFits ff {

		global HDU Kwds Kcom Data Cols Fkey HDUid

#	This routine eats ANY FITS FILE -- it is tweaked
#	towards processing of table extensions, of course --
#	proceeding through all HDUs and collecting their
#	keywords (and table data if any).
#
#	several arrays are generated.
#
#	HDU(n) offers very basic info:  hdutype, name, pkey
#		if relevant, indexed by HDU number
#	HDUid(name) reverses this lookup, translates name to number
#	Kwds(n) offers all kwds and values for HDU(n) as one
#		keyed list per HDU
#	Kcom(n) offers all kwds and comments for HDU(n) as one
#		keyed list per HDU
#	Cols(n,c) offers all columns for HDU(n), c orders them
#		correctly:  first kl pair is {name <name>}
#	Cols(n) offers simple list of all cols for HDU(n)
#	Data(n,r) offers all rows of data for HDU(n) as an
#		assoc array of keyed lists, klindex is cname,
#		klvalue is value
#	Fkey(n) shows the foreign keying of table N, in an
#		assoc array of keyed lists, where klindex is
#		HDUn col name and klvalue is ftablename:fcolname
#
#	these arrays can later be used to get at all the data,
#	store it in RDBMS or spit it out to other formats, etc.
#	

	set i 1

	while {1} {

	set err [catch {$ff move $i} res]

	if $err {
		puts stderr "END OF FITS FILE : no HDU $i"
		break
	}

	set fortblk [list HDLOC HDXTN HDNAM HDVER HDSUM HDDCS]
	set forkeyk [list FKHDU FKTYP]

	set t [$ff info hdutype]
	keylset HDU($i) type $t

	if {$t == "ASCII Table"} {
		set nc [$ff info ncols]
		set nr [$ff info nrows]
		set coldata [$ff info column .*]
		set cols ""
		set j 1
		foreach cd $coldata {
			lassign $cd cnam ctyp unit fmt dfmt size offs scal nulv
			keylset Cols($i,$j) nam $cnam typ $ctyp unit $unit fmt $fmt dfmt $dfmt size $size offs $offs scal $scal nulv $nulv
			lappend cols $cnam
			incr j
		}
		set Cols($i) $cols
		set tdata [$ff get table]
		set j 1
		foreach row $tdata {
			eval lassign \$row $cols
			foreach c $cols {
			keylset Data($i,$j) $c [string trim [set $c] "' "]
			}
			incr j
		}
	}

	set kwds [$ff get keyword]
	foreach kw $kwds {
		lassign $kw k v cmt
		set v [string trim $v "' "]
		set cmt [string trim $cmt "' "]
		keylset Kwds($i) $k $v
		keylset Kcom($i) $k $cmt
		if {$k == "EXTNAME"} {
			keylset HDU($i) name $v
			set HDUid($v) $i
		}
		if {[crange $k 0 4] == "HDNAM"} {
			set j [crange $k 5 end]
			set ft2nam($j) $v
#				puts stderr "Ftable number $j maps to name $v"
		}
		if {[crange $k 0 4] == "FKHDU"} {
			set j [crange $k 5 end]
#				puts stderr "Fkey $j table $i maps into ftable $v"
			set fk2ft($j) $v
		}
		if {[crange $k 0 4] == "PKTYP"} {
			set j [crange $k 5 end]
			set pkeys($i,$j) $v
		}
	}

#	why these subsequent iterations which seem redundant?
#	because you can't count at all on the order in which
#	you get the kwds out of fitstcl!
#	you don't necessarily know FKHDU1 before you know
#	FKFYP1 or FKTYP1, even if they are in the right order
#	in the header.

	set pk ""
	foreach pki [lsort [array names pkeys $i,*]] {
		catch {lappend pk $pkeys($pki)}
	}
	keylset HDU($i) pkey $pk

	foreach kw $kwds {

		lassign $kw k v cmt
		set v [string trim $v "' "]
		set cmt [string trim $cmt "' "]

		if {([crange $k 0 4] == "FKTYP") || ([crange $k 0 4] == "FKFYP")} {
		set j [crange $k 5 end]
		set t $fk2ft($j)
		set tn $ft2nam($t)
		if {[string first "FYP" $k] >= 0} {
			lappend fkey($i,$j) $tn:$v
		} else {
			lappend fkey($i,$j) $v
		}

		}

	}

	foreach e [lsort [array names fkey $i,*]] {
		
		foreach s $fkey($e) {
			if {[string first : $s] >= 0 } {
				set fk $s
			} else {
				set mk $s
			}
		}
		keylset Fkey($i) $mk $fk
	}
	
	
	incr i

	}
	
}
#
##
#
proc fitsSanity {} {

	global HDU Kwds Kcom Data Cols Fkey HDUid
	global Expect 
	global collected elements elinfo Entities

#	This routine tries to check whether the FITS file we
#	just ate is internally consistent.  What can we check?
#	only fits table extension attributes really...

#	we have to assume that some realm of discourse has been
#	inherited from memes, so we can compare against that
#	world.

#	First:  did we get as many HDU as we expected?
#	if not, we're probably in deep trouble, so bail.

	set hdus [llength [array names HDU]] 
	if {$hdus != $Expect(hdus)} {
		puts stderr "ERROR expected $Expect(hdus) HDUs in file"
		puts stderr "      got      $hdus"
		puts stderr "BAIL"
		exit 1
	} else {
		puts stderr "OK, we got the right number of HDUs"
	}

#	second, were we told the truth about each hdu?

	foreach h [lsort -integer [array names HDU]] {

		set t [keylget HDU($h) type]

		if {[string first Table $t] >= 0} {

			set n [keylget HDU($h) name]
			set pk [keylget HDU($h) pkey]
			if {[string first [string tolower $n] [string tolower $Entities]] >= 0} {
				puts stderr "Found table $h ($n) in known Entities"
			} else {
				puts stderr "Did NOT find table $h ($n) in known Entities"
			}

		}

		set err [catch {set et [keylget Expect($h) type]} res]
		if {$err} {
			puts stderr "ERROR couldn't get expected Type for header $h"
			puts stderr "      $res"
			exit 1
		}
		if {$et != $t} {
			puts stderr "ERROR hdu $h expected type $et got type $t"
		}

		if {$h == 1} {
			continue
		}

		set err [catch {set en [keylget Expect($h) name]} res]
		if {$err} {
			puts stderr "ERROR couldn't get expected Type for header $h"
			puts stderr "      $res"
			exit 1 
		}
		if {$en != $n} {
			puts stderr "ERROR hdu $h expected name $en got type $n"
		}

	}

}
#
##
#
#
proc getHDUKval {hdu kw {rec {}} } {

	global HDU HDUid Kwds Data

	puts stderr "*** getHDUKval"

	set hid $HDUid($hdu)

	set uniq [clock seconds]
	set v ERROR$uniq

	if {$rec == ""} {

	catch {set v [keylget Kwds($hid) $kw]}

	} else {

	puts stderr "Try to get Data $hid,$rec key $kw"

	catch {set v [keylget Data($hid,$rec) $kw]}

	}

	if {$v == "ERROR$uniq"} {
		return "HDUKval FAIL"
	} else {
		return $v
	}
}
#
##
#
# translate routines

proc ISOtoSybDate d {

#	we get a date that looks like this
#		1999-12-02T19:22:34
#	and we turn it into something sybase can read, we hope

	lassign [split $d T] date time

	set ret "$date $time"

	return $ret

}
#
proc checkType v {

        lassign [chkNum I $v] res n

        if !$res {
        	if {[string first . $n] >= 0} {
        		set t F
        	} else {
        		set t I
        	}
        } else {
        	set t S
        }

	return $t

}
#
#

#@package: GROK getTable mapTables sortTables mapData putData getIndirect stripEmailID

proc getTable t {

	global Tables mbase owner Primary Null Ident
	global sybmsg

	
	set sqt sysobjects
	set sqlcmd "select id from $mbase.dbo.sysobjects where type = 'U' and name = '$t'"
	doSQL 1
	set tid [sybNext 1]

	set sqt syscolumns
	set sqlcmd "select * from $mbase.dbo.syscolumns where id = $tid order by number"
	doSQL 1
	set cols [sybCols 1]

	while 1 {

		set line [sybNext 1]
		if {$line == ""} {break}
		eval lassign \$line $cols

		set Null($t,$name) 0
		set Ident($t,$name) 0

		if [expr {$status & 8}] {
			set Null($t,$name) 1
		}
		if [expr {$status & 128}] {
			set Ident($t,$name) 1
		}
	}

	set sqlcmd "set rowcount 1"
	set sqt NONE
	doSQL 1

	set fqn $mbase.$owner.$t
	set sqlcmd "select * from $fqn"
	set sqt $fqn
	set res [doSQL 1]

	if {[string first ERROR $res] >= 0} {
		puts stderr "Oops couldn't find table $fqn"
		continue
	}


	foreach c [getCols] {
		lassign $c cn ct
		lassign $ct ty sz
		set tf [getType $ty]
		keylset Tables($t) $cn [list $tf $ty $sz]
	}	

	set sqlcmd "set rowcount 0"
	set sqt NONE
	doSQL 1

set keys [SYBgetPkeys $fqn]
set pkc ""
set cs [keylkeys Tables($t)]
foreach k $keys {
	if $k {
	lappend pkc [lindex $cs [expr $k - 1]]
	}
}
set Primary($t) $pkc

}
# here we take the fits RDBmap extension and check it out.
#
proc mapTables {} {

global HDU Kwds Kcom Data Cols Fkey HDUid
global MapT MapH MapK MapC MapD Tables sybmsg mbase owner 
global Primary Bad MapCt Indirect TabList

#	The object is to get the list of tables out of RDBmap
#	and verify their shape and link them to the data in
#	the FITS HDUs and extensions from the file.

#	RDBmap is a special hardwired name known a priori.

# start with no Bad maps
set Bad ""

set mhdu -1
catch {set mhdu $HDUid(RDBmap)}

if {$mhdu < 0} {
	puts stderr "ABJECT FAILURE\nThis FITS file contains no HDU called RDBmap."
	exit 1
}

foreach e [array names Data $mhdu,*] {

	foreach k [keylkeys Data($e)] {
		set $k [keylget Data($e) $k]
	}

	if ![info exists MapT($RDBtable)] {
	set MapT($RDBtable) $MEMBER_NAME
	}
	if ![info exists MapH($MEMBER_NAME)] {
	set MapH($MEMBER_NAME) $RDBtable
	} else {
	if ![lcontain $MapT($RDBtable) $MEMBER_NAME] {
		lappend MapT($RDBtable) $MEMBER_NAME
	}
	if ![lcontain $MapH($MEMBER_NAME) $RDBtable] {
		lappend MapH($MEMBER_NAME) $RDBtable
	}
	}

	if ![info exists MapCt($MEMBER_NAME.$RDBtable)] {
		set MapCt($MEMBER_NAME.$RDBtable) 0
	}
	incr MapCt($MEMBER_NAME.$RDBtable)
	

#		we know that MapK items exist only once (1 record)
#		or be replicated (same value) in N records
#		whereas MapC items may exist w/diff values in N records

	set key $MEMBER_NAME.$Element
	keylset Map${KwdOrCol}($key) $RDBtable $RDBfield 
	eval keylset MapD($RDBtable.$RDBfield) [split $key .]

}

foreach e [array names MapT] {

	getTable $e
}

#	Now, are there any booboos here?
#	sanity check

foreach x [list C K] {
foreach e [array names Map$x] {

	foreach t [keylkeys Map${x}($e)] {
	set f [keylget Map${x}($e) $t]
	set fs [keylkeys Tables($t)]

	if ![lcontain $fs $f] {

		set bad 0

		if {[string first : $f] >= 0} {
			set fl [split $f :]
			if {[llength $fl] != 3} {
				set bad 1
			} else {
			lassign [split $f :] f mt mf
			if ![lcontain $fs $f] {
				set bad 1
			} else {
				set Indirect($e,$t.$f) $mt:$mf
				if ![info exists Tables($mt)] {
					getTable $mt
				}
			}
			}
		}

		if $bad {
		puts stderr "WARNING table $t does not have a field $f"
		puts stderr "        but $x HDU.elem $e wants to map to it"
		continue
		}
	}

#		get header and col/key name, so as to get type
#		and double-check that the dbase type is appropriate

	lassign [split $e .] h c
	set hid $HDUid($h)
	if {$x == "C"} {
		set hcols $Cols($hid)
		set ci [expr [lsearch $hcols $c] + 1]
		if !$ci {
			puts stderr "OOPS can't find col $c in Col List for header $h $hid"
			continue
		}
		set ht [cindex [keylget Cols($hid,$ci) typ] 0]
		if {$ht == "A"} {set ht S}
	} else {
		set kv [keylget Kwds($hid) $c]
		if {$kv == ""} {
			puts stderr "OOPS no value for $h $c"
			continue
		}

		set ht [checkType $kv]

	}
	if [info exists Indirect($e,$t.$f)] {
	lassign [split $Indirect($e,$t.$f) :] mt mf
	set ft [keylget Tables($mt) $mf]
	} else {
	set ft [keylget Tables($t) $f]
	}
	lassign $ft tt st sl 

	if {$ht != $tt} {
		puts stderr "OUCH the field $t:$f is type $st ($sl) or $tt"
		puts stderr "but the $x $h:$c is type $ht"
		puts stderr "This isn't going to work."
		lappend Bad $h:$c:$t:$f
		continue
	}
	}
}
}

catch {unset TabList}
sortTables

if [llength $Bad] {
	puts stderr "SORRY the following records indicate a serious problem."
	puts stderr "\t[join $Bad "\n\t"]"
	puts stderr "hdu:col:table:field type mismatch!"
	puts stderr "Check your schema, and check your HDUs."
	puts stderr "This should not happen."
	exit 1
}

}

#	establish the order in which tables need to be resolved
# 
proc sortTables {} {

	global Tables Ident Primary TabList Extend

#	the object is to discover who depends on whom,
#	and who depends on Nobody or Pre-Existing data
#	we'll write the sorted list into TabList.

	if ![info exists TabList] {
	puts stderr "INITIALIZE TAB LIST"
	set TabList [array names Tables]
	puts stderr "$TabList"
	}
#	puts stderr "TL $TabList"
	set ct 0
	set nochange 0

#	do this shuffle twice for luck

	loop j 0 2 {

	set changes 0

	foreach t [array names Tables] {

#		puts stderr "**** CHECK TABLE $t"
#		list of fields
		set fs [keylkeys Tables($t)]
		set fk 0
		foreach f $fs {
#			puts stderr "***  CHECK FIELD $f"
			set id 0
			foreach pt [array names Primary] {
#				puts stderr "  check table $pt for pk my fk"
				if {$pt == $t} {continue}
				set pk $Primary($pt)
				if {$pk == $f} {
#				my field F has same name as pkey of other
#				table!
#				Now, this would usually mean that I
#				am a child of pt, but there could be
#				a sibling relationship -- if so, in
#				this universe one of us must be the IDENT
#				if it is me, no problem
				if $Ident($t,$f) {
#					puts stderr "$pt $pk matches my $t $f"
#					puts stderr "but I am the IDENT"
					continue
				}
#				if it is my primary key?
#				if it's my primary key and *not* my ident,
#				and it's the pk and ident of someone else,
#				I must be an extension of that other.
				if {($Primary($t) == $f) && $Ident($pt,$f)} {
					set Extend($t) $pt
				}
#				nope, it really is an fk
				incr fk
#				otherwise, it appears that I belong to
#				table pt.  Move me after it.
				set i1 [lsearch $TabList $t]
				set i2 [lsearch $TabList $pt]
				if ![info exists moved($t)] {set mvd -1} else {
					set mvd $moved($t)
				}
				if {($mvd < 0) || ( ($mvd >= 0) && ($i2 > $i1) )} {
				set TabList [lreplace $TabList $i1 $i1]
#				linsert list n inserts BEFORE n
				set TabList [linsert $TabList [incr i2] $t]
				set moved($t) $i2
#				puts stderr "** put $t after parent $pt"
#				puts stderr "TL $TabList"
				incr changes
				} else {
#				puts stderr "DON'T move $t after $pt, $t already moved and $pt at $i2 is before $t at $i1"
				}
				}
			}
#			puts stderr "TABL $t fkeys $fk"
#			if there are no fkeys, whee!  put me first!
			if !$fk {
#				puts stderr "NOFK PUT $t FIRST"
				set i1 [lsearch $TabList $t]
				set TabList [lreplace $TabList $i1 $i1]
				set TabList [linsert $TabList 0 $t]
			}
		}
	}

#	we're just going to do this twice anyway

	if !$changes {incr nochange}
	incr ct
#	puts stderr "ROUND $ct changes $changes nochange $nochange"

#	if {$nochange > 2} {break}
#	if {$ct > 1} {break}

	}

	puts stderr "SORT TABLIST\n$TabList"

}
#
#
proc mapData {} {

global HDU Kwds Kcom Data Cols Fkey HDUid TabList Indirect
global MapT MapH MapK MapC MapD
global Tables sybmsg mbase owner Primary Ident
global LookupValue FixedValue Translate

#	How do we start?  we start at the top of the tab list.
#	foreach table, is there an HDU for it?
#	if not, move on.  if so, foreach field, make sure there
#	is a data source (col or kw).
#	having verified this, construct records and insert them.

#	IF the pkey is to be used later (if this is a parent
#	table) REMEMBER the mapping of temporary id (from fits
#	file to permanent id (from database insert).
#	Since we know a priori that this app is going to use
#	identity numeric pkeys in a sybase environment, code
#	for that method for now.

#	we will first do a sanity check, at the end of which
#	we should have a couple of arrays FixedValue (if needed for
#	kwd values to be ingested)
#	and LookupValue (for table ext columns to be ingested).

	foreach t $TabList {

		if ![info exists MapT($t)] {
			puts stderr "$t not mapped to fits data SKIP"
			continue
		}	

		set pk ""
		catch {set pk $Primary($t)}
		if {$pk == ""} {
			puts stderr "ERROR no primary key for table $t."
			puts stderr "      cannot process, abort."
			return -1
		}
		set id 0
		if {[llength $pk] == 1} {
		catch {set id $Ident($t,$pk)} 
		if !$id {
			set e [array names Ident *,$pk]
			if {$e == ""} {
			puts stderr "ERROR primary key for $t is not ident numeric."
			puts stderr "      nor is it the ident of another table."
			puts stderr "      cannot process, abort."
			return -1
			}
		}
		}

#	here we assume that pk namespace is unique across tables, which
#	somewhat eases the problem of Objects, Near, and Extend
		set Translate($pk) ""

#		OK, we've established that the table is mapped and that
#		it has an ident pkey if its pkey is single.
		set maps ""
		foreach e [array names MapD $t.*] {
			set f [lindex [split $e .] 1]
			set map [keylkeys MapD($e)]
			if {[llength map] > 1} {
				puts stderr "OUCH don't know what to do here!"
				puts stderr "Table $t field $f maps to:"
				puts stderr "FITS data $MapD($e)"
				puts stderr "BAIL"
				return -1
			}
			set s [keylget MapD($e) $map]
			set col 0
			set kwd 0
			if [info exists MapC($map.$s)] {set col 1}
			if [info exists MapK($map.$s)] {set kwd 1}
			if {$col && $kwd} {
				puts stderr "OUCH data for $t fld $f cannot come from both Col and Kwd $s"
				puts stderr "BAIL"
				return -1
			}
			if {!($col || $kwd)} {
				puts stderr "OUCH data for $t fld $f has to come from SOMEWHERE"
				puts stderr "Can't find a MapC or MapK record for $map.$s"
				puts stderr "BAIL"
				return -1
			}
#			Now we've established that there is a source for
#			this field in the fits data, that it is either a
#			col or a kwd, and where (which hdu) it lives 
			if $kwd {
				set v [getHDUKval $map $s]
				if {$v == "HDUKval FAIL"} {
					puts stderr "OUCH can't lookup value for kwd $s in hdu $map"
					return -1
				}
				set FixedValue($t,$f) $v
			} else {
				set LookupValue($t,$f) $map.$s
				lappend maps $map
			}
		}
		set maps [lrmdups $maps]
		if {[llength $maps] > 1} {
			puts stderr "WARNING DANGER"
			puts stderr "Table $t appears to map to multiple table extensions:\n\t$maps"
			puts stderr "I don't think we can handle this!"
			return -1
		}
	}

#	we do the above for ALL tables before ever starting to gen
#	SQL.  It's stupid not to.  we don't want to start an ingestion
#	run and find out halfway through that the fits file is 
#	bogus.

	return 0

}
#

proc putData {} {

global HDU Kwds Kcom Data Cols Fkey HDUid TabList Indirect
global MapT MapH MapK MapC MapD
global Tables sybmsg mbase owner Primary Ident Extend
global LookupValue FixedValue Translate
global sybmsg

#	assume that mapData has happened and that we are all happy
#	about the structure, or we would not be here.
#
#	foreach table, get fields
#		find the source table ext & get 1 rec
#		foreach field get the value from source or Fixed
#		if Translate exists for field, translate value before insert
#		construct sql
#		insert record, suppressing PK field if ident (which it s/b in
#		most cases)
#		if Translate exists, get new ident and keylset Trans
#		if ident insert, remember to keylset Trans.

	foreach t $TabList {

		if ![info exists MapT($t)] continue

		set flds [keylkeys Tables($t)]

		foreach f $flds {
			lassign [keylget Tables($t) $f] ty syty len
			if {$ty == "S"} {set qt($f) 1} else {set qt($f) 0}
		}

		set hdn $MapT($t)
		set hdi $HDUid($hdn)

		set recs ""
		foreach r [array names Data $hdi,*] {
			lassign [split $r ,] junk rn
			lappend recs $rn
		}

		set recs [lsort -integer $recs]

#		now we have a sorted list of HDU table extens rec nums
#		this gets us the keyed list "data" from the array Data

		puts stderr "STUFF TABLE $t"
		puts stderr "Have fields $flds"
		puts stderr "Have data records $recs"

		foreach r $recs {

			set data $Data($hdi,$r)

			set vals ""
			set id 0

#			make a value list from fields for each record

			set nonnulls 0

			foreach f $flds {

			if [info exists FixedValue($t,$f)] {
				set v $FixedValue($t,$f)
			} else {
				set look [array names LookupValue $t,$f* ]
				if {[string first : $look] >= 0} {
				set v [getIndirect $t $f $look $r]
				} else {
				if {$look == ""} {
				set v NULL
				} else {
				lassign [split $LookupValue($t,$f) .] h c
				set v [keylget data $c]
				}
				}
			}

#			the identity col is not inserted, leave it out
			if $Ident($t,$f) {
				set idf $f
				set id 1 
				set idv $v
				continue
			}


#		Translate is either a keyed list lookup or a single
#		value, name of a translate filter.
#		if it is a filter, we accept the output from it.
#		the filters will have to be hardwired, in advance,
#		preferably in some setup file.  for now, in top script

			if [info exists Translate($f)] {
				set err [catch {set v [keylget Translate($f) $v]} res]
				if {$err} {
				set v [$Translate($f) $v]
				}
			}

			if $qt($f) {
				if {$v != "NULL"} {
				set v "'$v'"
				}
			}

			if {$v != "NULL"} {
				incr nonnulls
			}

			lappend vals $v

			}

#			don't do SQL if you don't have non null values
#			for an Extend table aside from the pk!

			if [info exists Extend($t)] {
				if {$nonnulls == 1} {
					continue
				}
			}

#			actually do SQL!

			set sqlcmd "insert into $mbase.dbo.$t values ([join $vals ,])"
			set sqt $t

			puts stderr "SQL $sqlcmd"

			set res [doSQL 1]
		
			if {[string first ERROR $res] >= 0} {
				puts stderr "OUCH error in SQL cmd"
				puts stderr "$res"
				puts stderr "$sybmsg(msgtext)"
				puts stderr "ABORT"
				exit 1
			}

			if $id {
				set sqlcmd "select @@identity"
				doSQL 1
				set newid [sybNext 1]
				keylset Translate($idf) $idv $newid
				puts stderr "Map old $t rec id $idv to new minted id $newid"
			}
			
		}
	
	}

}
#
proc getIndirect {t f look r} {

#	I should be using namespaces really

global HDU Kwds Kcom Data Cols Fkey HDUid TabList Indirect
global MapT MapH MapK MapC MapD
global Tables sybmsg mbase owner Primary Ident
global LookupValue FixedValue Translate
global sybmsg

	puts stderr "GETINDIRECT $t $f LOOK $look REC $r"

	lassign [split $look :] tf ot of

	set e [array names Indirect *,$t.$f]

	if {[llength $e] > 1} {
		puts stderr "OUCH! table $t field $f indirect map"
		puts stderr "      references MORE THAN ONE source!"
		puts stderr "		$e"
		puts stderr "FATAL, BAIL"
		exit 1
	}

	puts stderr "Got Indirect $e"
	lassign [split $e ,] hducol tblcol
	lassign [split $hducol .] hdn hdc

	puts stderr "Get $t $f via $hdn $hdc for record $r"

	set hid $HDUid($hdn)
	set kwds [keylkeys Kwds($hid)]

	puts stderr "Got hid $hid"

#	if it's a kwd, get kwd val from hdu
#	if it's a col, get kwd val from same rec (!)
#	this needs a sanity check earlier.

	if {[lcontain $kwds $hdc]} {
	puts stderr "It's a KEYWORD getHDUKval no rec"
	set hdv [getHDUKval $hdn $hdc]
	} else {
	puts stderr "It's a COLUMN getHDUKval w/ rec"
	set hdv [getHDUKval $hdn $hdc $r]
	}

	puts stderr "Got hdv $hdv, check type pre SQL"
#
	set hdt [checkType $hdv]

	set ok $Primary($ot)

	if [info exists Translate($of)] {
		set trans $Translate($of)
		if {[llength $trans] == 1} {
		set hdv [$Translate($of) $hdv]
		} else {
		puts stderr "OUCH translate keylist for external lookup field $of"
		puts stderr "     namespace collision?"
		puts stderr "NO TRANS for $ot $of value $hdv"
		}
	}

	if {$hdt == "S"} {
		set hdv "'$hdv'"
	}

	set sqlcmd "select $ok from $ot where $of = $hdv"
	puts stderr "LOOK SQL $sqlcmd"
	set sqt $ot
	set res [doSQL 2]

	if {[string first ERROR $res] >= 0} {
		puts stderr "ERROR in 2dary SQL lookup:"
		puts stderr "$res"
		puts stderr "This will prove fatal later."
	}

	set mv [sybNext 2]

	if {$mv == ""} {
		puts stderr "WARNING WARNING WARNING"
		puts stderr "Attempt to look up $hdv via $ot:$of FAILED"
		puts stderr "Returning NULL, serious problems will ensue"
		set mv NULL
	}

	return $mv

}
#
#
proc stripEmailID {s} {

#	strip any email string you get to a valid address
#

#	take the first token with an @ in it
	set addr foo
	foreach w $s {
		if {[string first @ $w] > 0} {
			set addr $w
			break
		}
	}

	if {$addr == "foo"} {
		puts stderr "OUCH cannot find email address in "
		puts stderr "     $s"
		puts stderr "which was presented as an email address/id"
		return FOO
	}

	set addr [string trim $addr <>]

	return $addr

}

#@package: OBSOLETE getRealm setChildren idTables

# We're not going to do this any more.  We will be Memes-independent.
# that way we can hand off the schema and app to anyone with an RDBMS
# without carrying all of memes with it.
#
proc getRealm {fname sname} {

	global memtbl

#	establishRoles and collectMemes
#	to get the memes realm of discourse initialized

	establishRoles

	initWorld DesignData

#	also get context for the fits file

	set sqlcmd "select mid from $memtbl where name = '$fname' and syty = 'file'"
	set sqt $memtbl
	doSQL 1 

	set fid [sybNext 1]

	collectMemes $fid

}
##
# this isn't used any more.
#
proc setChildren {} {
 
	global Context Children
 
	foreach e [array names Context] {
 
	set t ""
	catch {set t [keylget Context($e) dtyp]}
 
	if {$t == "table"} {
		lassign [split [string tolower $e] ,] tn ctx
		if [info exists Context($tn)] {
			set Children($tn) [keylget Context($tn) elems]
		}
	}
 
	}
 
}
# forget this proc also.  we are going to be told, helpfully,
# by the fits file itself, how the fits file maps to the rdb
# tables.  no more guesswork.
#
proc idTables {} {

	global Children Cols HDU Kwds Belongs

	set FITSspecial [list TFORM TTYPE TUNIT TBCOL TNULL]

	catch {unset Belongs}

	foreach p [array names Children] {

		if {$p == "maskdesign"} {set Debug 1} else {set Debug 0}

		if $Debug {
		puts stderr "--------------------- Find table $p -----------------"
		}
		set cl $Children($p)

		set mind 999

		foreach h [array names HDU] {

		set n None
		catch {set n [keylget HDU($h) name]}
		if $Debug {
		puts stderr "    Check HDU name $n"
		}
		set cols ""
		catch {set cols $Cols($h)}
		if $Debug {
		puts stderr "cols  $cols"
		}
		set kwds ""
		foreach k [keylkeys Kwds($h)] {
			if {![lcontain $FITSspecial [crange $k 0 4]]} {
			lappend kwds $k
			}
		}
		if $Debug {
		puts stderr "kwds  $kwds"
		}

		set kwds [string tolower $kwds]
		set cols [string tolower $cols]

		lassign [listDiff $cols $cl nocase] cdiffs cold cldc
		set dc [llength $cldc]

		if {$dc < $mind} {

			if $Debug {
			puts stderr "**  NEW MIN DIFF HDU $n vs tbl $p diffs $dc COLS"
			}
			set mind $dc
			set which cols
			set hdu $h
			set hdun $n
			set left $cldc
		}

		if $Debug {
		puts stderr "DIFF\nL1 $kwds\nL2 $cl"
		}
		lassign [listDiff $kwds $cl nocase] kdiffs kwdd cldk
		set dk [llength $cldk]

		if {$dk < $mind} {
			if $Debug {
			puts stderr "**  NEW MIN DIFF HDU $n vs tbl $p diffs $dc KEYS"
			}
			set mind $dk
			set which kwds
			set hdu $h
			set hdun $n
			set left $cldk
		}

		}

		set tl [llength [set $which]]

#	must be diff by no more than 3 fields

		if {$mind <= 3} {
			puts stderr "$p is found inside HDU $hdu ($hdun) $which"
			keylset Belongs($p) hdu $hdu hdun $hdun which $which diff $mind
		}  else {
			puts stderr "UNMATCHED table $p"
			puts stderr "Sorry $h:$n diff $mind ($which) out of $tl"
			puts stderr "with table leftovers $left"
			puts stderr "is just not good enough"
		}
		
	}
}