#!/opt/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
# loadlibindex ../memes.tlib
#loadlibindex /u/de/cvs/tcldb/memes/memes.tlib
#
global env
set home /tmp
set uniq [clock seconds]
catch {set home $env(HOME)}
#
catch {unlink /tmp/mbc.log}
set err [catch {set efp [open /tmp/mbc.log w]}]
if {$err} {
        set efp [open $home/mbc.log w]
}
set dbpipe1 [sybOpen keck guest rsvp UCO-ASTRO]
set dbpipe2 [sybOpen keck guest rsvp UCO-ASTRO]
# puts $efp "got dbpipe $dbpipe1"
#
global sybmsg
#set sybmsg(nullvalue) 0
#
set memtbl keck.dbo.Memes
set mcotbl keck.dbo.Mcontexts
set maptbl keck.dbo.Mmaps
set mebtbl keck.dbo.Mbundles
set mpitbl keck.dbo.Mpinouts
#
# call this to set up some lists for getData
set ISAS ""
#
establishRoles
# -------------------------------------MAIN-----------------------------------

set sqlcmd "select mid from $memtbl where name = 'MemeName'"
doSQL 1
set smid [sybNext 1]
#
set myname [file tail $argv0]
set mail 0
if {[llength $argv] < 1} {
    puts stderr "Usage:  mbc|mbn|mbh|mbb|sbc|sbh ?-Flags? targetName ?outFile?"
    puts stderr "Optional additional flags at end of line: sort Item Element"
    puts stderr "	if sort is A, bundles will be alpha sorted."
    puts stderr "	Item controls the LaTeX index tmid string"
    puts stderr "	Element controls the LaTeX index emid string"
    exit 0
}
#
#  HIDEOUS HACKERY
#
set indexing 1
set Item Keywords
set Element ""
set sort ""
set AlphaSort 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 target outfile sort indexing Item Element
if {$sort == "A"} {
	set AlphaSort 1
}
if {$indexing == ""} {
	set indexing 1
	set Item "Keywords"
	set Element ""
}
if {$indexing > 1} {
	if {$Element == ""} {
		puts stderr "HUH?  deep indexing and no Element string?"
	}
}
#
#
# set report ffmt to c (context) or h (header)
set rts(mbn) "name"
set rts(mbc) "context"
set rts(mbh) "header"
set rts(mbb) "bundle"
set rts(mbnl) "name"
set rts(mbcl) "context"
set rts(mbhl) "header"
set rts(mbbl) "bundle"
set rts(sbc) "typedefs_c"
set rts(sbh) "typedefs_h"
#
set rt $rts($myname)

set htmfmt(Bul)         {<ul>}
set htmfmt(Eul)         {</ul>}
set htmfmt(Bol)         {<ol>}
set htmfmt(Eol)         {</ol>}
set htmfmt(li)          {<li>%s}
set htmfmt(Bdl)         {<dl>}
set htmfmt(Edl)         {</dl>}
set htmfmt(dt)          {<dt>}
set htmfmt(dd)          {<dd>}
set htmfmt(bold)        {<b>%s</b>}
set htmfmt(ital)        {<i>%s</i>}
set htmfmt(tt)          {<tt>%s</tt>}
set htmfmt(var)         {<var>%s</var>}
set htmfmt(rule)        {<hr>}
set htmfmt(ss)          {<center><b>%s</b></center>}
set htmfmt(br)          {<br>}
set htmfmt(p)           {<p>}
set htmfmt(h3)          {<h3>%s</h3>}
set htmfmt(h4)          {<h4>%s</h4>}
set htmfmt(Bhead)       {<head>}
set htmfmt(Ehead)       {</head>}
set htmfmt(Bbody)       {<body>}
set htmfmt(Ebody)       {</body>}
set htmfmt(title)       {<title>%s</title>}
set htmfmt(Bhtml)       {<html>}
set htmfmt(Ehtml)       {</html>}
set htmfmt(null)        {}

set ltxfmt(Bul)         {\begin{itemize}}
set ltxfmt(Eul)         {\end{itemize}}
set ltxfmt(Bol)         {\begin{enum}}
set ltxfmt(Eol)         {\end{enum}}
set ltxfmt(li)          {\item %s}
#
# if you use these, you always get boldface on the meme name
#	even in both members of ISA pairs.  and everything is
#	double spaced.
set ltxfmt(Bdl)         {\begin{description} \setlength{\itemsep}{0pt} \setlength{\parsep}{0.5ex plus0.2ex minus0.1ex}}
set ltxfmt(Edl)         {\end{description}}
#	
# But if you use these, you're hosed.
# set ltxfmt(Bdl)         {\begin{itemize}}
# set ltxfmt(Edl)         {\end{itemize}}
set ltxfmt(dt)          "\\item\[\{%%"
set ltxfmt(dd)          "\}\]%%"
set ltxfmt(bold)        {\textbf{%s}}
set ltxfmt(ital)        {\textit{%s}}
set ltxfmt(tt)          {\texttt{%s}}
set ltxfmt(var)         {$%s$}
set ltxfmt(rule)        {}
set ltxfmt(ss)          {\subsection{%s}}
set ltxfmt(br)          "\\\\"
set ltxfmt(p)           {}
set ltxfmt(h3)          {{\huge %s}\\}
set ltxfmt(h4)          {{\large %s}\\}
set ltxfmt(Bhead)       "\\documentclass\[twoside,11pt,openright\]{report}\n\
\\usepackage{desrev}\n
\\chauthor{auto maton}{deimos@ucolick.org}"
set ltxfmt(Ehead)       {%% end head}
set ltxfmt(Bbody)       {\begin{document}}
set ltxfmt(Ebody)       {\end{document}}
set ltxfmt(title)       {%% HTML title %s}
set ltxfmt(Bhtml)       {%% autogenerated LaTeX from mbc}
set ltxfmt(Ehtml)       {%% trailer cruft}
set ltxfmt(null)        {%%}
#
# determine which type of output you are making
# it can be either HTML (always standalone) or
# LaTex (standalone or for inclusion)
#
set outfmt ""
set standalone 1
if {$outfile == ""} {
    set outfile $target.$myname.out 
    puts $efp "no output file name, default to $outfile"
    # generate HTML
    set outfmt H
} else {
        if {[string first tex $outfile] >= 0} {
                set outfmt L
                set standalone 1
        } elseif { ([string first ltx $outfile] >= 0) || \
                ([string first inp $outfile] >= 0)} {
                set outfmt L
                set standalone 0
        } else {
                set outfmt H
        }
}
#
puts stderr "OUTPUT TYPE $outfmt, standalone $standalone AlphaSort $AlphaSort"
#
if {$outfmt == "L"} {
                # pseudo-LaTeX.  This must be filtered to become true LaTeX.
                foreach index [array names ltxfmt] {
                        set afmt($index) $ltxfmt($index)
                }
} else {
                # generate HTML
                foreach index [array names htmfmt] {
                        set afmt($index) $htmfmt($index)
                }
}
#
#
if {[string first @ $outfile] > 0} {
    set uniq [getclock]
    set recip $outfile
    set outfile /tmp/$myname.$uniq
    set mail 1
}
#
# what types of tuples are there?
#
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]]
}
#
puts stderr "Found tuple types $BundTypes"
puts stderr "Therefore BTcodes is $BTcodes"
#
# There's no disambiguation in here ya know.
#
set tophier 0
case $rt in {
    {name} {
        set sqlcmd "select mid from $memtbl where name = '$target' order by context"
        set sqt $memtbl
    }
    {context typedefs_c} {
        set sqlcmd "select mid from $memtbl where context = '$target' order by name"
        set sqt $memtbl
    }
    {header typedefs_h} {
        set sqlcmd "select mid from $memtbl where syty in ('[join $BundTypes ',']') and name = '$target'"
        set sqt $memtbl
        doSQL 1
        set rm [sybNext 1]
        if {$rm == ""} {set rm -1}
        set sqlcmd "select emid from $mebtbl where tmid = $rm"
        set sqt $mebtbl
	set tophier 1
    }
    {bundle} {
        set sqlcmd "select mid from $memtbl where syty in ('[join $BundTypes ',']') and name = '$target'"
        set sqt $memtbl
        doSQL 1
        set rm [sybNext 1]
        if {$rm == ""} {set rm -1}
        set sqlcmd "select emid from $mebtbl where tmid = $rm"
        set sqt $mebtbl
	set tophier 1
    }
}

set rt [crange $rt 0 7]

doSQL 1

set mlist "$smid"
while {1} {
    set m [sybNext 1]
    if {$m == ""} {break}
    if {$tophier} {
	keylset pinouts($m) $rm [getPinout $rm $m]
    }
    lappend mlist $m
}
#
if {[lempty $mlist]} {
    puts $efp "NO MEMES for target $rt $target"
    puts stderr "SORRY... No Memes for your target $rt $target"
    close $efp
    exit
}
#
# puts stderr "Collecting memes $mlist..."
set klist [collectMemes $mlist]
#
# puts stderr "Result of collectMemes..."
# puts stderr "$klist"
# foreach k $klist {
#    puts stderr "$k : [set $k]"
# }
set kids ""
foreach m $klist {
    set $m [lrmdups [set $m]]
#   puts $efp "$m : [set $m]"
    if {[lsearch $BTcodes $m] >= 0} {
        foreach p [set $m] {
            if {!$p} {
                puts stderr "Got mid 0 in parent list $m"
                continue
            }
            set mn [keylget collected($p) name]
            if {[info exists elements($p]} {
                puts $efp " $m $mn $p has children: "
                foreach e $elements($p) {
                    set mi [keylget elinfo($e) emid]
                    set mn [keylget collected($mi) name]
                    puts $efp "     $mn $mi"
                    lappend kids $mi
                }
            }
        }
    }
}
#
set REG ""
#       Is this just a regular name?  if it has no parent AND
#       it never is found in a table, then it should be printed
#       in its own right
foreach i [lsort [array names collected]] {
    set found 0
    set me [keylget collected($i) name]
#   puts $efp "Collected $i : $me"
    if {[info exists intables($i)]} {continue}
    if {[lsearch $ISA $i] >= 0} {continue}
    if {[lsearch $MAP $i] >= 0} {continue}
    if {[lsearch $CTR $i] >= 0} {continue}
    lappend REG $i
}
#
puts $efp "Regular Memes:"
foreach r $REG {
    set mn [keylget collected($r) name]
    puts $efp "    $mn $r"
}
# puts stderr "REG is $REG"
puts $efp "ISAS:"
foreach i $ISA {
    set mn [keylget collected($i) name]
    puts $efp "      $mn $i"
}
puts $efp "MAPS:"
foreach i $MAP {
    if {!$i} {puts stderr "Zero MID in maps list $MAP"; continue}
    set mn [keylget collected($i) name]
    puts $efp "      $mn $i"
}
#
#
# We now have, in the collected array, a collection of all the memes
# we think are involved in this context.
#
# Now we need to print out our report.  This should not be too hard
# actually.
#
# we can print the report out in sections:  counters, regular Memes,
# arrays, then tables.
#
set ofp [open $outfile w]
#
#------------------------------------------------------------------------
#
# spit out opening boilerplate
#
#
if {$rt == "typedefs"} {
    set out "[typeDefs]"
    puts $ofp "[join $out \n]"
    close $ofp
    close $efp
    exit 0
}

if {$standalone} {
puts $ofp [format $afmt(Bhtml)]
puts $ofp [format $afmt(Bhead)]
}
if {$rt == "context"} {
    puts $ofp [format $afmt(title) "Memes for Context $target"]
    puts $ofp [format $afmt(Ehead)]
    if {$standalone} {
    puts $ofp [format $afmt(Bbody)]
    puts $ofp [format $afmt(h3) "Memes (FITS Keywords) in context $target"]
    }
} elseif {$rt == "name"} {
    puts $ofp [format $afmt(title) "Memes whose name is $target"]
    puts $ofp [format $afmt(Ehead)]
    if {$standalone} {
    puts $ofp [format $afmt(Bbody)]
    puts $ofp [format $afmt(h3) "Memes (FITS Keywords) named $target"]
    }
} else  {
    set sqlcmd "select semantics from $memtbl where name = '$target' and syty = 'header'"
    set sqt $memtbl
    doSQL 1
    set ns [sybNext 1]
    if {$ns != ""} {
        set ns [format $afmt(h4) $ns]
    }
    puts $ofp [format $afmt(title) "Meme (Keyword) Documentation for Bundle $target"]
    puts $ofp [format $afmt(Ehead)]
    if {$standalone} {
    puts $ofp [format $afmt(Bbody)]
    puts $ofp [format $afmt(h3) "Memes (FITS Keywords) contained in Bundle $target"]
    }
    puts $ofp "$ns"
}
if {$standalone} {
puts $ofp [format $afmt(h4) [fmtclock [getclock] {%a %Y %b %e %T %Z}]]
}
puts $ofp [format $afmt(rule)]
flush $ofp

# only if context
if {$rt == "context"} {
    set desc ""
    set author ""
    set sqt $mcotbl
    set sqlcmd "select author, stamp, descrip from $mcotbl where mcontext = '$target'"
    # puts $efp "$sqlcmd"
    doSQL 1
    while {1} {
        set line [sybNext 1]
        if {$line == ""} {break}
    #   puts $efp "got $line"
        lassign $line author stamp desc
        if {$author == ""} {set author "Unknown_Author"}
        if {$stamp == ""} {set stamp "Unknown_Date"}
    }
    #
    if {$author != ""} {
        puts $ofp "Context [format $afmt(bold) $target] (by $author as of $stamp)[format $afmt(br)]"
        puts $ofp "[format $afmt(ital) $desc]"
    }
}
#
#------------------------------------------------------------------------
#
# Then print report, by sections
#
puts $ofp [format $afmt(ss) "Legend"]
puts $ofp [format $afmt(rule)]
puts $ofp [format $afmt(Bdl)]
if {$outfmt == "L"} {
	set mn [keylget collected($smid) name]
        if {$indexing} {
        puts $ofp "\\index\{Sample $Item\}"
        }
}
#
docMeme $smid
puts $ofp [format $afmt(Edl)]
#
if {![lempty $CTR]} {
    puts $ofp [format $afmt(rule)]
    puts $ofp [format $afmt(ss) "Active Counters"]
    puts $ofp [format $afmt(rule)]
    puts $ofp [format $afmt(Bdl)]
    set CTR [sortaList $CTR]
    foreach c $CTR {
	if {$outfmt == "L"} {
	set mn [keylget collected($c) name]
        if {$indexing} {
        puts $ofp "\\index\{$Item!$mn\}"
        }
	}
        docMeme $c
#        puts $ofp " [format $afmt(br)]"
        puts $ofp ""
    }
    puts $ofp [format $afmt(Edl)]
}
#
# puts stderr "REG is $REG"
if {![lempty $REG]} {
    puts $ofp [format $afmt(rule)]
    puts $ofp [format $afmt(ss) "Regular Memes"]
    puts $ofp [format $afmt(rule)]
    puts $ofp [format $afmt(Bdl)]
    set REG [sortaList $REG]
#     puts stderr "SortaListed REG is $REG"
    foreach r $REG {
#       puts stderr "Doc Meme $r"
        if {[lsearch $kids $r] >= 0} {continue}
        if {[lsearch $MAP $r] >= 0} {continue}
        if {$r == $smid} {continue}
	if {$outfmt == "L"} {
	set mn [keylget collected($r) name]
        if {$indexing} {
        puts $ofp "\\index\{$Item!$mn\}"
        }
	}
        docMeme $r
#        puts $ofp " [format $afmt(br)]"
        puts $ofp ""
    }
    puts $ofp [format $afmt(Edl)]
}
#
if {![lempty $MAP]} {
    puts $ofp [format $afmt(rule)]
    puts $ofp [format $afmt(ss) "Map Definitions"]
    puts $ofp [format $afmt(rule)]
    puts $ofp [format $afmt(Bdl)]
    set MAP [sortaList $MAP]
    foreach m $MAP {
        if {[lsearch $kids $m] >= 0} {puts stderr "A MAP $m can't be a child!";continue}
        if {[lsearch $ISA $m] >= 0} {puts stderr "A MAP $m can't be an ISA!";continue}
	if {$outfmt == "L"} {
	set mn [keylget collected($m) name]
        if {$indexing} {
        puts $ofp "\\index\{Maps!$mn\}"
        }
	}
        docMeme $m
#        puts $ofp " [format $afmt(br)]"
        puts $ofp ""
    }
    puts $ofp [format $afmt(Edl)]
}
#
# lassign [intersect3 $ISA $REG] isas overlap regs
# puts stderr "isas $isas"
# puts stderr "over $overlap"
# puts stderr "regs $regs"
# if {![lempty $isas]} {
#     puts $ofp [format $afmt(rule)]
#     puts $ofp [format $afmt(ss) "ISA Targets"]
#     puts $ofp [format $afmt(rule)]
#     puts $ofp [format $afmt(Bdl)]
#     set isas [sortaList $isas]
#     foreach i $isas {
#         docMeme $i
#         #puts $ofp [format $afmt(p)]
#     }
#     puts $ofp [format $afmt(Edl)]
# }
#
# THE END
#
puts $ofp [format $afmt(rule)]
if {$standalone} {
puts $ofp [format $afmt(Ebody)]
}
puts $ofp [format $afmt(Ehtml)]
close $efp
close $ofp
 
if {$outfmt == "L"} {
        # postfilter the output to become true LaTeX
        set sedcmd {-e 's/%\([^ %][^ %]*\)/\\%\1/g' -e 's/\([^&_#]*[^\]\)\([&_#]\)/\1\\\2/g' -e 's/->/$\\leftrightarrow$/g'}
        eval system \{ sed $sedcmd < $outfile > $outfile.foo \}
        frename $outfile.foo $outfile
}

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 $target"
        close $afp
}
#
sybClose 1
#
