#!/opt/tcl/bin/sytcl
#
# $Header: /a/local/CVS/tcldb/memes/apps/mhm,v 1.25 1997/05/22 21:24:09 de Exp $
#
# mhm : name header maker
#       give it the name of a header, and it will try to
#       construct a fake fits header according to that spec
#
set tclroot /opt/share/tcl
loadlibindex $tclroot/lib/ucodb/ucodb.tlib
#loadlibindex ../memes.tlib
loadlibindex $tclroot/lib/ucodb/memes.tlib
#
set uniq [clock seconds]
set efp [open /tmp/mtm_$uniq.log w]
set dbpipe1 [sybOpen keck guest rsvp UCO-SCIDB]
set dbpipe2 [sybOpen keck guest rsvp UCO-SCIDB]
# puts $efp "got dbpipe $dbpipe1"
#
#       control operation with "called as" argv0
set myname [file tail $argv0]
set mail 0
#
global sybmsg
# set sybmsg(nullvalue) 0
#
set meta metabase
set dictionary data_dict
set memtbl keck.dbo.Memes
set mcotbl keck.dbo.Mcontexts
set mvatbl keck.dbo.Mvalues
set mebtbl keck.dbo.Mbundles
set maptbl keck.dbo.Mmaps
set mpitbl keck.dbo.Mpinouts
set contexts ""
# call this to set up some lists for getData
establishRoles

random seed [random [getclock]]

set tcl_precision 17
# flag to control whether there are bars separating columns in FITS tables
set tblbar 1
# flag to control whether FITS table rows start with a newline
set tblnl 1
#
# -------------------------------------MAIN-----------------------------------
#
if {[llength $argv] < 1} {
        puts stderr "Usage: mhm|mtm|mcm|mdm|stf|stff targetName ?outFile?"
        exit 0
}
#
set Flags ""
if {[cindex $argv 0] == "-"} {
        set flags [crange [lvarpop argv] 1 end]
        foreach flag [split $flags {}] {
        append Flags $flag
        }
        puts stderr "Got Flags : $Flags"
}
#
set Batch 0
if {[string first B $Flags] >= 0} {
	set Batch 1
}
#
lassign $argv hdrnam outfile
puts $efp "we were invoked as $argv0 so myname is $myname"
# we are either meTableMaker or meHeaderMaker
set nonew ""
if {$myname == "mtm"} {
    set suffix "sql"
    set tm "SQLtable"
} elseif {$myname == "mcm"} {
    set suffix "fio"
    set tm "FITSIO"
} elseif {$myname == "mdm"} {
    set suffix "dict.sql"
    set tm "Ddict"
} elseif {$myname == "mhm"} {
    set suffix "hdu"
    set tm "pFITS"
} elseif {$myname == "stf"} {
    # Sybase table to true FITS table extension
    set suffix "fits"
    set tm "sFITS"
    set nonew "-nonewline"
    set realfits 1
} elseif {$myname == "stff"} {
    # Sybase table to fake FITS table extension
    set suffix "ffits"
    set tm "sFITS"
    set realfits 0
    set tblnl 0
} else {
    puts stderr "Sorry, I do not know what to do when invoked as $myname"
    puts stderr "mtm:  SybSQL table definition from header or table meme"
    puts stderr "mcm:  FITSIO source code from header meme"
    puts stderr "mdm:  SybSQL table definition from table meme in context DataBase"
    puts stderr "mhm:  fake FITS header cards from header meme"
    puts stderr "stf:  FITS table HDU from existing sybase table"
    close $efp  "stff: fake FITS table HDU from existing sybase table"
    exit 1
}
if {$outfile == ""} {
    set outfile $hdrnam.$suffix
}
if {[string first @ $outfile] > 0} {
        set uniq [getclock]
        set recip $outfile
        set outfile /tmp/$myname.$uniq
        set mail 1
}
set ofp [open $outfile w]

set sybh 0
# need more decision logic here.  What if we do want to generate
# "tables within tables" from a FITS table extension header?
if {$tm == "SQLtable"} {
    set sqlcmd "select mid from $memtbl where name = '$hdrnam' and (syty = 'table' or syty = 'header')"
    puts $efp "Trying to find a Table or Header called $hdrnam..."
} elseif {$tm == "Ddict"} {
    set sqlcmd "select mid from $memtbl where syty = 'table' and context = 'DataBase' and name = '$hdrnam'"
    puts $efp "Trying to find a Sybase Table called $hdrnam..."
} elseif {$tm == "sFITS"} {
    set sqlcmd "select mid,alt_name from $memtbl where name = '$hdrnam' and syty ='table'"
    set sybh 1
#    puts $efp "Trying to find a Header called $hdrnam ..."
} else {
    set sqlcmd "select mid from $memtbl where name = '$hdrnam' and syty in ('header','table')"
#    puts $efp "Trying to find a Header called $hdrnam..."
}
set sqt $memtbl
doSQL 1

# use the results of the SQL query to build a list of all mid that matched
set bmid ""
set an ""
while {1} {
        set sqlres [sybNext 1]
        if {$sqlres == ""} {break}
        if {$sybh} {
                # the SQL query result is a list:  mid,alt_name
                lassign $sqlres m aname
                lappend bmid $m
                lappend an $aname
        } else {
                # the SQL query result is just mid
                lappend bmid $sqlres
        }
}
#
if {$tm == "SQLtable"} {
    if {[llength $bmid] > 1} {
        set sqlcmd "select mid, name, context, syty, alt_name from $memtbl where mid in ([join $bmid ,])"
        doSQL 1
        set cols [sybCols 1]
        set Mtable ""
        set Mheader ""
        while {1} {
                set line [sybNext 1]
                if {$line == ""} {break}
                eval lassign \$line $cols
                puts stderr "$mid $name $syty $context"
                set mts($mid) $syty
                set ans($mid) $alt_name
        }
	set bmid $mid
	if {!$Batch} {
        puts stderr "Which of these did you want? (enter mid)"
        gets stdin bmid
	} else {
	puts stderr "NON INTERACTIVE MODE:  assume choice $mid from $bmid"
	}
        set err [catch {set mt $mts($bmid)}]
        set err [catch {set an $ans($bmid)}]
        if {$err} {
                puts stderr "Sorry, you have to choose one from the list."
                puts $efp "User chose $bmid which was not in the list [array names mts] QUIT"
                close $efp
                exit 1
        }
        puts $efp "mt is $mt"
        if {$mt == "header"} {set sybh 0}
    }
}
#
if {[llength $bmid] > 1} {
    puts stderr "Sorry, there are multiple headers named $hdrnam:\n$bmid"
    puts $efp "TOO MANY headers $hdrnam : [llength $bmid]"
    close $efp
    exit 1
} elseif {$bmid == ""} {
    puts stderr "Sorry, there are no headers called $hdrnam."
    puts $efp "NO SUCH header $hdrnam"
    close $efp
    exit 1
}
# Find all the different types which have been used for meme bundles
# Make a code-name set of them which presumes 4-character uniqueness
set BundTypes ""
set BTcodes ""
set sqlcmd "select distinct syty from $memtbl where mid in (select distinct tmid from $mebtbl)"
set sqt "$memtbl $mebtbl"
doSQL 1
while {1} {
        set t [sybNext 1]
        if {$t == ""} {break}
        lappend BundTypes $t
        lappend BTcodes [string toupper [crange $t 0 3]]
}
#
set tblh ""
if {$sybh} {
#       this is not a real header so we have to synthesize a header
#       save the meme number of the original table def
        set tblh $bmid
#       save the count of records from the original db table
        set sqlcmd "select count(*) from $an"
        set sqt $an
        doSQL 1
        set tblct [sybNext 1]
        puts $efp "Not a real header:  get SybHeader"
        set sqlcmd "select mid from $memtbl where name = 'SybHeader' and context = 'TYPEDEFS'"
        doSQL 1
        set m [sybNext 1]
        if {$m == ""} {
                puts stderr "Very serious error!"
                puts stderr "There is no magic meme SybHeader.  Memes database corrupt."
                puts stderr "You have to fix this before you can use stf on $hdrnam"
                puts $efp "NO SYBHEADER magic meme missing QUIT"
                close $efp
                exit  1
        } else {
                set bmid $m
                set sqlcmd "select mid from $memtbl where name = 'SelfTable' and context = 'TYPEDEFS'"
                doSQL 1
                set m [sybNext 1]
                if {$m == ""} {
                        puts stderr "Very serious error!  SybHeader but no SelfTable"
                        puts stderr "Corrupt memes database, fix before proceeding."
                        puts $efp "NO SELFTABLE magic meme missing QUIT"
                        close $efp
                        exit 1
                }
                set tblh "$m $tblh"
        }
}
#
# tblh should now be a list of two memes, first the "fake" meme number
# called SelfTable, second the meme with which it's to be replaced.
# we pass this to collectMemes.
#
puts $efp "Header number of header $hdrnam is $bmid ($tm)"
#
# Get initial mlist and master header list
#
set mlist "$bmid"
set Mcount 0
#
# and recurse until you know everything.
puts $efp "Initial list is [llength $mlist] Memes in length..."
# puts $efp "$mlist"
#
collectMemes $mlist {} $tblh
#
puts $efp "\n-----------------DONE with data gathering--------------------\n"
#
#
foreach pt {TABL TUPL HEAD FILE SCHE} {
    foreach pk [set $pt] {
        set mn NoName
        catch {set mn [keylget collected($pk) name]}
        puts $efp " $pt $mn $pk has children: "
        if {![info exists elements($pk)]} {
            puts $efp "    OOPS no elements set for $pt $mn $pk"
            continue
        }
        set i 1
        foreach e $elements($pk) {
            set err [catch {set mi [keylget elinfo($e) emid]}]
            if {$err} {
                puts $efp "    OOPS No elinfo for child $i ($e) of $mn"
                incr i
                continue
            }
            set err [catch {set mn [keylget collected($mi) name]}]
            if {$err} {
                puts $efp "    OOPS no Name in elinfo for child $mi ($e) of $mn"
                incr i
                continue
            }
            puts $efp "     $mn $mi"
            lappend kids $mi
            incr i
        }
    }
}

# get values for each counter
foreach m [lrmdups $CTR] {
    set err [catch {set mn [keylget collected($m) name]}]
        if {$err} {
            puts $efp "OOPS, no info for counter $m"
            continue
        }
    set mc   [keylget collected($m) context]
    set minv [keylget collected($m) minv]
    set maxv [keylget collected($m) maxv]
    set defv [keylget collected($m) defv]
    if {$minv == $maxv && $minv != 0 && $minv != ""} {
        # no need to prompt for a value
        puts $efp "Assuming value $minv for counter $mn ($mc)"
        # integer part of the value
        set ctrvals($m) [lindex [split $minv .] 0]
    } elseif {$defv != 0 && $defv != ""} {
        # presume a nonzero defv to give the recommended value
        puts $efp "Assuming default value $defv for counter $mn ($mc)"
        # integer part of the value
        set ctrvals($m) [lindex [split $defv .] 0]
    } else {
        # get interactive input from the user
	set ctrvals($m) 1
	if {!$Batch} {
        puts stderr "Give me a value for counter $mn ($mc): " nonewline
        gets stdin ctrvals($m)
	} else {
	puts stderr "NON INTERACTIVE MODE:  assume value 1 for $mn counter"
	}
    }
}

# generate output entity list, be it FITS keywords or sql commands
fakeKey $bmid {}
# output entities are now stored in the global variables starting with M
#
puts $efp "Mcount is $Mcount..."
#
if {$tm == "pFITS"} {
    puts $efp "about to make fake values"
    fakeValues
}
#
if {$tm == "Ddict"} {
        puts $ofp "use $meta\ngo"
        puts $ofp "delete from $dictionary where dbase = 'keck' and tbln = '$hdrnam'\ngo"
}
if {$tm == "SQLtable"} {
    set tbldef "use keck\ngo\n"
    if {!$sybh} {
        append tbldef "create table ${hdrnam}_H (\n\thdrid\t\int\tnot null,\t/* Generated unique $hdrnam header ID */"
        append tbldef2 "create table ${hdrnam}_D (\n\thdrid\t\int\tnot null,\n\trecid\t\int\tnot null,\t/* Generated unique $hdrnam table record ID */"
    } else {
        append tbldef "create table $hdrnam (\n"
    }

} elseif {$tm == "pFITS"} {
    puts $ofp "\nCOMMENT                Sample FITS header of type $hdrnam\n"
} elseif {$tm == "FITSIO"} {
    puts $ofp "/* sample C FITSIO code for $hdrnam headers */"
} elseif {$tm == "sFITS"} {
    # count number of output records
    set outrec 0
    if {! $realfits} {
        # a little commentary for the sake of beauty
        puts $ofp "\nCOMMENT                FITS table from DB table $hdrnam\n"
    }
} elseif {$tm == "Ddict"} {
        puts $ofp "/* SQL to stuff Data Dictionary from Memes for Table $hdrnam */"
} else {
    puts $ofp "Impossible for code to get to here : tm was $tm"
}
# print out each record and do some last-minute hackery
loop i 0 $Mcount {

    catch {unset m}
    catch {set m $Melems($i)}
    if {![info exists m]} {
        catch {set m $Mmids($i)}
        # puts $efp "No Melem for $i set m to $m"
    }
    if {![info exists ct$m]} {
        set ct$m 0
    } else {
        incr ct$m
    }

    # END is a special case to get all blanks after it
    if {$Mnames($i) == "END"} {
        if {($tm == "pFITS") || ($tm == "sFITS")} {
            eval puts $nonew $ofp {[format "%-80s"  $Mnames($i)]}
        }
        continue
    }

    # INSTRUME is a hack filled with all contexts
    if {$Mnames($i) == "INSTRUME"} {
        set Mvalus($i) "'$contexts'"
    }

    # next chunk rearranges name space for tables where
    # the same mid is used for different purposes with different names
    set mt -1
    set res ""
    catch {set mt [lindex $mbids($m) [set ct$m]]} res
#    puts $efp "[set ct$m] MID $m Mbid from metable is $mt : res $res (ct$m is [set ct$m])"
    set nam ""
    set ink ""
    if {$mt >= 0} {
        # look up any primary key info
        set ink [keylget elinfo($mt) inkey]
#       puts $efp "  for $mt set ink to $ink from elinfo"
    }
#    puts $efp "i $i Mnames(i) $Mnames($i)"

    # output happens here
    if {($tm == "SQLtable") || ($tm == "sFITS")} {
            set mn $Mnames($i)
    }

    if {($tm == "SQLtable") || ($tm == "Ddict")} {
        # This code is doing the wrong thing.
        # In the case of the following FITS TABLE Memes the right
        # thing to do is to create yet another Sybase table definition
        # while adding one more field to point back to the "parent"
        # entry from the table that we have just been defining here.

        if {[crange $Mnames($i) 0 4] == "TFORM"} {continue}
        if {[crange $Mnames($i) 0 4] == "TUNIT"} {continue}
        if {[crange $Mnames($i) 0 4] == "TBCOL"} {continue}
        if {[crange $Mnames($i) 0 4] == "TNULL"} {continue}
        if {[crange $Mnames($i) 0 4] == "TSCAL"} {continue}
        if {[crange $Mnames($i) 0 4] == "TZERO"} {continue}
        if {[crange $Mnames($i) 0 3] == "TDIM"} {continue}
        if {[crange $Mnames($i) 0 4] == "TDISP"} {continue}
        if {[crange $Mnames($i) 0 4] == "TLMIN"} {continue}
        if {[crange $Mnames($i) 0 4] == "TLMAX"} {continue}
        if {[crange $Mnames($i) 0 4] == "TDEFV"} {continue}
        if {[crange $Mnames($i) 0 4] == "TTOLV"} {continue}

        if {$ink != ""} {
                set ink "$ink :"
        }
        if {[crange $Mnames($i) 0 4] == "TTYPE"} {
#           puts $efp "Found a TTYPE field $Mnames($i) "
            # in this case the FITS name is not useful for sybase
            set me $Melems($i)
            set st [keylget collected($me) syty]
            # use the original meme name, which should be FITS field name
            set mn [keylget collected($me) name]
            set sem [keylget collected($me) semantics]

            if {$mt == "SQLtable"} {
            if {!$sybh} {
            append tbldef2 "\n\t[string tolower $mn]\t$st, \t/* $ink $Mcomms($i) */"
                } else {
            append tbldef "\n\t[string tolower $mn]\t$st, \t/* $ink $Mcomms($i) */"
            }
            } else {
                puts $ofp "insert into $dictionary (ddid,dbase,owner,tbln,fldn,ddesc) values (-1,'keck','dbo','$hdrnam','$mn','$sem')\ngo"
            }
            continue
        }

        if {$mt == "SQLtable"} {
        append tbldef "\n\t[string tolower $mn]\t$Mfrmts($i), \t/* $ink $Mcomms($i) */"
        }

    } elseif {$tm == "pFITS"} {

        set mv $Mvalus($i)
        if {[crange $Mnames($i) 0 4] == "TTYPE"} {
#           puts $efp "Found a TTYPE field $Mnames($i) value $Mvalus($i) "
        }

        if {[crange "$mv" 0 0] == "'"} {
            # FITS strings are left justified in a minimum 20 char field
            set fs "%-8s= %-20s / %s"
        } else {
            # everything else is right justified in a minimum 20 char field
            set fs "%-8s= %20s / %s"
        }
        puts $ofp "[format $fs $Mnames($i) "$mv" $Mcomms($i)]"

    } elseif {$tm == "FITSIO"} {
        set st [keylget collected($m) syty]
        set fc [keylget collected($m) comment]
        if {$fc == ""} {
            # we really should fill the comment fields, but when they're
            # null this is not a bad replacement
            set fc $Mcomms($i)
        }
        # initial valdata string is just the variable name
        set vd [string tolower $Mnames($i)]
        # get the manner of the Fortran data-edit-descriptor
        set ded [crange $Mfrmts($i) 0 0]
        # get the overall width and decimal count of the Fortran d-e-d
        lassign [split [crange $Mfrmts($i) 1 end] .] w d
        #puts $efp "$Mnames($i) ded $ded wid $w dec $d"
        #
        if {$ded == "L"} {
            # FITS logical value
            set cfs "log"
        } elseif {$ded == "A"} {
            # FITS string value
            set cfs "str"
        } elseif {$ded == "I"} {
            # FITS integer value
            set cfs "lng"
            set vd "(long) $vd"
        } elseif {$ded == "F"} {
            # FITS floating point value, fixed point format
            if {$st == "real"} {
                set cfs "fixflt"
            } elseif {$st == "float"} {
                set cfs "fixdbl"
            } else {
                puts $efp "Unknown sybase type $syty for mid=$m, $Mnames($i)"
            }
            set vd "$vd, $d"
        } elseif {$ded == "E"} {
            # FITS floating point value, exponential format
            if {$st == "real"} {
                set cfs "flt"
            } elseif {$st == "float"} {
                set cfs "dbl"
            } else {
                puts $efp "Unknown sybase type $syty for mid=$m, $Mnames($i)"
            }
            set vd "$vd, [ expr $d - 4]"
        } else {
            puts $efp "Unknown data-edit-descriptor $Mfrmts($i) for mid=$m, $Mnames($i)"
        }
        puts $ofp [format {ios = fits_write_key_%s(fptr, "%s", %s, "%s", ios);} \
        $cfs "$Mnames($i)" "$vd" "$fc" ]

    } elseif {$tm == "sFITS"} {

        set err [catch {set mv $Mvalus($i)} res]
        if {$err} {
                if {$Mnames($i) == "NAXIS2"} {
                        puts $efp "Setting NAXIS2 value to $tblct"
                        set mv $tblct
                } else {
                        puts $efp "Oops, how come no Mvalus($i) ($Mnames($i))?"
                        continue
                }
        }

        if {[crange "$mv" 0 0] == "'"} {
            # FITS strings are left justified in a minimum 20 char field
            set fs "%-8s= %-20s / %-47s"
        } else {
            # everything else is right justified in a minimum 20 char field
            set fs "%-8s= %20s / %-47s"
        }

        if {$mn != $Mnames($i)} {
                set mv '$mn'
        }

        eval puts $nonew $ofp {[format $fs $Mnames($i) "$mv" $Mcomms($i)]}
        incr outrec

        if {[crange $Mnames($i) 0 4] == "TFORM"} {
                set cn [crange $Mnames($i) 5 end]
                set ff $Mvalus($i)
                set ffs($cn) [string trimleft [string trimright $ff '] ']
#               puts $efp "Col $cn format is $ff"
        }

    } else {
        puts $efp "tm did not match anything!  We should not be here!"
    }
}
# one last bit of output for Sybase
if {$tm == "SQLtable"} {
    set tbldef [string trimright $tbldef ,]
    append tbldef "\n)\ngo\n"
    puts $ofp "$tbldef"
    if {!$sybh} {
        set tbldef2 [string trimright $tbldef2 ,]
        append tbldef2 "\n)\ngo\n"
        puts $ofp "\n$tbldef2\n"
    }
}
#
# and write the data out if you were making a fits table from sybase
#
if {$tm == "sFITS"} {
        # add extra blank records to make 2880 bytes
        incr outrec
        puts $efp "Outrec is $outrec"
        loop i 1 [expr 36 - ( ( $outrec - 1) % 36 ) ] {
                eval puts $nonew $ofp {[ format "%80s" "" ]}
        }
        # construct the output format for the table rows
        if {$realfits && $tblnl} {
                set fmt "\n"
        } else {
                set fmt ""
        }
        # loop over each of the FITS table columns
        foreach i [lsort -integer [array names ffs]] {
                # get the field width
                set found 0
                set fl ""
                foreach c [split $ffs($i) {}] {
                        if {[ctype digit $c]} {
                                set found 1
                                append fl $c
                        } else {
                                if {$found} {break}
                        }
                }
                # update the printf format
                puts $efp "format $ffs($i)"
                if { [crange $ffs($i) 0 0] == "A" } {
                        append fmt "%-$fl.${fl}s"
                } else {
                        append fmt "%$fl.${fl}s"
                }
                if {$tblbar} {
                        append fmt "|"
                }

        }
        set tmid $bmid
        puts $efp "tmid is $tmid"
        if {$sybh} {
                puts $efp "tblh is $tblh"
                set tmid [lindex $tblh 1]
        }
        puts $efp "About to write out table $tmid fmt $fmt"
        putTable $tmid $fmt
}
# done
close $ofp
close $efp
if {$mail} {
        system "/usr/ucb/Mail -s Your_Meme_Report $recip < $outfile"
        system "/bin/rm $outfile"
        set err [catch {set afp [open /usr/local/httpd/logs/GL_log a]}]
        if {$err} {
                set afp [open /tmp/GL_log a]
        }
        puts $afp "MAILED [fmtclock [getclock]] [string toupper $myname] $recip $hdrnam"
        close $afp
}
#
