520 lines
14 KiB
Tcl
520 lines
14 KiB
Tcl
|
#
|
||
|
# Copyright 2007 Petra Schilhard.
|
||
|
#
|
||
|
# Redistribution and use in source and binary forms, with or without
|
||
|
# modification, are permitted provided that the following conditions
|
||
|
# are met:
|
||
|
# 1. Redistributions of source code must retain the above copyright
|
||
|
# notice, this list of conditions and the following disclaimer.
|
||
|
# 2. Redistributions in binary form must reproduce the above copyright
|
||
|
# notice, this list of conditions and the following disclaimer in the
|
||
|
# documentation and/or other materials provided with the distribution.
|
||
|
#
|
||
|
# THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
||
|
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||
|
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||
|
# ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE
|
||
|
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||
|
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||
|
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||
|
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||
|
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||
|
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||
|
# SUCH DAMAGE.
|
||
|
#
|
||
|
|
||
|
|
||
|
.menubar.tools.experimental add command -label "Topology partitioning..." -underline 9 -command "dialog";
|
||
|
|
||
|
#****h* gpgui/weight_file
|
||
|
# NAME & FUNCTION
|
||
|
# weight_file -- holds the name of the file where the node weights are saved
|
||
|
#****
|
||
|
set WEIGHT_FILE "node_weights";
|
||
|
array set node_weights {};
|
||
|
|
||
|
#****f* gpgui.tcl/dialog
|
||
|
# NAME
|
||
|
# dialog
|
||
|
# SYNOPSIS
|
||
|
# dialog
|
||
|
# FUNCTION
|
||
|
# Procedure opens a new dialog with a text field for entering the number of parts
|
||
|
# in which the graph is to be partition, and with the node and link weights, which can be
|
||
|
# changed.
|
||
|
#****
|
||
|
proc dialog { } {
|
||
|
# package require BWidget
|
||
|
global partition_list
|
||
|
|
||
|
readNodeWeights;
|
||
|
|
||
|
set wi .popup
|
||
|
toplevel $wi
|
||
|
wm transient $wi .
|
||
|
wm resizable $wi 0 0
|
||
|
wm title $wi "Graph partition settings"
|
||
|
|
||
|
#number of partitions parameter
|
||
|
labelframe $wi.pnum -pady 0 -padx 4
|
||
|
frame $wi.pnum.l
|
||
|
label $wi.pnum.l.p -text "Number of partitions:" -anchor w
|
||
|
pack $wi.pnum.l.p -side top
|
||
|
frame $wi.pnum.e -borderwidth 2
|
||
|
entry $wi.pnum.e.p -bg white -width 10 -validate focus
|
||
|
pack $wi.pnum.e.p -side top
|
||
|
pack $wi.pnum.l $wi.pnum.e -side left
|
||
|
pack $wi.pnum -side top -anchor w -fill both
|
||
|
|
||
|
#buttons for detail node and link weights
|
||
|
labelframe $wi.weight -pady 4 -padx 4 -text "Weights"
|
||
|
frame $wi.weight.wl
|
||
|
label $wi.weight.l -text "Detailed:"
|
||
|
button $wi.weight.wl.lns -text "Link weights" -command \
|
||
|
"displayAllLinkWeights $wi"
|
||
|
|
||
|
frame $wi.weight.wn
|
||
|
button $wi.weight.wn.nds -text "Nodes weights" -command \
|
||
|
"displayAllNodeWeights $wi"
|
||
|
|
||
|
pack $wi.weight.l $wi.weight.wn.nds $wi.weight.wl.lns -side left
|
||
|
pack $wi.weight.wn $wi.weight.wl -side left
|
||
|
|
||
|
#pack $wi.custom -side top -anchor w -fill both
|
||
|
pack $wi.weight -side top -anchor w -fill x
|
||
|
|
||
|
#buttons Ok & Cancel
|
||
|
frame $wi.button -borderwidth 6
|
||
|
button $wi.button.ok -text "OK" -command \
|
||
|
"popupApply $wi"
|
||
|
focus $wi.button.ok
|
||
|
button $wi.button.cancel -text "Cancel" -command \
|
||
|
"destroy $wi"
|
||
|
pack $wi.button.cancel $wi.button.ok -side right
|
||
|
pack $wi.button -side bottom
|
||
|
|
||
|
return;
|
||
|
#grab .popup
|
||
|
}
|
||
|
|
||
|
#****f* gpgui.tcl/displayAllNodeWeights
|
||
|
# NAME
|
||
|
# displayAllNodeWeights -- display all nodes weight
|
||
|
# SYNOPSIS
|
||
|
# displayAllNodeWeights wi
|
||
|
# FUNCTION
|
||
|
# Procedure reads for each node its weight and writes it onto
|
||
|
# new window. The weight is first search in the node_list, and
|
||
|
# if not found, read from the default values.
|
||
|
# INPUTS
|
||
|
# * wi -- parent window id
|
||
|
#****
|
||
|
proc displayAllNodeWeights {wi} {
|
||
|
#package require BWidget
|
||
|
global node_list;
|
||
|
|
||
|
set nw .pop
|
||
|
toplevel $nw
|
||
|
wm transient $nw .
|
||
|
wm resizable $nw 0 0
|
||
|
wm title $nw "Node weights"
|
||
|
#weights settings
|
||
|
labelframe $nw.more -pady 4 -padx 4 -text "Node Weights"
|
||
|
frame $nw.more.weights
|
||
|
|
||
|
set i 1;
|
||
|
set j 1;
|
||
|
#weights from the file
|
||
|
foreach node $node_list {
|
||
|
#read for each node its weight
|
||
|
set wgt [getNodeWeight $node];
|
||
|
|
||
|
label $nw.more.weights.$node -text "$node" -anchor w
|
||
|
spinbox $nw.more.weights.w$node -bg white -width 3 \
|
||
|
-validate focus -invcmd "focusAndFlash %W"
|
||
|
$nw.more.weights.w$node insert 0 $wgt;
|
||
|
$nw.more.weights.w$node configure \
|
||
|
-vcmd {checkIntRange %P 0 100} \
|
||
|
-from 0 -to 100 -increment 1
|
||
|
|
||
|
grid $nw.more.weights.$node -row $i -column $j
|
||
|
grid $nw.more.weights.w$node -row $i -column [expr {int($j+1)}];
|
||
|
|
||
|
incr i;
|
||
|
if {[expr {$i % 10}] == 0} then {
|
||
|
set j [expr {$j + 2}];
|
||
|
set i 1;
|
||
|
}
|
||
|
}
|
||
|
pack $nw.more.weights -side top -anchor w
|
||
|
pack $nw.more -side top -anchor w -fill x
|
||
|
|
||
|
#buttons Apply & Cancel
|
||
|
frame $nw.button -borderwidth 6
|
||
|
button $nw.button.apply -text "Apply" -command "applyNodeWeights $nw"
|
||
|
focus $nw.button.apply
|
||
|
button $nw.button.cancel -text "Cancel" -command "destroy $nw"
|
||
|
pack $nw.button.cancel $nw.button.apply -side right
|
||
|
pack $nw.button -side bottom
|
||
|
}
|
||
|
|
||
|
|
||
|
#****f* gpgui.tcl/displayAllLinkWeights
|
||
|
# NAME
|
||
|
# displayAllLinkWeights -- display all link weights
|
||
|
# SYNOPSIS
|
||
|
# displayAllLinkWeights wi
|
||
|
# FUNCTION
|
||
|
# Procedure reads for each link its characteristics and writes them
|
||
|
# on the new window.
|
||
|
# INPUTS
|
||
|
# * wi -- parent window id
|
||
|
#****
|
||
|
proc displayAllLinkWeights {wi} {
|
||
|
# package require BWidget
|
||
|
global link_list;
|
||
|
|
||
|
set lw .pop
|
||
|
toplevel $lw
|
||
|
wm transient $lw .
|
||
|
wm resizable $lw 0 0
|
||
|
wm title $lw "Link weights"
|
||
|
#weights settings
|
||
|
labelframe $lw.more -pady 4 -padx 4 -text "Link Weights"
|
||
|
frame $lw.more.weights
|
||
|
|
||
|
set i 1;
|
||
|
set j 1;
|
||
|
foreach link $link_list {
|
||
|
|
||
|
label $lw.more.weights.$link -text "$link" -anchor w
|
||
|
#bandwidth
|
||
|
label $lw.more.weights.bl$link -text "Bandwidth:" -anchor w
|
||
|
spinbox $lw.more.weights.b$link -bg white -width 9 \
|
||
|
-validate focus -invcmd "focusAndFlash %W"
|
||
|
$lw.more.weights.b$link insert 0 [getLinkBandwidth $link]
|
||
|
$lw.more.weights.b$link configure \
|
||
|
-vcmd {checkIntRange %P 0 100000000} \
|
||
|
-from 0 -to 100000000 -increment 1000
|
||
|
#delay
|
||
|
label $lw.more.weights.dl$link -text "Delay:" -anchor w
|
||
|
spinbox $lw.more.weights.d$link -bg white -width 9 \
|
||
|
-validate focus -invcmd "focusAndFlash %W"
|
||
|
$lw.more.weights.d$link insert 0 [getLinkDelay $link]
|
||
|
$lw.more.weights.d$link configure \
|
||
|
-vcmd {checkIntRange %P 0 100000000} \
|
||
|
-from 0 -to 100000000 -increment 5
|
||
|
#BER
|
||
|
label $lw.more.weights.rl$link -text "BER (1/N):" -anchor w
|
||
|
spinbox $lw.more.weights.r$link -bg white -width 9 \
|
||
|
-validate focus -invcmd "focusAndFlash %W"
|
||
|
$lw.more.weights.r$link insert 0 [getLinkBER $link]
|
||
|
$lw.more.weights.r$link configure \
|
||
|
-vcmd {checkIntRange %P 0 10000000000000} \
|
||
|
-from 0 -to 10000000000000 -increment 1000
|
||
|
|
||
|
grid $lw.more.weights.$link -row $i -column 1;
|
||
|
grid $lw.more.weights.bl$link -row $i -column 2;
|
||
|
grid $lw.more.weights.b$link -row $i -column 3;
|
||
|
grid $lw.more.weights.dl$link -row $i -column 4;
|
||
|
grid $lw.more.weights.d$link -row $i -column 5;
|
||
|
grid $lw.more.weights.rl$link -row $i -column 6;
|
||
|
grid $lw.more.weights.r$link -row $i -column 7;
|
||
|
|
||
|
incr i;
|
||
|
}
|
||
|
pack $lw.more.weights -side top -anchor w
|
||
|
pack $lw.more -side top -anchor w -fill x
|
||
|
|
||
|
#buttons Apply & Cancel
|
||
|
frame $lw.button -borderwidth 6
|
||
|
button $lw.button.apply -text "Apply" -command \
|
||
|
"applyLinkWeights $lw"
|
||
|
focus $lw.button.apply
|
||
|
button $lw.button.cancel -text "Cancel" -command \
|
||
|
"destroy $lw"
|
||
|
pack $lw.button.cancel $lw.button.apply -side right
|
||
|
pack $lw.button -side bottom
|
||
|
}
|
||
|
|
||
|
#****f* gpgui.tcl/readNodeWeights
|
||
|
# NAME
|
||
|
# readNodeWeights -- read node weights
|
||
|
# SYNOPSIS
|
||
|
# readNodeWeights
|
||
|
# FUNCTION
|
||
|
# Procedure reads from a file node weights and saves them
|
||
|
# in array.
|
||
|
#****
|
||
|
proc readNodeWeights {} {
|
||
|
global node_weights;
|
||
|
|
||
|
#get the weight settings out of the file
|
||
|
set file [openWeightFile "r"];
|
||
|
# Boeing: attempt to recover with default weights
|
||
|
if { $file == "" } {
|
||
|
set i 0;
|
||
|
while { $i < 6 } {
|
||
|
set node_weights($i) $i
|
||
|
incr i
|
||
|
}
|
||
|
return
|
||
|
}
|
||
|
# end Boeing
|
||
|
|
||
|
set n [gets $file line];
|
||
|
|
||
|
set i 0;
|
||
|
while {[gets $file line] >= 0} {
|
||
|
set node_weights($i) $line;
|
||
|
incr i;
|
||
|
}
|
||
|
close $file;
|
||
|
|
||
|
if {$i != 6} then {
|
||
|
puts stdout "Bad file $file.";
|
||
|
return;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
#****f* gpgui.tcl/openWeightFile
|
||
|
# NAME
|
||
|
# openWeightFile -- open weight file
|
||
|
# SYNOPSIS
|
||
|
# openWeightFile $op
|
||
|
# FUNCTION
|
||
|
# Function opens a file specified in WEIGHT_FILE constant,
|
||
|
# and returns file descriptor.
|
||
|
# INPUTS
|
||
|
# * op -- operation "r" (for read) or "w" (for write)
|
||
|
# RESULT
|
||
|
# * fileId -- file id
|
||
|
#****
|
||
|
proc openWeightFile { op } {
|
||
|
global WEIGHT_FILE;
|
||
|
if {[catch {open $WEIGHT_FILE $op} fileId]} then {
|
||
|
puts stdout "graph_partitioning: Cannot open $WEIGHT_FILE.";
|
||
|
return;
|
||
|
}
|
||
|
return $fileId;
|
||
|
}
|
||
|
|
||
|
#****f* gpgui.tcl/applyNodeWeights
|
||
|
# NAME
|
||
|
# applyNodeWeights -- apply node weights
|
||
|
# SYNOPSIS
|
||
|
# applyNodeWeights nw
|
||
|
# FUNCTION
|
||
|
# Procedure reads for each node its weight from the
|
||
|
# window, and save it to the node_list.
|
||
|
# INPUTS
|
||
|
# * nw -- window id
|
||
|
#****
|
||
|
proc applyNodeWeights {nw} {
|
||
|
global node_list;
|
||
|
|
||
|
foreach node $node_list {
|
||
|
writeWeightToNode $node [$nw.more.weights.w$node get];
|
||
|
}
|
||
|
destroy $nw;
|
||
|
}
|
||
|
|
||
|
#****f* gpgui.tcl/applyLinkWeights
|
||
|
# NAME
|
||
|
# applyLinkWeights -- apply link weights
|
||
|
# SYNOPSIS
|
||
|
# applyLinkWeights lw
|
||
|
# FUNCTION
|
||
|
# Procedure reads for each link its characteristics from the
|
||
|
# window, and change theirs values in program.
|
||
|
# INPUTS
|
||
|
# * lw -- window id
|
||
|
#****
|
||
|
proc applyLinkWeights {lw} {
|
||
|
global link_list;
|
||
|
|
||
|
foreach link $link_list {
|
||
|
setLinkBandwidth $link [$lw.more.weights.b$link get];
|
||
|
setLinkDelay $link [$lw.more.weights.d$link get];
|
||
|
setLinkBER $link [$lw.more.weights.r$link get];
|
||
|
}
|
||
|
destroy $lw;
|
||
|
}
|
||
|
|
||
|
#****f* gpgui.tcl/writeWeightToNode
|
||
|
# NAME
|
||
|
# writeWeightToNode -- write weight to node
|
||
|
# SYNOPSIS
|
||
|
# writeWeightToNode $node $weight
|
||
|
# FUNCTION
|
||
|
# Procedure writes the weight to the node.
|
||
|
# INPUTS
|
||
|
# * node -- node id
|
||
|
# * weight -- weight of the node
|
||
|
#****
|
||
|
proc writeWeightToNode {node weight} {
|
||
|
global $node;
|
||
|
|
||
|
set p [lsearch [set $node] "weight *"];
|
||
|
if { $p >= 0 } {
|
||
|
set $node [lreplace [set $node] $p $p "weight $weight"];
|
||
|
} else {
|
||
|
set $node [linsert [set $node] end "weight $weight"];
|
||
|
}
|
||
|
}
|
||
|
|
||
|
|
||
|
#****f* gpgui.tcl/getNodeWeight
|
||
|
# NAME
|
||
|
# getNodeWeight -- get node weight
|
||
|
# SYNOPSIS
|
||
|
# getNodeWeight $node
|
||
|
# FUNCTION
|
||
|
# Function searches the node for the information
|
||
|
# about its weight. If the weight is found, it is
|
||
|
# returned, and if it is not found, an empty string is
|
||
|
# returned.
|
||
|
# INPUTS
|
||
|
# * node -- node id
|
||
|
# RESULT
|
||
|
# * wgt -- weight of the node
|
||
|
#****
|
||
|
proc getNodeWeight {node} {
|
||
|
global $node;
|
||
|
global node_weights;
|
||
|
|
||
|
set wgt [lindex [lsearch -inline [set $node] "weight *"] 1];
|
||
|
|
||
|
if {$wgt == ""} then {
|
||
|
switch -exact -- [nodeType $node] {
|
||
|
pc {
|
||
|
set wgt $node_weights(0);
|
||
|
}
|
||
|
host {
|
||
|
set wgt $node_weights(1);
|
||
|
}
|
||
|
router {
|
||
|
set wgt $node_weights(2);
|
||
|
}
|
||
|
lanswitch {
|
||
|
set wgt $node_weights(3);
|
||
|
}
|
||
|
hub {
|
||
|
set wgt $node_weights(4);
|
||
|
}
|
||
|
rj45 {
|
||
|
set wgt $node_weights(5);
|
||
|
}
|
||
|
default {
|
||
|
set wgt 0;
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
return $wgt;
|
||
|
}
|
||
|
|
||
|
#****f* gpgui.tcl/changeDefaultWeights
|
||
|
# NAME
|
||
|
# changeDefaultWeights -- change default weights
|
||
|
# SYNOPSIS
|
||
|
# changeDefaultWeights wi
|
||
|
# FUNCTION
|
||
|
# Procedure opens a file with node weights, and writes
|
||
|
# in it the weight for each group of nodes (pc,router,...).
|
||
|
# INPUTS
|
||
|
# * wi -- window id, parent window
|
||
|
#****
|
||
|
#save node weights to the file
|
||
|
proc changeDefaultWeights {wi} {
|
||
|
global node_weights;
|
||
|
set file [openWeightFile "w"];
|
||
|
|
||
|
set node_weights(0) [$wi.weight.pcs get];
|
||
|
set node_weights(1) [$wi.weight.hosts get];
|
||
|
set node_weights(2) [$wi.weight.routers get];
|
||
|
set node_weights(3) [$wi.weight.switchs get];
|
||
|
set node_weights(4) [$wi.weight.hubs get];
|
||
|
set node_weights(5) [$wi.weight.rj45s get];
|
||
|
|
||
|
debug $file [format "%d %d %d %d %d %d" $node_weights(0) $node_weights(1) $node_weights(2) $node_weights(3) $]node_weights(4) $node_weights(5);
|
||
|
close $file;
|
||
|
destroy $wi;
|
||
|
}
|
||
|
|
||
|
|
||
|
#****f* gpgui.tcl/popupApply
|
||
|
# NAME
|
||
|
# popupApply -- popup apply
|
||
|
# SYNOPSIS
|
||
|
# popupApply wi
|
||
|
# FUNCTION
|
||
|
# Procedure saves for each node its weight in node_list.
|
||
|
# INPUTS
|
||
|
# * wi -- window id
|
||
|
#****
|
||
|
proc popupApply { wi } {
|
||
|
global node_list;
|
||
|
set partNum [$wi.pnum.e.p get]
|
||
|
|
||
|
foreach node $node_list {
|
||
|
#read for each node its weight
|
||
|
set wgt [getNodeWeight $node];
|
||
|
#write it to the node_list
|
||
|
writeWeightToNode $node $wgt
|
||
|
}
|
||
|
|
||
|
destroy $wi
|
||
|
#graphPartition $partNum;
|
||
|
test_partitioning $partNum;
|
||
|
}
|
||
|
|
||
|
#****f* gpgui.tcl/displayErrorMessage
|
||
|
# NAME
|
||
|
# displayErrorMessage -- display error message
|
||
|
# SYNOPSIS
|
||
|
# displayErrorMessage $message
|
||
|
# FUNCTION
|
||
|
# Procedure writes a message to the screen as a popup dialog.
|
||
|
# INPUTS
|
||
|
# * message -- message to be writen
|
||
|
#****
|
||
|
proc displayErrorMessage { message } {
|
||
|
tk_dialog .dialog1 "Graph partitioning" $message info 0 Dismiss;
|
||
|
}
|
||
|
|
||
|
#****f* gpgui.tcl/getLinkWeight
|
||
|
# NAME
|
||
|
# getLinkWeight -- calculate link weight
|
||
|
# SYNOPSIS
|
||
|
# getLinkWeight $link
|
||
|
# FUNCTION
|
||
|
# Function calculates for each link its weight from its characteristics.
|
||
|
# INPUTS
|
||
|
# * link -- link id
|
||
|
# RESULT
|
||
|
# * weight -- weight of the link
|
||
|
#****
|
||
|
proc getLinkWeight {link} {
|
||
|
set bndw [getLinkBandwidth $link];
|
||
|
set dly [getLinkDelay $link];
|
||
|
set ber [getLinkBER $link];
|
||
|
set dup [getLinkDup $link];
|
||
|
set weight [expr {$bndw}];
|
||
|
|
||
|
return $weight;
|
||
|
}
|
||
|
|
||
|
|
||
|
proc test_partitioning {partNum} {
|
||
|
|
||
|
# foreach n {2 4 8 16 32 64 128 256 512} {
|
||
|
# if {$n > $partNum} then {
|
||
|
# break;
|
||
|
# }
|
||
|
# for {set i 0} {$i < 3} {incr i} {
|
||
|
# puts "i=$i, n=$n";
|
||
|
graphPartition $partNum;
|
||
|
# }
|
||
|
# }
|
||
|
}
|