1 # mob.tcl --
2 #
3 # Base class for a media object.
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.tcl,v 1.13 2002/08/06 23:46:06 weitsang Exp $
32
33 #-------------------------------------------------------------------
34 # Class:
35 # Mob
36 # Description:
37 #
38 # A Mob, or Media Object, is the basic abstraction for hardwares
39 # and media data in a distributed media environment.
40 #
41 # Mob objects reside on the Indiva manager, and not in the
42 # applications. The applications only have access to the name
43 # of the mobs.
44 #
45 # Mobs are organized into hierarchical name space. The Indiva
46 # Manager maintains the name space as a tree, it also maintain a
47 # graph of mobs that represents the current environment.
48 #
49 # Members:
50 # attributes_ --
51 # an array of attributes, indexed by keys.
52 #
53 # ext_ --
54 # an array, which is a map from extension to class type.
55 #
56 # parent_ --
57 # parent mob of this mob. "" if no parent.
58 #
59 # destroy_callbacks_ --
60 # A list of methods to eval when this mob is destroy.
61 #
62 # See Also:
63 # MobGraph
64 #-------------------------------------------------------------------
65 Class Mob
66
67 #-------------------------------------------------------------------
68 # Method:
69 # Mob init
70 # Description:
71 # Create a new mob with given $name and parameters $args.
72 #-------------------------------------------------------------------
73 Mob instproc init {name args} {
74 $self instvar name_ parent_
75 set ext [[$self info class] get_ext]
76 if {![string match *$ext $name]} {
77 # if the given name does not include an extension, add it
78 # automatically.
79 append name $ext
80 }
81 set name_ $name
82 set parent_ ""
83 if {$args != ""} {
84 eval $self parse_args $args
85 }
86
87 $self instvar destroy_callbacks_
88 set destroy_callbacks_ {}
89
90 $self instvar path_ flow_
91 set path_ $name_
92 set flow_ ""
93 }
94
95
96 #-------------------------------------------------------------------
97 # Method:
98 # Mob destroy
99 # Description:
100 # Delete the mob. All destroy callbacks associated with this mob
101 # is evaluated.
102 #-------------------------------------------------------------------
103 Mob instproc destroy { } {
104 $self instvar destroy_callbacks_ name_
105 set cbs $destroy_callbacks_
106 foreach cb $cbs {
107 eval $cb
108 }
109 $self del_info_file
110 $self next
111 }
112
113
114 #-------------------------------------------------------------------
115 # Method:
116 # Mob name
117 # Mob get_name
118 # Description:
119 # Return the name of the mob. get_name is deprecated. Use name
120 # instead.
121 #-------------------------------------------------------------------
122 Mob public name {} {
123 $self instvar name_
124 return $name_
125 }
126 Mob public get_name {} {
127 uplevel {puts "$class $proc"}
128 puts stderr "get_name is deprecated. Use name instead"
129 $self instvar name_
130 return $name_
131 }
132
133
134 #-------------------------------------------------------------------
135 # Method:
136 # Mob parse_args
137 # Description:
138 # Turn list of parameters given to constructor into object
139 # attributes.
140 #-------------------------------------------------------------------
141 Mob private parse_args {args} {
142 $self instvar attributes_
143 set len [llength $args]
144 set i 0
145 set curr [lindex $args $i]
146 while {$i < $len} {
147 set key [string range $curr 1 end]
148 incr i
149 set curr [lindex $args $i]
150 if {[string index $curr 0] != "-"} {
151 set val $curr
152 incr i
153 if {$i < $len} {
154 set curr [lindex $args $i]
155 if {[string index $curr 0] != "-"} {
156 error "Malformed args: a value without key '$curr' is detected.\nProper format is -<key> \[value\] -<key> \[value\]"
157 }
158 }
159 } else {
160 # it is a boolean key.
161 set val 1
162 }
163 set attributes_($key) $val
164 }
165 }
166
167
168 #-------------------------------------------------------------------
169 # Methods:
170 # Mob read_info_file
171 # Mob open_info_file
172 # Mob write_info_file
173 # Mob del_info_file
174 # Description:
175 # open_info_file opens the metadata associated with this mob with
176 # the given attribute (read,write etc). read_info_file reads the
177 # metadata and initialize the attributes of the object.
178 # write_info_file dumps the attributes of this object onto disk,
179 # and del_info_file called [file delete ..] to delete the file.
180 # Subclasses that wish to use a different mechanism to maintain
181 # the metadata can override these methods.
182 # Arguments:
183 # attr -- Argument to tcl's open when calling open_info_file.
184 #-------------------------------------------------------------------
185 Mob instproc read_info_file {} {
186 $self instvar attributes_
187 if {[catch {$self open_info_file r} f]} {
188 puts stderr "WARNING: unable to read [$self name]"
189 } else {
190 set list [read $f]
191 foreach {element attributes data} $list {
192 foreach {attrname attrvalue} $attributes {
193 set attributes_($attrname) [string trim $attrvalue]
194 }
195 }
196 }
197 close $f
198 }
199
200 Mob instproc open_info_file {attr} {
201 $self instvar name_
202 return [open $name_ $attr]
203 }
204
205 Mob instproc write_info_file {} {
206 $self instvar attributes_
207 set f [$self open_info_file w]
208 puts $f [$self get_type]
209 puts $f "{"
210 foreach attrname [array names attributes_] {
211 puts $f "$attrname { $attributes_($attrname) }"
212 }
213 puts $f "}"
214
215 # For future expansion. In case we need more complicated structure
216 # to describe a mob other than (key, value) pair.
217 puts $f "{\n}"
218 close $f
219 }
220
221 Mob private del_info_file {} {
222 $self instvar name_
223 return [file delete $name_]
224 }
225
226
227 #-------------------------------------------------------------------
228 # Methods:
229 # Mob get_attribute
230 # Mob set_attribute
231 # Mob get_attributes
232 # Mob get_local_attribute
233 # Description:
234 # get_attribute and set_attribute retrieve and update the attributes
235 # of this object. get_attributes returns the list of all attributes
236 # as a tcl list of {key value} pair. If the attribute is not found
237 # at this object. The parent objects (not superclass, but parent in
238 # the namespace hierarchy) are search for the attribute.
239 # get_local_attribute behave like get_attribute, except that it does
240 # search parents for missing attribute.
241 #-------------------------------------------------------------------
242 Mob public get_attributes {} {
243 $self instvar attributes_
244 set info "class {[$self get_type]}"
245 foreach attrname [array names attributes_] {
246 append info "\n$attrname {[string trim $attributes_($attrname)]}"
247 }
248 return $info
249 }
250
251 Mob instproc set_attribute {attrname value} {
252 $self instvar attributes_
253 set attributes_($attrname) [string trim $value]
254 }
255
256 Mob instproc get_attribute {attrname} {
257 $self instvar attributes_
258 if {$attrname == "class"} {
259 return [$self get_type]
260 }
261 if [info exists attributes_($attrname)] {
262 return $attributes_($attrname)
263 } else {
264 set parent [$self get_parent]
265 if {$parent != ""} {
266 return [$parent get_attribute $attrname]
267 } else {
268 return ""
269 }
270 }
271 }
272
273 Mob instproc get_local_attribute {attrname} {
274 $self instvar attributes_
275 if {$attrname == "class"} {
276 return [$self get_type]
277 }
278 if [info exists attributes_($attrname)] {
279 return $attributes_($attrname)
280 } else {
281 return ""
282 }
283 }
284
285
286 #-------------------------------------------------------------------
287 # Methods:
288 # Mob get_type
289 # Description:
290 # Sub-class should redefine this to return the type of the object.
291 #-------------------------------------------------------------------
292 Mob private get_type {} {
293 error "ERROR: 'get_type' not defined in [$self info class]."
294 }
295
296
297 #-------------------------------------------------------------------
298 # Methods:
299 # Mob path
300 # Description:
301 # Set and get a path associated with a mob.
302 #-------------------------------------------------------------------
303 Mob instproc path {args} {
304 $self instvar path_
305 if {$args == ""} {
306 return $path_
307 } else {
308 eval set path_ $args
309 }
310 }
311
312
313 #-------------------------------------------------------------------
314 # Methods:
315 # Mob flow
316 # Description:
317 # Set and get a flow associated with a mob.
318 #-------------------------------------------------------------------
319 Mob instproc flow {args} {
320 $self instvar flow_
321 if {$args == ""} {
322 return $flow_
323 } else {
324 eval set flow_ $args
325 }
326 }
327
328
329
330 #-------------------------------------------------------------------
331 # Methods:
332 # Mob share_readable
333 # Mob share_writable
334 # Description:
335 # share_readable returns 1 if this mob can be read by multiple
336 # flow simultaneously and 0 otherwise. Subclass should override
337 # this to something appropriate for their type. share_writable
338 # is the same as share_readable, except that it indicates if a
339 # mob can by written to by more than one flow simultaneously.
340 #-------------------------------------------------------------------
341 Mob instproc share_readable {} {
342 return 0
343 }
344
345 Mob instproc share_writable {} {
346 return 0
347 }
348
349 Mob instproc is_persistent {} {
350 return 1
351 }
352
353 Mob instproc action {} {
354 #puts "Method action is deprecated. Use \[$\x get_local_attribute action\]"
355 #uplevel {puts "$class $proc"}
356 $self instvar attributes_
357 if [info exists attributes_(action)] {
358 return $attributes_(action)
359 } else {
360 return "none"
361 }
362 }
363
364 Mob instproc get_virtual_edge_to {n} {
365 return ""
366 }
367
368
369
370 #
371 # PARENT Management
372 #
373 Mob instproc set_parent {parent} {
374 $self instvar parent_
375 set parent_ $parent
376 }
377
378
379 Mob instproc get_parent {} {
380 $self instvar parent_
381 return $parent_
382 }
383
384 #
385 # EXTENSION Management
386 #
387 import MobInputPort MobOutputPort
388 import MobHostMachine MobCaptureCard
389 import MobCamera MobMicrophone MobRoom
390 import MobConference MobSession MobStream
391 import MobRoutingSwitcher MobMixer
392 import MobChannel MobService
393
394 foreach mobtype {
395 MobHostMachine MobCaptureCard MobRoutingSwitcher MobMixer
396 MobInputPort MobOutputPort MobChannel MobService
397 MobConference MobSession MobStream MobCamera
398 MobMicrophone MobRoom } {
399 Mob set ext_([$mobtype get_ext]) $mobtype
400 }
401
402 Mob proc is_valid_ext { ext } {
403 Mob instvar ext_
404 return [info exists ext_($ext)]
405 }
406
407 Mob proc create_new { name args } {
408 Mob instvar ext_
409 set ext [file extension $name]
410 if {[$self is_valid_ext $ext]} {
411 return [eval new $ext_($ext) $name $args]
412 } else {
413 return ""
414 }
415 }
416
417 Mob instproc on_destroy {option callback} {
418 $self instvar destroy_callbacks_
419 switch $option {
420 append {
421 lappend destroy_callbacks_ $callback
422 }
423 set {
424 set destroy_callbacks_ $callback
425 }
426 }
427 }
428
429 Mob public service_key {to} {
430 $self instvar name_
431 if {$to != ""} {
432 return "$name_,$name_,[$to name]"
433 } else {
434 return "$name_,$name_,"
435 }
436 }
437
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.