#!/opt/tcl/bin/sywish
#
# set up the basics
set tclroot /opt/share/tcl
loadlibindex $tclroot/lib/ucodb/ucodb.tlib
load libMeters.so
#
global dbpipe1 server sybmsg table user 
#
set user sa
set pass FOO
set base master
set server $argv

puts stderr "Please enter the SA password for server $server"
gets stdin pass
set dbpipe1 ""
catch {set dbpipe1 [sybOpen $base $user $pass $server]}
if {$dbpipe1 == ""} {
puts stderr "$sybmsg(dberrstr)"
exit
}
set sybhost abacus
set lfont [getFont {} helvetica]
#
global debugs
set debugs {}
#
# Start by sampling every 5 seconds
#
global exedir
set exedir /usr/local/bin
global bitmapdir
set bitmapdir /usr/local/X11/include/bitmaps
#
global samplet
set samplet 10
global avgsam
global scount
global lastsam
global rconns
global ucount
global bconns
set runtot 0
set scount 0
set lastsam 0
set avgsam 0
set rconns 0
set bconns 0
set ucount 0
#
# This is for autoscaling the disk reads meter, which is the volatile one.
# we keep a buffer of 100 points (half the meter) and scale to the max 
# of that buffer (rmax)
global bufptr 
global dumpctr
global rmax
set bufptr 0
set dumpctr 0
set rmax 0
global buffer
loop i 0 100 {
	set buffer($i) 0
}
#
global first
set first 1
global detail
set detail 0
global us
set us c
#
proc readServer {} {

	global sybmsg first bufptr rmax buffer dumpctr
	global avgsam lastsam samplet scount runtot us sybhost rconns ucount
	global bconns detail per_iobz per_cpubz per_idle per_other rdmax

set sqt none

set sqlcmd "select spid,suser_name(suid), db_name(dbid), hostname, cmd, cpu, physical_io, blocked from sysprocesses where hostname != '' order by suser_name(suid), db_name(dbid)"
doSQL 1

set users {}
set hosts {}
set blocks {}
set rcct 0

set ptable {}
lappend ptable [format "%-2.2s %-8.8s %-10.10s %-10.10s %-10.10s %-7.7s %-5.5s %-3.3s" id user dbase host cmd cpu physio blk]
lappend ptable [format "%-2.2s %-8.8s %-10.10s %-10.10s %-10.10s %7.7s %5.5s %3.3s" -- -------- ---------- ---------- -------- ------- ----- ---]

while {1 == 1} {
	set line [sybNext 1]
	if {$line == ""} {break}
	
	lassign $line spid user dbase hname cmd cpu io block
	lappend users $user
	set hname [lindex [split $hname .] 0]
	if {$hname != $sybhost} {
		lappend hosts $hname
		incr rcct
	}

	lappend ptable [format "%2d %-8.8s %-10.10s %-10.10s %-10.10s %7d %5d %3d" $spid $user $dbase $hname $cmd $cpu $io $block]

	lappend cpus $cpu
	lappend ios $io
	if {$block} {
	lappend blocks $block
	}

}

set rconns $rcct

# put back the three server procs with empty hostname

set cur_conns [expr {[llength $users] + 3}]

# now make info to display:  list of unique users, count of blocked conn, etc.
set ulist [lrmdups $users]
set ucount [llength $ulist]
set bconns [llength $blocks]

#
set hosts [lrmdups $hosts]
# set hosts [join [lreplace $hosts [lsearch $hosts $sybhost] [lsearch $hosts $sybhost]] \n]
# set r_hosts [llength $hosts]
#

set i 0

foreach u $users {
	
	set err [catch {incr uio($u) [lindex $ios $i]}]
	if {$err} {
		set uio($u) [lindex $ios $i]
	}
	set err [catch {incr ucpu($u) [lindex $cpus $i]}]
	if {$err} {
		set ucpu($u) [lindex $cpus $i]
	}
	set err [catch {incr ucon($u)}]
	if {$err} {
		set ucon($u) 1
	}

	incr i
}
#
if {$us == "c"} {
set ushow [format "%-8.8s %2.2s %3.3s\n" name co cpu]
} else {
set ushow [format "%-8.8s %2.2s %3.3s\n" name co io]
}
foreach u $ulist {
	if {$us == "c"} {
	set ustr [format "%-8.8s %02d %06d" $u $ucon($u) $ucpu($u)]
	} else {
	set ustr [format "%-8.8s %02d %06d" $u $ucon($u) $uio($u)]
	}
	append ushow "\n$ustr"
}
.showuser delete 1.0 end
.showuser insert 1.0 "$ushow"

.showhost delete 1.0 end
.showhost insert 1.0 "$hosts"

# this does no good, the silly server doesn't know its current conn count
# set sqlcmd "select @@connections"
# doSQL 1
# set cur_conns [sybNext 1]

set sqlcmd "sp_monitor"
doSQL 1

# set sybmsg:  $sybmsg(msgno) $sybmsg(msgtext)"

set ctr 1
while {2 ==2} {

	set line [sybNext 1]
#	echo "Got line $line"

#	set nextrow is $sybmsg(nextrow)"
	if {[string compare $sybmsg(nextrow) NO_MORE_RESULTS] == 0} {break}

	if {$line == ""} {continue}

	case $ctr in {
	{1} {
		lassign $line lastrun thisrun seconds
	}
	{2} {
		lassign $line cpubz iobz idle
		puts stderr "line is $line"
		set p1 [string first ( $cpubz]
		set p2 [string first ) $cpubz]
		set p3 [string first - $cpubz]
		set tot_cpubz [crange $cpubz 0 [expr $p1 - 1] ]
		set cur_cpubz [crange $cpubz [expr $p1 + 1] [expr $p2 - 1]]
		set per_cpubz [string trimright [crange $cpubz [expr $p3 + 1] end] %]
		puts stderr "iobz is $iobz"
		set p1 [string first ( $iobz]
		set p2 [string first ) $iobz]
		set p3 [string first - $iobz]
		puts stderr "p1 is $p1"
		set tot_iobz [crange $iobz 0 [expr $p1 - 1]]
		set cur_iobz [crange $iobz [expr $p1 + 1] [expr $p2 - 1]]
		set per_iobz [string trimright [crange $iobz [expr $p3 + 1] end] %]
		set p1 [string first ( $idle]
		set p2 [string first ) $idle]
		set p3 [string first - $idle]
		set tot_idle 0
		catch {set tot_idle [crange $idle 0 [expr $p1 - 1]]}
		set cur_idle [crange $idle [expr $p1 + 1] [expr $p2 - 1]]
		set per_idle [string trimright [crange $idle [expr $p3 + 1] end] %]
		set per_other [expr 100 - ($per_idle + $per_cpubz + $per_iobz)]
	}
	{3} {
		lassign $line pktin pktout pkterr
		set p1 [string first ( $pktin]
		set p2 [string first ) $pktin]
		set tot_pktin [crange $pktin 0 [expr $p1 - 1]]
		set cur_pktin [crange $pktin [expr $p1 + 1] [expr $p2 - 1]]
		set p1 [string first ( $pktout]
		set p2 [string first ) $pktout]
		set tot_pktout [crange $pktout 0 [expr $p1 - 1]]
		set cur_pktout [crange $pktout [expr $p1 + 1] [expr $p2 - 1]]
		set p1 [string first ( $pkterr]
		set p2 [string first ) $pkterr]
		set tot_pkterr [crange $pkterr 0 [expr $p1 - 1]]
		set cur_pkterr [crange $pkterr [expr $p1 + 1] [expr $p2 - 1]]
	}
	{4} {
		lassign $line reads writes errs conns
		set p1 [string first ( $reads]
		set p2 [string first ) $reads]
		set tot_reads [crange $reads 0 [expr $p1 - 1]]
		set cur_reads [crange $reads [expr $p1 + 1] [expr $p2 - 1]]
		set p1 [string first ( $writes]
		set p2 [string first ) $writes]
		set tot_writes [crange $writes 0 [expr $p1 - 1]]
		set cur_writes [crange $writes [expr $p1 + 1] [expr $p2 - 1]]
		set p1 [string first ( $errs]
		set p2 [string first ) $errs]
		set tot_errs [crange $errs 0 [expr $p1 - 1]]
		set cur_errs [crange $errs [expr $p1 + 1] [expr $p2 - 1]]
		set p1 [string first ( $conns]
		set p2 [string first ) $conns]
		set tot_conns [crange $conns 0 [expr $p1 - 1]]
		set new_conns [crange $conns [expr $p1 + 1] [expr $p2 - 1]]
	}
	{default} {
		set error, got too many lines from sp_monitor"
	}
	}

	incr ctr

}
#	echo "set variables"

	set cpu_busy [lindex [split [expr $cur_cpubz.0/$seconds] .] 0]
	set io_busy [lindex [split [expr $cur_iobz.0/$seconds] .] 0]
	set pktsin [lindex [split [expr $cur_pktin.0/$seconds] .] 0]
	set pktsout [lindex [split [expr $cur_pktout.0/$seconds] .] 0]
	set pkterr [lindex [split [expr $cur_pkterr.0/$seconds] .] 0]
	set reads [lindex [split [expr $cur_reads.0/$seconds] .] 0]
	set writes [lindex [split [expr $cur_writes.0/$seconds] .] 0]
	set errs [lindex [split [expr $cur_errs.0/$seconds] .] 0]
	set conns $cur_conns

#	get the previous value at this position in buffer
	set prevr $buffer($bufptr)
#	and put the new value in its place
	set buffer($bufptr) $reads
#	is the new value greater than the max value? if so, set the new
#	max value and configure the stripchart
	if {$reads > $rdmax} {
		set rdmax $reads
		.reads configure -max $rdmax \
			-title "Disk reads/sec : 0 to $rdmax"
#		.rdmax configure -text $rdmax
		.dread configure -max $rdmax
	} else {
#	new value not greater? well then, are we replacing the old max val?
#	if so, then we need to find the new max val by scanning the buffer.
		if {$prevr == $rdmax} {
			set rdmax [getMaxR]
			if {$rdmax == 0} {set rdmax 1}
			.reads configure -max $rdmax
#			.rdmax configure -text $rdmax
			.dread configure -max $rdmax
		}
	}
	
#	this is a circular buffer
	incr bufptr
	if {$bufptr == 50} {
		set bufptr 0
		incr dumpctr
		if {$dumpctr == 10} {
		set sqlcmd "dump tran master with no_log"
		doSQL 1
		set dumpctr 0
		}
	}

#	echo "cpu_busy io_busy pktsin pktsout pkterr reads writes errs  conns"
#	echo "$cpu_busy $io_busy $pktsin $pktsout $pkterr $reads $writes $errs  $conns"

	if {$first} {
		set first 0
#		echo "no print, first time through"
	} else {
	.dconn set $conns
	.dwrit set $writes
	.dread set $reads
	.dpkti set $pktsin
	.dpkto set $pktsout
	.dsamp set $seconds

	.cpubz set $cpu_busy
	.iobz set $io_busy
	.pktin set $pktsin
	.pktout set $pktsout
	.pkterr set $pkterr
	.reads set $reads
	.writes set $writes
	.errs set $errs
	.conns set $conns

	incr runtot $seconds
	incr scount
	set avgsam [format "%6.2f" [expr $runtot.0/$scount]]
	set lastsam $seconds

	update

	if {$detail} {
		showDetail $ptable
	}

	}

}
#
proc makeDetail {} {

	global bitmapdir server

	set w .pdet
	catch {destroy $w}
	toplevel $w
	wm geometry $w 600x400
	wm title $w "Sybase Proc Table : $server"
	catch {wm iconbitmap $w @$bitmapdir/fosql.xbm}
	set wid 600
	set hgt 400
	wm minsize $w $wid $hgt

	set font [getFont $w mediumcou]

	frame $w.f -relief flat -border 0
	frame $w.c -relief flat -border 0
	scrollbar $w.f.vert -orient vertical -command "$w.f.box yview"  -relief sunken
        listbox $w.f.box -yscroll "$w.f.vert set"  -relief sunken  -font "$font" -border 1 -relief sunken -width 60 -height 20 

	button $w.c.quit -command "set detail 0; destroy $w" -text "Go Away"
	button $w.c.prin -command "printBox $w.f.box" -text "Print Table"
	pack append $w.c $w.c.prin {left expand fillx} \
		$w.c.quit {right expand fillx}

	pack append $w.f $w.f.vert {right filly fillx} \
		$w.f.box {left fillx filly expand}
	pack append $w $w.f {top expand fillx} $w.c {bot expand fillx}

	pack append $w $w.f {top fillx} $w.c {bot fillx}

	update

}
#
proc showDetail {lines} {

	.pdet.f.box delete 0 end

	foreach lin $lines {

		.pdet.f.box insert end "$lin"
	}

}
#
proc setSample {val} {

	global nstrip

	.dconn configure -interval [expr $val * 1000]

	set totsec [expr $nstrip * $val]
	set tmin [lindex [split [expr {$totsec/60.0}] .] 0]
	set tsec [expr {$totsec - ($tmin * 60) }]

	.runt configure -text "Total runtime of strips is $tmin:$tsec"

}
#
proc showPerc {} {

	global per_cpubz per_iobz per_idle per_other
        global bitmapdir server
 
        set w .perc
        catch {destroy $w}
        toplevel $w
        wm geometry $w 600x200
        wm title $w "Sybase Runtime Percentages"
        catch {wm iconbitmap $w @$bitmapdir/fosql.xbm}
        set wid 600
        set hgt 200
        wm minsize $w $wid $hgt
 
	vu_pie .perc.pie 
	.perc.pie set CPU-Busy $per_cpubz IO-Busy $per_iobz Idle $per_idle \
		Other $per_other
	.perc.pie configure  -title PieChart -textwidth 200 \
	-textcolor yellow \
	-background black \
	-radius 75 

	button .perc.quit -command "destroy .perc" -text "Go Away"

	place .perc.pie -in .perc 
	pack .perc.quit -side bottom
	update

}
#
proc getMaxR {} {

	global buffer

	set max 0
	foreach i [array names buffer] {
		if {$buffer($i) > $max} {
			set max $buffer($i)
		}
	}

	return $max
}
#
#
wm geometry . 600x700
wm title . "Sybase Perf Meter : $server"
catch {wm iconbitmap . @$bitmapdir/fosql.xbm}
set wid 500
set hgt 500
wm minsize . $wid $hgt

set cpmax 10
set iomax 10
set pimax 60
set pomax 60
set pemax 10
set rdmax 150
set wrmax 75
set ermax 10
set comax 50
#	BUG in stripchart?  or undoc feature?  100 is max numstrips
set nstrip 100

set totsec [expr $nstrip * $samplet]
set tmin [lindex [split [expr {$totsec/60.0}] .] 0]
set tsec [expr {$totsec - ($tmin * 60) }]

label .runt -text "Total runtime of strips is $tmin:$tsec"

set font [getFont {} helvetica]

label .hlab -text "Connected Hosts" -font $font
label .ulab -text "Connected Users" -font $font

vu_stripchart .cpubz -title "CPU Busy / Sec : 0 to $cpmax" -min 0 -max $cpmax \
	-numstrips $nstrip \
	-stripwidth 2 -height 50 -border 1 -relief sunken -font $font
vu_stripchart .iobz -title "I/O Busy / Sec : 0 to $iomax" -min 0 -max $iomax \
	-numstrips $nstrip \
	-stripwidth 2 -height 50 -border 1 -relief sunken -font $font
vu_stripchart .pktin -title "Pkts In / Sec : 0 to $pimax" -min 0 -max $pimax \
	-numstrips $nstrip \
	-stripwidth 2 -height 50 -border 1 -relief sunken -font $font
vu_stripchart .pktout -title "Pkts Out / Sec : 0 to $pomax" -min 0 \
	-max $pomax \
	-numstrips $nstrip \
	-stripwidth 2 -height 50 -border 1 -relief sunken -font $font
vu_stripchart .pkterr -title "Pkt Errs / Sec : 0 to $pemax" -min 0  \
	-max $pemax \
	-numstrips $nstrip \
	-stripwidth 2 -height 50 -border 1 -relief sunken -font $font
vu_stripchart .reads -title "Disk Reads / Sec : 0 to $rdmax" -min 0 \
	-max $rdmax \
	-numstrips $nstrip \
	-stripwidth 2 -height 50 -border 1 -relief sunken -font $font
vu_stripchart .writes -title "Disk Writes / Sec : 0 to $wrmax" -min 0 \
	-max $wrmax \
	-numstrips $nstrip -stripwidth 2 -height 50 -border 1 \
	-relief sunken -font $font
vu_stripchart .errs -title "Serv Errs / Sec : 0 to $ermax" -min 0 -max $ermax \
	-numstrips $nstrip \
	-stripwidth 2 -height 50 -border 1 -relief sunken -font $font
vu_stripchart .conns -title "Curr Conns : 0 to $comax" -min 0 -max $comax \
	-numstrips $nstrip \
	-stripwidth 2 -height 50 -border 1 -relief sunken -font $font

vu_dial .dconn -title "CurConns" -minvalue 0 -maxvalue $comax -radius 40 \
	-command readServer -interval [expr $samplet * 1000] \
	-begindegree 240 -enddegree 120 -font $lfont
vu_dial .dwrit -title "Writes" -minvalue 0 -maxvalue $wrmax -radius 40 \
	-begindegree 240 -enddegree 120 -font $lfont
vu_dial .dread -title "Reads" -minvalue -0 -maxvalue $rdmax -radius 40 \
	-begindegree 240 -enddegree 120 -font $lfont
vu_dial .dpkti -title "PktIn" -minvalue -0 -maxvalue $pimax -radius 40 \
	-begindegree 240 -enddegree 120 -font $lfont
vu_dial .dpkto -title "PktOut" -minvalue -0 -maxvalue $pomax -radius 40 \
	-begindegree 240 -enddegree 120 -font $lfont
vu_dial .dsamp -title "Sample Sec" -minvalue -0 -maxvalue 120 -radius 40 \
	-begindegree 240 -enddegree 120 -font $lfont

entry .samplet -width 4 -border 2 -relief sunken -textvariable samplet \
	-border 1
entry .avgsam -width 5 -border 2 -relief sunken -textvariable avgsam \
	-border 1
entry .lastsam -width 4 -border 2 -relief sunken -textvariable lastsam \
	-border 1
entry .scount -width 6 -border 2 -relief sunken -textvariable scount \
	-border 1
entry .rconns -width 6 -border 2 -relief sunken -textvariable rconns \
	-border 1
entry .ucount -width 6 -border 2 -relief sunken -textvariable ucount \
	-border 1
entry .bconns -width 6 -border 2 -relief sunken -textvariable bconns \
	-border 1

set font [getFont {} helvetica]

label .stlab -font $font -text "Sec/Smpl"
label .avlab -font $font -text "Avg Sec/Smp"
label .lslab -font $font -text "Last Sec/Smp"
label .ctlab -font $font -text "Sample Cnt"
label .rclab -font $font -text "Remote Conn"
label .uclab -font $font -text "Conn Cnt"
label .bclab -font $font -text "Blk'd Conn"

# label .cpmax -text $cpmax -font $font
# label .iomax -text $iomax -font $font
# label .pimax -text $pimax -font $font
# label .pomax -text $pomax -font $font
# label .pemax -text $pemax -font $font
# label .rdmax -text $rdmax -font $font
# label .wrmax -text $wrmax -font $font
# label .ermax -text $ermax -font $font
# label .comax -text $comax -font $font

button .setsam -command "setSample [.samplet get]" -text "Set" 
button .quit -command "exit" -text "Quit Monitor"
button .sperc -command showPerc -text "Show %Time..."

text .showhost -width 20 -height 4 -font $font -border 1 -relief sunken

set font [getFont {} courier]

text .showuser -width 18 -height 10 -font $font -border 1 -relief sunken

set font [getFont {} helvetica]

radiobutton .suc -text "cpu" -variable us -value c -font $font -border 1
radiobutton .sui -text "io" -variable us -value i -font $font -border 1

button .detail -command "makeDetail; set detail 1" -text "Show Procs..."

# Place the buttons and entry boxes
#
# Row 1
place .stlab -in .   -rely .0400 -relx .5200 -anchor w
place .samplet -in . -rely .0700 -relx .5200 -anchor w
place .setsam -in .  -rely .0700 -relx .6500 -anchor w
place .ctlab -in .   -rely .0400 -relx .4000 -anchor w
place .scount -in .  -rely .0700 -relx .4000 -anchor w
#
# Row 2
place .avlab -in .   -rely .1600 -relx .4000 -anchor w
place .avgsam -in .  -rely .1900 -relx .4000 -anchor w
place .lslab -in .   -rely .1600 -relx .5200 -anchor w
place .lastsam -in . -rely .1900 -relx .5200 -anchor w
#
# Row 3
place .uclab -in .   -rely .2800 -relx .4000 -anchor w
place .ucount -in .  -rely .3100 -relx .4000 -anchor w
place .rclab -in .   -rely .2800 -relx .6500 -anchor w
place .rconns -in .  -rely .3100 -relx .6500 -anchor w
place .bclab -in .   -rely .2800 -relx .5200 -anchor w
place .bconns -in .  -rely .3100 -relx .5200 -anchor w
#
# Row 4
place .hlab -in . 	-rely .3800 -relx .4000 -anchor w
place .showhost -in .   -rely .4000 -relx .4000 -anchor nw
place .ulab -in . 	-rely .5200 -relx .4000 -anchor w
place .showuser -in .   -rely .5400 -relx .4000 -anchor nw
place .suc -in . 	-rely .5200 -relx .6250 -anchor w
place .sui -in . 	-rely .5500 -relx .6250 -anchor w
#
# Last Rows
place .sperc -in .     -rely .8700 -relx .4000 -anchor w
place .detail -in .    -rely .8000 -relx .4000 -anchor w
place .quit   -in .    -rely .9800 -relx .9800 -anchor e
place .runt   -in .    -rely .9800 -relx .0200 -anchor w
#
# place the gauges with their max labels
#
place .conns -in .  -relx .0200 -rely .0700 -anchor w
# place .comax -in .  -relx .4250 -rely .0300 -anchor w
place .reads -in .  -relx .0200 -rely .1750 -anchor w
# place .rdmax -in .  -relx .4250 -rely .1350 -anchor w
place .writes -in . -relx .0200 -rely .2800 -anchor w
# place .wrmax -in .  -relx .4250 -rely .2400 -anchor w
place .pktin -in .  -relx .0200 -rely .3850 -anchor w
# place .pimax -in .  -relx .4250 -rely .3450 -anchor w
place .pktout -in . -relx .0200 -rely .4900 -anchor w
# place .pomax -in .  -relx .4250 -rely .4000 -anchor w
place .pkterr -in . -relx .0200 -rely .5950 -anchor w
# place .pemax -in .  -relx .4250 -rely .5550 -anchor w
place .cpubz -in .  -relx .0200 -rely .7000 -anchor w
# place .cpmax -in .  -relx .4250 -rely .6600 -anchor w
place .iobz -in .   -relx .0200 -rely .8050 -anchor w
# place .iomax -in .  -relx .4250 -rely .7650 -anchor w
place .errs -in .   -relx .0200 -rely .9100 -anchor w
# place .ermax -in .  -relx .4250 -rely .8700 -anchor w
#
place .dconn -in . -relx .9500 -rely .0900 -anchor e
place .dread -in . -relx .9500 -rely .2400 -anchor e
place .dwrit -in . -relx .9500 -rely .3900 -anchor e
place .dpkti -in . -relx .9500 -rely .5400 -anchor e
place .dpkto -in . -relx .9500 -rely .6900 -anchor e
place .dsamp -in . -relx .9500 -rely .8400 -anchor e

.dconn stop
.dconn start

update

# ---------------------------------------------------------------------------

# while {1 == 1} { 

# echo "start loop... do sp_monitor"

