view release on metacpan or  search on metacpan

watch-multiple-mimedefangs.tcl  view on Meta::CPAN

	set bago [string range $bago 4 end]
	set x [expr $bago - $aago]
	if {$x != 0} {
	    return $x
	}
    }

    return [expr $an - $bn]
}

proc update_busyworkers { mach fp} {
    global Data
    set w $Data($mach,busyworkerwin)
    if {![winfo exists $w]} {
	catch { close $fp }
	return
    }
    $w.t configure -state normal
    $w.t delete 1.0 end

    # Clear out tags
    foreach tag [$w.t tag names] {
	if {"$tag" != "pid"} {
	    $w.t tag delete $tag
	}
    }

    set busyguys [lsort -command compare_workers $Data($mach,busydata)]

    set count(scan) 0
    set count(relayok) 0
    set count(senderok) 0
    set count(recipok) 0

    foreach line $busyguys {
	set lst [split $line]
	set workerno [lindex $lst 0]
	set pid [lindex $lst 2]
	set cmd [lindex $lst 3]
	incr count($cmd)
	set len [string length "$workerno B $pid "]
	set line [string range $line $len end]
	$w.t insert end [format "%4d" $workerno] workerno
	$w.t insert end " "
	$w.t tag delete "Z$pid"
	$w.t insert end [format "%6d" $pid] [list pid "Z$pid"]
	$w.t insert end " $line\n"

    }

    set title "Busy workers: $mach"
    foreach cmd {scan relayok senderok recipok} {
	if {$count($cmd) > 0} {
	    set c $count($cmd)
	    append title " $cmd=$c"
	}
    }
    wm title $w $title
}

proc popup_machine_menu { m index x y} {
    catch { destroy .m }
    menu .m -tearoff 0
    .m add command -label "SSH" -command [list ssh $m]
    .m add command -label "Busy Workers" -command [list busyworkers $m]
    .m add separator
    .m add command -label "Delete" -command [list del_machine $m]
    tk_popup .m $x $y
}

proc grid_machine_new_style { m index } {
    global NewStyleShowScans NewStyleShowRelayoks NewStyleShowSenderoks NewStyleShowRecipoks
    set m [lindex $m 0]

    set disp_m $m
    if {[regexp {@(.*)$} $m foo host]} {
	set disp_m $host
    }

    # Chop off domain name from host
    if {[regexp {^([^.]+)\.} $disp_m foo new_m]} {
	set disp_m $new_m
    }
    set row [expr $index + 1]
    catch { destroy .top.name$index }
    catch { destroy .top.busy$index }
    catch { destroy .top.scanspersec$index }
    catch { destroy .top.scantime$index }
    catch { destroy .top.relayspersec$index }
    catch { destroy .top.relaytime$index }
    catch { destroy .top.senderspersec$index }
    catch { destroy .top.sendertime$index }
    catch { destroy .top.recipspersec$index }
    catch { destroy .top.reciptime$index }
    catch { destroy .top.c$index }

    set column 2
    set canv_width 200
    label .top.name$index -text $disp_m -relief raised
    bind .top.name$index <ButtonPress-1> [list popup_machine_menu $m $index %X %Y]
    bind .top.name$index <ButtonPress-2> [list popup_machine_menu $m $index %X %Y]
    bind .top.name$index <ButtonPress-3> [list popup_machine_menu $m $index %X %Y]
    label .top.busy$index -text "" -foreground "#A00000"
    grid .top.name$index -row $row -column 0 -sticky new
    grid .top.busy$index -row $row -column 1 -sticky new

    if {$NewStyleShowScans} {
	label .top.scanspersec$index -foreground "#00A000"
	grid .top.scanspersec$index -row $row -column $column -sticky new
	incr column
	label .top.scantime$index -foreground "#0000A0"
	grid .top.scantime$index -row $row -column $column -sticky new
	incr column
	incr canv_width 200
    }
    if {$NewStyleShowRelayoks} {
	label .top.relayspersec$index -foreground "#808000"
	grid .top.relayspersec$index -row $row -column $column -sticky new
	incr column
	label .top.relaytime$index -foreground "#008080"
	grid .top.relaytime$index -row $row -column $column -sticky new
	incr column
	incr canv_width 200
    }
    if {$NewStyleShowSenderoks} {
	label .top.senderspersec$index -foreground "#808080"
	grid .top.senderspersec$index -row $row -column $column -sticky new
	incr column
	label .top.sendertime$index -foreground "#800080"
	grid .top.sendertime$index -row $row -column $column -sticky new
	incr column
	incr canv_width 200
    }
    if {$NewStyleShowRecipoks} {
	label .top.recipspersec$index -foreground "#008000"
	grid .top.recipspersec$index -row $row -column $column -sticky new
	incr column
	label .top.reciptime$index -foreground "#000000"
	grid .top.reciptime$index -row $row -column $column -sticky new
	incr column
	incr canv_width 200
    }
    canvas .top.c$index -width $canv_width -height 60 -takefocus 0 -borderwidth 0 -background #FFFFFF -highlightthickness 0
    grid .top.c$index -row $row -column $column -sticky nsew -pady 1
    grid rowconfigure .top $row -weight 1
}
proc grid_machine { m index } {
    set m [lindex $m 0]
    set row [expr $index + 1]

    catch { destroy .top.name$index}
    catch { destroy .top.busy$index}
    catch { destroy .top.persec$index}
    catch { destroy .top.time$index}
    catch { destroy .top.c$index}

    set disp_m $m
    if {[regexp {@(.*)$} $m foo host]} {
	set disp_m $host
    }

    label .top.name$index -text $disp_m -relief raised
    bind .top.name$index <ButtonPress-1> [list popup_machine_menu $m $index %X %Y]
    bind .top.name$index <ButtonPress-2> [list popup_machine_menu $m $index %X %Y]
    bind .top.name$index <ButtonPress-3> [list popup_machine_menu $m $index %X %Y]
    label .top.busy$index -text ""
    label .top.persec$index -text ""
    label .top.time$index -text ""
    canvas .top.c$index -width 600 -height 60 -takefocus 0 -borderwidth 0 -background white -highlightthickness 0
    .top.c$index create text 2 2 -anchor nw -text "" -tags statusText
    grid .top.name$index -row $row -column 0 -sticky new
    grid .top.busy$index -row $row -column 1 -sticky new
    grid .top.persec$index -row $row -column 2 -sticky new
    grid .top.time$index -row $row -column 3 -sticky new
    grid .top.c$index -row $row -column 4 -sticky nsew -pady 1
    grid rowconfigure .top $row -weight 1

}

proc kick_off_update {} {
    global Machines
    global NewStyle
    global DoneARedrawSinceLastUpdate
    global MachinesAwaitingReply
    global MainUpdateInterval

    if {$DoneARedrawSinceLastUpdate} {
	set DoneARedrawSinceLastUpdate 0
	if {$NewStyle} {
	    set cmd "rawload1 60"
	} else {
	    set cmd "rawload"
	}

	set MachinesAwaitingReply {}
	foreach m $Machines {
	    catch {
		set fp [lindex $m 1]
		puts $fp $cmd
		flush $fp
		lappend MachinesAwaitingReply [lindex $m 0]
	    }
	}
    }
    after $MainUpdateInterval kick_off_update
}

## translated from C-code in Blt, who got it from:
##      Taken from Paul Heckbert's "Nice Numbers for Graph Labels" in
##      Graphics Gems (pp 61-63).  Finds a "nice" number approximately
##      equal to x.
proc nicenum {x floor} {

    if {$x == 0} {
	return 0
    }

    set negative 0

    if {$x < 0} {
        set x [expr -$x]
        set negative 1
    }

    set exponX [expr floor(log10($x))]