1 # mob-graph.tcl --
2 #
3 # Implemetation of the media object graph.
4 #
5 # Copyright (c) 1996-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/indiva/imgr/mob-graph.tcl,v 1.12 2002/07/28 18:16:38 weitsang Exp $
32
33 import MashStack
34 import MashHeap
35 import MashGraph
36 import MobEdge
37 import MobHub
38 import Mob
39
40 #--------------------------------------------------------------------------
41 # Class:
42 # MobGraph
43 #
44 # Description:
45 # MobGraph maintains inter-connection information about individual
46 # mobs.
47 #--------------------------------------------------------------------------
48 Class MobGraph -superclass MashGraph
49
50 #--------------------------------------------------------------------------
51 # Method:
52 # MobGraph init
53 # Description:
54 # Create a MobGraph by loading all mobs rooted at $root_dir.
55 #--------------------------------------------------------------------------
56 MobGraph instproc init { root_dir } {
57 $self next
58
59 set stack [new MashStack]
60 $stack push $root_dir
61
62 while {![$stack is_empty]} {
63
64 # Do a DFS on the directory tree.
65 set curr_mob_path [$stack pop]
66 if {[file type $curr_mob_path] == "link"} {
67 # we ignore links.
68 } else {
69 if [file isdir $curr_mob_path] {
70 if {![catch {glob $curr_mob_path/*} submob_paths]} {
71 foreach submob_path $submob_paths {
72 $stack push $submob_path
73 }
74 }
75 }
76
77 # For each mob, find out the type of the mob, then
78 # construct the appropriate node. Also read the
79 # info file to find out interconnection information.
80 set mob [Mob create_new $curr_mob_path]
81 if {$mob != ""} {
82 if {![$mob is_persistent]} {
83 file delete $curr_mob_path
84 delete $mob
85 } else {
86 $mob read_info_file
87 $self add_node $curr_mob_path $mob
88 }
89 }
90 }
91 }
92 delete $stack
93
94 # Now add in the edges, and parent-child relationship.
95 foreach mob_name [$self get_all_nodes] {
96 set mob [$self get_node $mob_name]
97 # add edges
98 foreach name [$mob get_attribute "to"] {
99 set abs_name [file_normalize [file join $mob_name .. $name]]
100 # each of the name can be a wild card expression. We create
101 # a dummy node to represent the group of nodes named by the
102 # expression.
103 set namelist [glob -nocomplain $abs_name]
104 if {$namelist == ""} {
105 #puts stderr "ERROR: Invalid connection from [$mob name] to $name"
106 } elseif {[llength $namelist] == 1} {
107 set to_name $namelist
108 if {[$self has_node $to_name]} {
109 set to_mob [$self get_node $to_name]
110 $self add_edge $mob_name $to_name [new MobEdge $mob $to_mob [$mob action]]
111 } else {
112 #puts stderr "ERROR: Invalid connection from [$mob name] to $to_name"
113 }
114 } else {
115 if {![$self has_hub $abs_name]} {
116 set hub [new MobHub]
117 set name [$hub name]
118 $self add_hub $abs_name $name
119 $self add_node $name $hub
120 foreach to_name $namelist {
121 if {[$self has_node $to_name]} {
122 set to_mob [$self get_node $to_name]
123 $self add_edge $name $to_name [new MobEdge $hub $to_mob none]
124 } else {
125 #puts stderr "ERROR: Invalid connection from [$mob name] to $to_name"
126 }
127 }
128 } else {
129 set hub [$self get_node [$self get_hub $abs_name]]
130 }
131 $self add_edge $mob_name [$hub name] [new MobEdge $mob $hub [$mob action]]
132 }
133 }
134 if [string match *.cap/*.in $mob_name] {
135 foreach name [$self get_nodes *.ses] {
136 set ses [$self get_node $name]
137 $self add_edge $mob_name $name [new MobEdge $mob $ses "encode"]
138 }
139 }
140 # add parent-child
141 set parent_name [file dirname $mob_name]
142 if {[$self has_node $parent_name]} {
143 set parent_mob [$self get_node $parent_name]
144 $mob set_parent $parent_mob
145 $parent_mob add_child $mob
146 }
147 }
148 }
149
150
151 #--------------------------------------------------------------------------
152 # Method:
153 # MobGraph add_conference
154 # Description:
155 # Add a new conference into the graph.
156 #--------------------------------------------------------------------------
157 MobGraph instproc add_conference { mob } {
158 $self add_node [$mob name] $mob
159 }
160
161
162 #--------------------------------------------------------------------------
163 # Method:
164 # MobGraph add_session
165 # Description:
166 # Add a new session $mob into the graph. The follow edges are added:-
167 # - an edge to the conference it belongs to
168 # - for each capture card, for each input port, an edge from the port to
169 # the session. (FIXME: we can reduce the number of edges here by
170 # connecting port -> card -> session)
171 #--------------------------------------------------------------------------
172 MobGraph instproc add_session { mob } {
173 $self add_node [$mob name] $mob
174
175 # Add edge to conference, and parent-child link too.
176 set name [$mob name]
177 set parent_name [file dirname $name]
178 if {[$self has_node $parent_name]} {
179 set parent_mob [$self get_node $parent_name]
180 $mob set_parent $parent_mob
181 $parent_mob add_child $mob
182
183 set edge [new MobEdge $mob $parent_mob]
184 $self add_edge $name $parent_name $edge
185 }
186
187 # Add edge from each input port to session.
188 foreach inport_name [$self get_nodes *.cap/*.in] {
189 set inport_mob [$self get_node $inport_name]
190 set edge [new MobEdge $inport_mob $mob]
191 $edge action "encode"
192 $self add_edge $inport_name $name $edge
193 }
194 }
195
196
197 #--------------------------------------------------------------------------
198 # Method:
199 # MobGraph add_stream
200 # Description:
201 # Add a new stream $mob into the graph. The follow edges are added:-
202 # - an edge to the session it belongs to.
203 #--------------------------------------------------------------------------
204 MobGraph instproc add_stream { mob } {
205 #MashLog info "add_stream: [short_name [$mob name]]"
206 $self add_node [$mob name] $mob
207
208 # Add edge to conference, and parent-child link too.
209 set name [$mob name]
210 set parent_name [file dirname $name]
211 if {[$self has_node $parent_name]} {
212 set parent_mob [$self get_node $parent_name]
213 $mob set_parent $parent_mob
214 $parent_mob add_child $mob
215
216 set edge [new MobEdge $parent_mob $mob]
217 $self add_edge $parent_name $name $edge
218 }
219 }
220
221
222 #--------------------------------------------------------------------------
223 # Method:
224 # MobGraph find_path
225 # Description:
226 # Given the name of a src and a dest, find the shortest path between them.
227 #--------------------------------------------------------------------------
228 MobGraph instproc find_path { src dest } {
229 set h [new MashHeap]
230 set MAXINT [expr {(2 << 30)-1}]
231
232 set dist($src) 0
233 $h insert $src 0
234
235 foreach name [$self get_nodes *] {
236 if {$name != $src} {
237 set dist($name) $MAXINT
238 $h insert $name $dist($name)
239 }
240 }
241
242 while {![$h is_empty]} {
243 set curr [$h delete_min]
244 foreach neighbor [$self get_out_neighbors $curr] {
245 if [$h has $neighbor] {
246 #if {$dist($curr) + "cost of $curr->$name" < $dist($name)}
247 if {$dist($curr) + 1 < $dist($neighbor)} {
248 set dist($neighbor) [expr {$dist($curr) + 1}]
249 $h decrease_key $neighbor $dist($neighbor)
250 set parent($neighbor) $curr
251 }
252 }
253 }
254 }
255
256 set path $dest
257 set curr $dest
258 while {$curr != $src} {
259 if {![info exists parent($curr)]} {
260 return ""
261 }
262 set curr $parent($curr)
263 set path "$curr $path"
264 }
265 return $path
266 }
267
268
269 #--------------------------------------------------------------------------
270 # Method:
271 # MobGraph find_paths
272 # Description:
273 # Given the name of a src and a dest, find a set of shortest path
274 # between them. Result is given as an instance of MashGraph G, paths
275 # stored in G are "reverse path" (from dest to src).
276 #--------------------------------------------------------------------------
277 MobGraph instproc find_paths { src dest } {
278 set e [$self get_virtual_edge $src $dest]
279 if {$e != ""} {
280 set g [new MashGraph]
281 $g add_node $src
282 $g add_node $dest
283 $g add_edge $dest $src $e; # this is a reverse path
284 $self add_edge $src $dest $e
285 return $g
286 }
287
288 set h [new MashHeap]
289 set g [new MashGraph]
290 set MAXINT [expr {(2 << 30)-1}]
291
292 #DEBUG
293 #puts "finding paths from $src to $dest"
294
295 set dist($src) 0
296 $h insert $src 0
297 $g add_node $src [$self get_node $src]
298
299 foreach name [$self get_nodes *] {
300 if {$name != $src} {
301 set dist($name) $MAXINT
302 $h insert $name $dist($name)
303 $g add_node $name [$self get_node $name]
304 }
305 }
306
307 while {![$h is_empty]} {
308 set curr [$h delete_min]
309 foreach neighbor [$self get_out_neighbors $curr] {
310 if [$h has $neighbor] {
311 set e [$self get_edge $curr $neighbor]
312 if {$dist($curr) + [$e cost] < $dist($neighbor)} {
313 set dist($neighbor) [expr {$dist($curr) + [$e cost]}]
314 $h decrease_key $neighbor $dist($neighbor)
315 $g del_out_edges $neighbor
316 $g add_edge $neighbor $curr 0
317 } elseif {$dist($curr) + [$e cost] == $dist($neighbor)} {
318 $g add_edge $neighbor $curr 0
319 }
320 }
321 }
322 }
323 delete $h
324
325 #$g print
326
327 # We should only keep edges in $g that are on the paths from dest
328 # to $src. To remove the other edges, we traverse from dest to src,
329 # and mark the edges on the paths. Then, we go through all the edges
330 # in $g and remove unmarked edges.
331
332 set s [new MashStack]
333 $s push $dest
334 while {![$s is_empty]} {
335 set curr [$s pop]
336 foreach n [$g get_out_neighbors $curr] {
337 $s push $n
338 $g set_edge $curr $n 1
339 #DEBUG
340 #puts "Adding edge in Graph: [short_name $curr] [short_name $n]"
341
342 }
343 }
344 delete $s
345
346 foreach pair [$g get_all_edges] {
347 foreach {u v} $pair {
348 set value [ $g get_edge $u $v ]
349 if {$value != 1} {
350 #DEBUG
351 #puts "Deleting edge in Graph: [short_name $u] [short_name $v]"
352 $g del_edge $u $v
353 }
354 }
355 }
356 #$g print
357
358 foreach n [$g get_all_nodes] {
359 if {[$g get_out_neighbors $n] == "" && $n != $src} {
360 #DEBUG
361 #puts "Deleting node in Graph: [short_name $n]"
362 $g del_node $n
363 }
364 }
365
366 #$g print
367 return $g
368 }
369
370
371 #--------------------------------------------------------------------------
372 # Method:
373 # MobGraph find
374 # Description:
375 # Return a list of mobs in the graph that matches the given attribute
376 # names and values.
377 #--------------------------------------------------------------------------
378 MobGraph instproc find { args } {
379 set result {}
380 foreach mob_name [$self get_all_nodes] {
381 set mob [$self get_node $mob_name]
382 set match 1
383 foreach {attr value} $args {
384 if {[$mob get_attribute $attr] != $value} {
385 set match 0
386 break
387 }
388 }
389 if {$match} {
390 lappend result $mob_name
391 }
392 }
393 return $result
394 }
395
396
397 #--------------------------------------------------------------------------
398 # Method:
399 # MobGraph has_hub
400 # MobGraph get_hub
401 # MobGraph add_hub
402 # Description:
403 # has_hub returns 1 iff a hub that represents the given expression exists.
404 # get_hub returns the name of the hub that represents the given expression.
405 # add_hub adds a hub, and del_hub deletes the given hub. is_hub tests if
406 # a node is a hub.
407 #--------------------------------------------------------------------------
408 MobGraph instproc has_hub { name } {
409 $self instvar hub_
410 return [info exists hub_($name)]
411 }
412 MobGraph instproc get_hub { name } {
413 $self instvar hub_
414 if {[$self has_hub $name]} {
415 return $hub_($name)
416 } else {
417 error "no such hub $name"
418 }
419 }
420 MobGraph instproc add_hub { exp hub } {
421 $self instvar hub_
422 set hub_($exp) $hub
423 }
424 MobGraph instproc del_hub { exp } {
425 $self instvar hub_
426 if {[$self has_hub $name]} {
427 unset hub_($name)
428 } else {
429 error "no such hub $name"
430 }
431 }
432 MobGraph instproc is_hub { name } {
433 return [MobHub is_hub $name]
434 }
435
436 #MobGraph instproc get_edge { src dest } {
437 # if [catch {$self next $src $dest} e] {
438 # set e [$self get_virtual_edge $src $dest]
439 # $self add_edge $src $dest $e
440 # }
441 # return $e
442 #}
443
444 MobGraph instproc get_virtual_edge { src dest } {
445 MashLog info "creating dynamic edges [short_name $src to $dest]"
446 set s [$self get_node $src]
447 set d [$self get_node $dest]
448 if {$d == ""} {
449 error "no $d"
450 }
451 set e [$s get_virtual_edge_to $d]
452 if {$e != ""} {
453 return $e
454 }
455 }
456
457 proc short_name {args} {
458 set result ""
459 set root [Application get_option root]
460 foreach n $args {
461 regsub -all $root $n "" newname
462 append result "$newname "
463 }
464 return [string trim $result]
465 }
466
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.