1#!%TCLSH%
2
3#
4# Example script to display graphical representation of equipment
5# configuration.
6#
7# Usage:
8#	doteq < eqvirt.eq | gv -
9#	analyze ... | doteq > /tmp/eq.ps
10#
11# History
12#   2007/07/16 : pda : design
13#   2012/04/26 : pda : remove comments in source file
14#
15
16proc dot-init {} {
17    global dottxt
18
19    set dottxt ""
20}
21
22proc dot-kw {lattrval} {
23    global dottxt
24
25    foreach {a v} $lattrval {
26	append dottxt "$a = $v ;\n"
27    }
28}
29
30proc dot-add-node {node lattrval} {
31    global dottxt
32
33    if {[string equal $node ""]} then {
34	append dottxt "node"
35    } else {
36	append dottxt "\"$node\""
37    }
38
39    if {[llength lattrval] > 0} then {
40	set lattr {}
41	foreach {a v} $lattrval {
42	    lappend lattr "$a=$v"
43	}
44	set attr [join $lattr ", "]
45	append dottxt " \[$attr\]"
46    }
47
48    append dottxt ";\n"
49}
50
51proc dot-add-link {n1 n2} {
52    global dottxt
53
54    append dottxt "\"$n1\" -- \"$n2\" ;\n"
55}
56
57proc dot-get {} {
58    global dottxt
59
60    return $dottxt
61}
62
63proc prologue {} {
64    dot-init
65    dot-kw {
66		center		true
67		size		\"7.5,10.5\"
68		fontname	Helvetica
69		fontsize	10
70		ratio		compress
71	    }
72    dot-add-node "" {
73			fontname	Helvetica
74			fontsize	10
75		}
76}
77
78proc epilogue {} {
79    return
80}
81
82proc title {eq type model} {
83    dot-kw [list "label" "\"$eq ($type / $model)\""]
84}
85
86proc node {name shape label {sup {}}} {
87    dot-add-node $name [concat \
88			    [list shape $shape label "\"$label\""] \
89			    $sup
90			]
91}
92
93proc main {argv0 argv} {
94    dot-init
95
96    prologue
97
98    while {[gets stdin l] >= 0} {
99	regsub {[[:space:]]*#.*} $l {} l
100	switch [lindex $l 0] {
101	    eq {
102		array set t $l
103		append r [title $t(eq) $t(type) $t(model)]
104		array unset t
105	    }
106	    node {
107		set node [lindex $l 1]
108		set type [lindex $l 3]
109		switch $type {
110		    L1 {
111			array set t $l
112			set iface $t(name)
113			set link  $t(link)
114			append r [node $node "rectangle" "$iface\\n$link"]
115			array unset t
116		    }
117		    L2 {
118			array set t $l
119			set vlan $t(vlan)
120			append r [node $node "diamond" "$vlan"]
121			array unset t
122		    }
123		    L2pat {
124			append r [node $node "Mdiamond" ""]
125		    }
126		    bridge {
127			append r [node $node "box" "" {regular true}]
128		    }
129		    brpat {
130			append r [node $node "Msquare" ""]
131		    }
132		    L3 {
133			set ip [lindex $l 7]
134			append r [node $node "ellipse" "$ip"]
135		    }
136		    router {
137			set instance [lindex $l 7]
138			append r [node $node "circle" "$instance"]
139		    }
140		}
141	    }
142	    link {
143		set l1 [lindex $l 1]
144		set l2 [lindex $l 2]
145		dot-add-link $l1 $l2
146	    }
147	}
148    }
149
150    epilogue
151
152    set tmp "/tmp/doteq.[pid]"
153    set fd [open $tmp "w"]
154    puts $fd "graph G \{\n[dot-get] \}"
155    close $fd
156
157    set fd [open "|neato -Tps < $tmp" "r"]
158    set ps [read $fd]
159    close $fd
160
161    file delete $tmp
162
163    puts stdout $ps
164
165    return 0
166}
167
168exit [main $argv0 $argv]
169