pref.tk

openPBS的开放源代码

									  $line
				  }
				  np {
					set props ""
					lappend props $attv
					set line [list $props "Virtual PROCessors: " \
									  TEXT]
					systemNodeInfo2Append $sysframe $nname \
									  $line
				  }
				}
			}
			lappend nlist "$nname NOMOM_SNODE"
			systemNodeTypePut $sysframe $nname NOMOM_SNODE
		}

                catch {pbsdisconnect}
        	InfoBox_sendmsg "pbsdisconnect($server_name)" end
        }
	return $nlist
}

proc statNodesStateMap {state} {

	set stat [lindex [split $state ,] 0] 

	switch -exact -- $stat {
		FREE		-
		free		{ return FREE }
		OFFLINE		-	
		offline		{ return OFFLINE }
		DOWN		-
		down		{ return DOWN }
		RESERVED	-
		reserve		{ return RESERVED }
		INUSE-EXCLUSIVE	-
		job-exclusive	{ return INUSE-EXCLUSIVE }
		INUSE-SHARED	-
		job-sharing	{ return INUSE-SHARED }
		NOINFO		{ return NOINFO }
		default		{ return "" }
	}
}

proc nodesListMerge {nlist1 nlist2 frame} {

	set newlist ""
	set k 0
	foreach n1 $nlist1 {
		set nname [lindex $n1 0]
		set nodes($nname) [lrange $n1 1 end]
		set order($k) $nname
		incr k
	}
	foreach n2 $nlist2 {
		set nname [lindex $n2 0]
		set ntype [lindex $n2 1]
		if [info exists nodes($nname)] {
			set oldattr "$nodes($nname)"
			for {set i 1} {$i < [llength $n2]} {incr i} {
				set attr [lindex $n2 $i]
				if {$i == 1 && \
					[string compare $attr MOM] == 0} {
					set attr MOM_SNODE
					set ntype MOM_SNODE
				}
				if { $attr != {} } {
				   set j [expr $i-1]
				   if { $j < [llength $oldattr] } {
				     set oldattr [lreplace $oldattr $j $j $attr]
				   } else  {
				     lappend oldattr $attr
				   }	
				}
			}
			set nodes($nname) $oldattr
		} else {
			set nodes($nname) [lrange $n2 1 end]
			set order($k) $nname
			incr k
		}
		systemNodeTypePut $frame $nname $ntype
	}

	if [info exists order] {
		for {set k 0} {$k < [array size order]} {incr k} {
			set n $order($k)
			lappend newlist "$n $nodes($n)"
		}
	}

	return $newlist
}

proc serverNamesSorted {systemName servers nodesp frame} {
	global sysnodes

	upvar $nodesp nodeslist
	set newservers ""

	foreach s $servers {
		set nlist1 [statNodes $s $frame]
		set nlist2  [lrange $sysnodes($systemName,$s) 1 end]
		set nodeslist($s) [nodesListMerge $nlist1 $nlist2 $frame]

		set slen($s) [llength $nodeslist($s)]

		set i 0
		foreach os $newservers {
			if {$slen($s) < $slen($os)} {
				break
			}
			incr i
		}
		set newservers [linsert $newservers $i $s]

	}
	return $newservers
}

proc siteHasServers {siteName} {

	set sites [siteNamesGet]
	if {[lsearch -exact $sites $siteName] == -1} {
		return 0
	}
	return 1
}

proc serversPut {boxframe {siteName ""}} {
        global sysnodes

	if {[string compare $siteName ""] == 0} {
		return
	}

        set nrows [box $boxframe nrows]
        set svrBox [box $boxframe lbox 0]
	set labBox [box $boxframe lbox 1]
        for {set i 0} {$i < $nrows} {incr i} {
		set svrname  [$svrBox get $i]
		set svrlabel [$labBox get $i]
		if [info exists sysnodes($siteName,$svrname)] {
			set sysnodes($siteName,$svrname) \
			  [lreplace $sysnodes($siteName,$svrname) 0 0 $svrlabel]
		} else {
			set sysnodes($siteName,$svrname) $svrlabel
		}
        }
}

proc serversGet {boxframe siteName} {
	global sysnodes

        set srvBox [box $boxframe lbox 0]
        $srvBox delete 0 end
        set srvlBox [box $boxframe lbox 1]
        $srvlBox delete 0 end
	
        box $boxframe -nrows "-[box $boxframe nrows]"

        set entBox [box $boxframe entry 0]
        $entBox delete 0 end
        set labBox [box $boxframe entry 1]
        $labBox delete 0 end
        [box $boxframe titlelabel] configure -text "Servers@$siteName"

        foreach s [array names sysnodes] {
                set s_list [split $s ","]
                set sname [lindex $s_list 0]
                set hname [lindex $s_list 1]
                if {[string compare $sname $siteName] == 0} {
			set hlabel [lindex $sysnodes($sname,$hname) 0]
               		$srvBox insert end $hname
			$srvlBox insert end $hlabel
               		box $boxframe -nrows +1
                }
        }

        boxSelect $boxframe 0
}

proc sysnodesGet {sitename boxframe} {
	global sysnodes

	set host [box $boxframe title]

	if {![info exists sysnodes($sitename,$host)]} {
		return
	}

	set nodeBox [box $boxframe lbox 0]
	set typeBox [box $boxframe lbox 1]

	$nodeBox delete 0 end

	set nnodes 0
	foreach line [lrange $sysnodes($sitename,$host) 1 end] {
		set node [lindex $line 0]
		set type  [lindex $line 1]

		$nodeBox insert end $node
		$typeBox insert end $type
		box $boxframe -nrows +1
		incr nnodes
    	}
	if {$nnodes > 0} {
		boxSelect $boxframe 0
	}
}

proc sysnodesPut {sitename serverName box} {
	global sysnodes

	if [info exists sysnodes($sitename,$serverName)] {
		set sysnodes($sitename,$serverName) \
				[lindex $sysnodes($sitename,$serverName) 0]
	} else {
		set sysnodes($sitename,$serverName) ""
	}

	set nrows [box $box nrows]
	set ncols [box $box ncols]
	for {set i 0} {$i < $nrows} {incr i} {
		set val ""
		for {set j 0} {$j < $ncols} {incr j} {
			set lbox [box $box lbox $j]
			lappend val [$lbox get $i]
		}
		lappend sysnodes($sitename,$serverName) $val
	}
}

proc sysnodesPrint {sitename} {
	global sysnodes

	foreach s [array names sysnodes] {
		set s_list [split $s ","]
		set sname [lindex $s_list 0]
		if {[string compare $sname $sitename] == 0} {
			puts "sysnodes($s): $sysnodes($s)"
		}
	}
}


proc prefServerComplete {boxframe callerDialogBox} {

	set title [box $boxframe title]	
	set nrows [box $boxframe nrows]
	if {$nrows == 0} {
	   popupInfoBox $callerDialogBox \
    	    "Server $title does not have any nodes. Please complete info!" 700 $callerDialogBox
	   return
	}

	destroy $callerDialogBox
}

proc prefServer {siteName serverName callerDialogBox focusBox} {
  global activeWindow dialog sysnodes

  if {[string compare $serverName ""] == 0} {
	popupInfoBox $callerDialogBox "Server name not selected!!" 500 \
							$callerDialogBox
	return
  }
  busy_cursor
## Bring up the standard Dialog box ##
  set dialog(prefServerDialogBox) ".prefServer"
  set dbox [popupDialogBox $dialog(prefServerDialogBox) "Server Preference Dialog"]
  set activeWindow($dialog(prefServerDialogBox)) 1
  set dbox_top    [lindex $dbox 0]
  set dbox_bottom [lindex $dbox 1]


## TOP PART ##
 box $dbox_top.box -entrylabels \
        [list "Node_Name" [list "type" MENU_ENTRY "MOM" "NOMOM"]] \
	-title "$serverName" \
	-remCmd "queryTableDelete $siteName,\[boxGetCurselect $dbox_top.box 0\]" \
        -lboxlabels [list "Nodes" "Type"] -orient x \
        -lboxwidths [list 17 5] -lboxheights [list 10 10] \
        -grabBox $dialog(prefServerDialogBox) \
	-key [list 0 1]
  box $dbox_top.box -entryval 1 MOM

  set updButton [box $dbox_top.box updateButton]
  
  $updButton configure -text "query.." -command \
   "prefQuery $siteName \[boxGetCurselect $dbox_top.box 0\] \[boxGetCurselect $dbox_top.box 1\] $dialog(prefServerDialogBox) \[box $dbox_top.box entry 0\]"

## BOTTOM PART ##
  set cmdButtons \
  [buildCmdButtons $dbox_bottom {{{ok ok} {help help}}} x 2m 18 3]

  set cmdFrame  [lindex $cmdButtons 0]
  set cmdOk     [lindex $cmdButtons 1]
  set cmdHelp   [lindex $cmdButtons 2]

  $cmdOk configure \
    -command "sysnodesPut $siteName $serverName $dbox_top.box; destroy $dialog(prefServerDialogBox)"

  $cmdHelp configure -command {xpbs_help prefServer $dialog(prefServerDialogBox)}

  pack $dbox_top.box -side bottom -fill both -expand 1
  tkwait visibility $dialog(prefServerDialogBox)
  sysnodesGet $siteName $dbox_top.box
  remove_busy_cursor
  catch {tkwait window $dialog(prefServerDialogBox)}
  set activeWindow($dialog(prefServerDialogBox)) 0
  catch {grab $callerDialogBox}
  catch {focus $focusBox}
}

proc prefQuery {siteName nodeName nodeType callerDialogBox focusBox} {
  global prefQueryDialogBox activeWindow dialog queryTable
  if {[string compare $nodeName ""] == 0} {
	popupInfoBox $callerDialogBox "Node name not selected!!" 500 \
							$callerDialogBox
	return
  }

  if {[string compare $nodeType NOMOM] == 0} {
	popupInfoBox $callerDialogBox "Can't specify queries to send to a node not running MOM!!" 500 $callerDialogBox
	return
  }

  busy_cursor
## Bring up the standard Dialog box ##
  set dialog(prefQueryDialogBox) ".prefQuery"
  set dbox [popupDialogBox $dialog(prefQueryDialogBox) "Query Table Dialog"]
  set activeWindow($dialog(prefQueryDialogBox)) 1
  set dbox_top    [lindex $dbox 0]
  set dbox_bottom [lindex $dbox 1]


## TOP PART ##

  box $dbox_top.box -title "$nodeName" \
    -entrylabels [list "Query_Expr" "Display_Info" \
     [list "Display_Type" MENU_ENTRY TEXT SCALE]] \
     -lboxlabels [list "Queries" " " " "] -lboxwidths [list 20 20 20] \
	-lboxheights [list 10 10 10] -orient y \
	-key {0} -noUpdateButton 1 \
	-grabBox $dialog(prefQueryDialogBox)

  queryTableLoad $siteName $dbox_top.box

## BOTTOM PART ##
  set cmdButtons \
  [buildCmdButtons $dbox_bottom {{{ok ok} {help help}}} x 2m 18 3]

  set cmdFrame  [lindex $cmdButtons 0]
  set cmdOk     [lindex $cmdButtons 1]
  set cmdHelp   [lindex $cmdButtons 2]

  $cmdOk configure -command \
            "queryTableSave $siteName $dbox_top.box; destroy $dialog(prefQueryDialogBox)"
  $cmdHelp configure -command {xpbs_help prefQuery $dialog(prefQueryDialogBox)}

  pack $dbox_top.box -anchor nw -side left -padx 0 -pady 0
  tkwait visibility $dialog(prefQueryDialogBox)
  remove_busy_cursor
  catch {tkwait window $dialog(prefQueryDialogBox)}
  set activeWindow($dialog(prefQueryDialogBox)) 0
  catch {grab $callerDialogBox}
  catch {focus $focusBox}
}