# dbinitprocs -- Ray R. Larson (mar 92)
#
# procs to read the default or user-specified database
# for acquiting some useful info.
# set database to the default for the application
# this is set by pgtkm command line args (like monitor) or
# defaults to the database with the user's name
#  -- this is forced to the cookie db in s2k 

global CURRENTDATABASE
PQsetdb "$CURRENTDATABASE"

# puts stdout "Current Database is $CURRENTDATABASE"

# set to "NO LAST QUERY" in s2k
global PGLASTQUERY 

proc bldtypes {} {
     global PGTYPES
     catch { unset PGTYPES }
     PQexec "begin"
     PQexec "retrieve portal tport (pg_type.oid, pg_type.all)"
     PQexec "fetch all in tport"
     PQtuplearray tport PGTYPES
     PQexec "close tport"
     PQexec "end"
}


proc bldclass {} {
    global PGCLASSALL
     catch { unset PGCLASSALL }
     catch { unset PGCLASS }
    PQexec "begin"
    # retrieve only normal relations (not indexes)
    PQexec "retrieve portal rport (r.oid, r.all) from r in pg_class "
    PQexec "fetch all in rport"
    PQtuplearray rport PGCLASSALL
    PQexec "close rport"
    PQexec "end"

    # get only the class names
    PQexec "begin"
    # retrieve only normal relations (not indexes)
    PQexec "retrieve portal rport (r.relname) from r in pg_class  where r.relname !~ \"pg_\""
    PQexec "fetch all in rport"
    PQtuplearray rport PGCLASS
    PQexec "close rport"
    PQexec "end"

    
}

proc bldattr {} {
    global PGATTR
     catch { unset PGATTR }
    PQexec "begin"
    PQexec "retrieve portal aport (a.all)
             from a in pg_attribute
             where  a.attnum > 0 "

    PQexec "fetch all in aport"
    PQtuplearray aport PGATTR
    PQexec "close aport"
    PQexec "end"
}

proc bldDB {} {
    global PGDBS
     catch { unset PGDBS }
    PQexec "begin"
    PQexec "retrieve portal aport (pg_database.all)"
    PQexec "fetch all in aport"
    PQtuplearray aport PGDBS
    PQexec "close aport"
    PQexec "end"
}

proc bldLOlist {} {
    global PGLOLIST
    catch { unset PGLOLIST }
    PQexec "begin"
    PQexec "retrieve portal aport (pg_naming.all)"
    PQexec "fetch all in aport"
    PQtuplearray aport PGLOLIST
    PQexec "close aport"
    PQexec "end"
}

proc bldTindex {} {
    global PGTYPES PGTYPELEN PGTYPEINDEX
    foreach iname [lsort [array names PGTYPES]] {
        if {[string match "FIELD*" $iname] == 1} break

        set oid [lindex $PGTYPES($iname) 0]
        set tname [lindex $PGTYPES($iname) 1]
        set prlen [lindex $PGTYPES($iname) 4]

        set PGTYPEINDEX($oid) $tname
        set PGTYPELEN($oid) $prlen
        set PGTYPELEN($tname) $prlen
    }
}

proc bldRindex {} {
    global PGCLASSALL PGCLASSINDEX
    foreach iname [lsort [array names PGCLASSALL]] {
        if {[string match "FIELD*" $iname] == 1} break

        set oid [lindex $PGCLASSALL($iname) 0]
        set cname [lindex $PGCLASSALL($iname) 1]
        set kind [lindex $PGCLASSALL($iname) 10]

        set PGCLASSINDEX($oid) $cname
        set PGCLASSINDEX(TYPE$oid) $kind
        set PGCLASSINDEX($cname) $oid
    }
}


proc bldATTRlist {} {
    global PGATTR PGATTRLIST PGCLASSINDEX PGTYPEINDEX
    set PGATTRLIST ""
    set templist ""
    foreach iname [lsort [array names PGATTR]] {
        if {[string match "FIELD*" $iname] == 1} break

        set reloid [lindex $PGATTR($iname) 0]
        set aname [lindex $PGATTR($iname) 1]
        set type [lindex $PGATTR($iname) 2]

        if {[catch {set temp $PGCLASSINDEX($reloid)}]==0} {
           lappend temp $aname $PGTYPEINDEX($type)
           lappend templist $temp
        }
    }
    set PGATTRLIST [lsort $templist]
}


proc bldSYSATTRlist {} {
    global PGATTR PGSYSATTRLIST PGCLASSINDEX PGTYPEINDEX
    set PGSYSATTRLIST ""
    set templist ""
    foreach iname [lsort [array names PGATTR]] {
        if {[string match "FIELD*" $iname] == 1} break

        set reloid [lindex $PGATTR($iname) 0]
        set aname [lindex $PGATTR($iname) 1]
        set type [lindex $PGATTR($iname) 2]

        if {[catch {set temp $PGCLASSINDEX($reloid)}]==0} { 
 	    if {[regexp "^pg_" $temp] == 0} continue
            lappend temp $PGCLASSINDEX(TYPE$reloid) $aname $PGTYPEINDEX($type)
            lappend templist $temp
        }
    }
    set PGSYSATTRLIST [lsort $templist]
}


proc bldUserATTRlist {} {
    global PGATTR PGUSERATTRLIST PGCLASSINDEX PGTYPEINDEX
    set PGUSERATTRLIST ""
    set templist ""
    foreach iname [lsort [array names PGATTR]] {
        if {[string match "FIELD*" $iname] == 1} break

        set reloid [lindex $PGATTR($iname) 0]
        set aname [lindex $PGATTR($iname) 1]
        set type [lindex $PGATTR($iname) 2]

        if {[catch {set temp $PGCLASSINDEX($reloid)}]==0} {
	   if {[regexp "^pg_" $temp]} continue
           lappend temp $PGCLASSINDEX(TYPE$reloid) $aname $PGTYPEINDEX($type)
           lappend templist $temp
        }
    }
    set PGUSERATTRLIST [lsort $templist]
}

# ------------------------------------------------------------------------
# create an index to Inversion Large Objects in PGLOLIST -- see bldLOlist 
#
# ------------------------------------------------------------------------
proc bldLOTree {} {
    global PGLOLIST PGLONAMES PGLODIRS PGLOPARENTS
    catch { unset PGLONAMES }
    catch { unset PGLODIRS }
    catch { unset PGLOPARENTS }
    foreach iname [lsort [array names PGLOLIST]] {
        if {[string match "FIELD*" $iname] == 1} break

        set fname [lindex $PGLOLIST($iname) 0]
        set fid [lindex $PGLOLIST($iname) 1]
        set parentid [lindex $PGLOLIST($iname) 2]

        lappend PGLONAMES($fid) [list $fname $fid]
        lappend PGLONAMES($parentid) [list $fname $fid]
	set PGLOPARENTS($fid) $parentid
    }

    foreach iname [array names PGLONAMES] {

        if {[llength $PGLONAMES($iname)] > 1} {
     	   set dirname [getLOpath [lindex $PGLONAMES($iname) 0]]
	   set PGLODIRS($dirname) [list [lindex $PGLONAMES($iname) 0]]
           set rest [lrange $PGLONAMES($iname) 1 end]
     	   foreach lname $rest {
               set fname [lindex $lname 0]
               set fnum [lindex $lname 1]
               if {[llength $PGLONAMES($fnum)] > 1} { 
                    lappend fname $fnum "<DIR>"
               } else {
                    lappend fname $fnum {}
               }
	       lappend PGLODIRS($dirname) $fname
	   }
	}
    }
}

proc getLOpath {dname} {
	global PGLONAMES PGLOPARENTS
	set inname [lindex $dname 0]
	set innum [lindex $dname 1]
	set level 0
	set pathlist $inname
	set nextnum $innum

	while {[set pnum $PGLOPARENTS($nextnum)]} {
		lappend pathlist [lindex [lindex $PGLONAMES($pnum) 0] 0]
		incr level
		set nextnum $pnum
	}
	incr level -1
	set pathstring "/"
	while {$level >= 0} {
		append pathstring [lindex $pathlist $level]
		incr level -1
		if {$level >= 0} {append pathstring "/"}
	}
	return $pathstring
}

proc dodbinit {} {
# actually build these arrays
bldDB
bldattr
bldclass
bldtypes
bldTindex
bldRindex
bldATTRlist
bldSYSATTRlist
bldUserATTRlist

}

proc PQlonames {invpath} {

	global PGLODIRS
	if {[catch {set junk $PGLODIRS(/)}]} {
           bldLOlist
           bldLOTree
	}
	return [lrange $PGLODIRS($invpath) 1 end]
}






