Correct PPTP server firewall rules chain.
[tomato/davidwu.git] / release / src / router / usbmodeswitch / jim / tree.tcl
blob01fc16704eae9bc2c666346a35354179631f82e8
1 # Conceptually compatible with tcllib ::struct::tree
2 # but uses an object based interface.
3 # To mimic tcllib, do:
4 # rename [tree] mytree
6 package require oo
8 # set pt [tree]
10 # Create a tree
11 # This automatically creates a node named "root"
13 # $pt destroy
15 # Destroy the tree and all it's nodes
17 # $pt set <nodename> <key> <value>
19 # Set the value for the given key
21 # $pt lappend <nodename> <key> <value> ...
23 # Append to the (list) value(s) for the given key, or set if not yet set
25 # $pt keyexists <nodename> <key>
27 # Returns 1 if the given key exists
29 # $pt get <nodename> <key>
31 # Returns the value associated with the given key
33 # $pt getall <nodename>
35 # Returns the entire attribute dictionary associated with the given key
37 # $pt depth <nodename>
39 # Returns the depth of the given node. The depth of "root" is 0.
41 # $pt parent <nodename>
43 # Returns the name of the parent node, or "" for the root node.
45 # $pt numchildren <nodename>
47 # Returns the number of child nodes.
49 # $pt children <nodename>
51 # Returns a list of the child nodes.
53 # $pt next <nodename>
55 # Returns the next sibling node, or "" if none.
57 # $pt insert <nodename> ?index?
59 # Add a new child node to the given node.
60 # THe default index is "end"
61 # Returns the name of the newly added node
63 # $pt walk <nodename> dfs|bfs {actionvar nodevar} <code>
65 # Walks the tree starting from the given node, either breadth first (bfs)
66 # depth first (dfs).
67 # The value "enter" or "exit" is stored in variable $actionvar
68 # The name of each node is stored in $nodevar.
69 # The script $code is evaluated twice for each node, on entry and exit.
71 # $pt dump
73 # Dumps the tree contents to stdout
75 #------------------------------------------
76 # Internal implementation.
77 # The tree class has 4 instance variables.
78 # - tree is a dictionary. key=node, value=node value dictionary
79 # - parent is a dictionary. key=node, value=parent of this node
80 # - children is a dictionary. key=node, value=list of child nodes for this node
81 # - nodeid is an integer which increments to give each node a unique id
83 # Construct a tree with a single root node with no parent and no children
84 class tree {
85 tree {root {}}
86 parents {root {}}
87 children {root {}}
88 nodeid 0
91 # Simply walk up the tree to get the depth
92 tree method depth {node} {
93 set depth 0
94 while {$node ne "root"} {
95 incr depth
96 set node [dict get $parents $node]
98 return $depth
101 tree method parent {node} {
102 dict get $parents $node
105 tree method children {node} {
106 dict get $children $node
109 tree method numchildren {node} {
110 llength [dict get $children $node]
113 tree method next {node} {
114 # My siblings are my parents children
115 set siblings [dict get $children [dict get $parents $node]]
116 # Find me
117 set i [lsearch $siblings $node]
118 incr i
119 lindex $siblings $i
122 tree method set {node key value} {
123 dict set tree $node $key $value
124 return $value
127 tree method get {node key} {
128 dict get $tree $node $key
131 tree method keyexists {node key} {
132 dict exists $tree $node $key
135 tree method getall {node} {
136 dict get $tree $node
139 tree method insert {node {index end}} {
141 # Make a new node and add it to the tree
142 set childname node[incr nodeid]
143 dict set tree $childname {}
145 # The new node has no children
146 dict set children $childname {}
148 # Set the parent
149 dict set parents $childname $node
151 # And add it as a child
152 set nodes [dict get $children $node]
153 dict set children $node [linsert $nodes $index $childname]
155 return $childname
158 tree method lappend {node key args} {
159 if {[dict exists $tree $node $key]} {
160 set result [dict get $tree $node $key]
162 lappend result {*}$args
163 dict set tree $node $key $result
164 return $result
167 # $tree walk node bfs|dfs {action loopvar} <code>
169 tree method walk {node type vars code} {
170 # set up vars
171 lassign $vars actionvar namevar
173 set n $node
175 if {$type ne "child"} {
176 upvar 2 $namevar name $actionvar action
178 # Enter this node
179 set name $node
180 set action enter
182 uplevel 2 $code
185 if {$type eq "dfs"} {
186 # Depth-first so do the children
187 foreach child [$self children $n] {
188 uplevel 2 [list $self walk $child $type $vars $code]
190 } elseif {$type ne "none"} {
191 # Breadth-first so do the children to one level only
192 foreach child [$self children $n] {
193 uplevel 2 [list $self walk $child none $vars $code]
196 # Now our grandchildren
197 foreach child [$self children $n] {
198 uplevel 2 [list $self walk $child child $vars $code]
202 if {$type ne "child"} {
203 # Exit this node
204 set name $node
205 set action exit
207 uplevel 2 $code
211 tree method dump {} {
212 $self walk root dfs {action n} {
213 set indent [string repeat " " [$self depth $n]]
214 if {$action eq "enter"} {
215 puts "$indent$n ([$self getall $n])"
218 puts ""