~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/archive/archive-system.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # archive-system.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1998-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/archive/archive-system.tcl,v 1.18 2002/02/03 04:25:07 lim Exp $
 32 
 33 
 34 import SessionCatalog ArchiveSession/Record/RTP ArchiveSession/Record/Mediaboard ArchiveSession/Play/RTP
 35 #import ArchiveSession/Record/Mediaboard ArchiveSession/Play/Mediaboard
 36 
 37 #
 38 # The core object that defines the public API for
 39 # manipulating the MASH Archive system.  All details
 40 # of the archive system architecture are hidden
 41 # behind this API so that different implementations
 42 # can be re-used across an application base.
 43 #
 44 Class ArchiveSystem
 45 Class ArchiveSystem/Record -superclass ArchiveSystem
 46 Class ArchiveSystem/Play -superclass ArchiveSystem
 47 
 48 #
 49 # The archive system constructor.  Initialize an object
 50 # to interact with the archive repository in the file
 51 # system in the directory named by <i>path</i>.
 52 # If this directory does not exist, create it
 53 # and initialize the new archive.
 54 # If it cannot be created, return an error.
 55 #
 56 ArchiveSystem public init {} {
 57 }
 58 
 59 ArchiveSystem private check_dir dir {
 60     if ![file exists $dir] {
 61         catch "file mkdir $dir"
 62         if ![file isdirectory $dir] {
 63             return "$dir: can't create"
 64         }
 65     } elseif ![file isdirectory $dir] {
 66         return "$dir: not a directory"
 67     }
 68     return ""
 69 }
 70 
 71 ArchiveSystem/Record private destroy {} {
 72     $self instvar sessions_
 73     foreach s $sessions_ {
 74         delete $s
 75     }
 76     $self next
 77 }
 78 
 79 #
 80 # Create and open a new module named <i>name</i>
 81 # in the archive system.
 82 # If this module already exists, r1eturn an error.
 83 # Otherwise, returns an empty string.
 84 # If module already exists, overwrites it.
 85 # FIXME should do coarse-grained locking of the
 86 # directory (trivial to implement)
 87 #
 88 ArchiveSystem/Record public open { path module } {
 89     $self instvar catalog_ module_
 90     set err [$self check_dir $path]
 91     if { $err != "" } {
 92         return $err
 93     }
 94     set module_ $path/$module
 95     set err [$self check_dir $module_]
 96     if { $err != "" } {
 97         return $err
 98     }
 99     set catalog_ [new SessionCatalog]
100     $catalog_ open $module_/cat.ctg w 0644
101 }
102 
103 ArchiveSystem/Play public init {} {
104         $self instvar sesslist_
105         set sesslist_ ""
106         $self next
107 }
108 
109 ArchiveSystem/Play public open { path module } {
110         set module_ $path/$module
111 
112         if ![file isdirectory $path] {
113                 return "$path: no such directory"
114         }
115         #if ![file isdirectory $module_] {
116         #       return "$path/$module: no such module"
117         #    }
118         $self instvar catalog_
119         set catalog_ [new SessionCatalog]
120         #$catalog_ open $module_/cat.ctg
121         $catalog_ open $module_
122         $self scan_catalog
123 }
124 
125 ArchiveSystem/Play public open {module} {
126         set module_ $module
127 
128         if ![file isfile $module_] {
129                 return "$module_: no such file"
130         }
131         $self instvar catalog_
132         set catalog_ [new SessionCatalog]
133         $catalog_ open $module_
134         $self scan_catalog
135 }
136 
137 ArchiveSystem/Play public query_sessions {} {
138         $self instvar sesslist_
139 
140         return $sesslist_
141 
142 }
143 
144 ArchiveSystem/Play private scan_catalog {} {
145 
146     $self instvar catalog_ start_ end_ srcs_ lts_ sesslist_
147     catch "unset start_ end_"
148 
149     #FIXME why?
150     if [catch "$catalog_ read" error] {
151         return $error
152     }
153     #
154     # Create a linked list of sources for each session
155     # that exists in this archive module
156     #
157     foreach src [$catalog_ info streams] {
158             set sess [$catalog_ info session $src]
159             lappend srcs_($sess) $src
160             if {[lsearch $sesslist_ $sess]==-1} {
161                     lappend sesslist_ [$catalog_ info session $src]
162             }
163     }
164 
165     #FIXME just one?
166     set lts_ [new LTS]
167 }
168 
169 # FIXME should work for record too?
170 # schedule an event in the logical LTS time system
171 #
172 ArchiveSystem/Play private at { logical_time cmd } {
173     #FIXME assume speed of 1.0
174     $self instvar lts_ start_
175     set diff [expr $logical_time - ([$lts_ now_logical] - $start_) ]
176     if { $diff < 0 } {
177         set diff 0
178     }
179     set ms [expr int(1000 * $diff + 0.5)]
180     puts "$logical_time, [$lts_ now_logical], $ms"
181     after $ms $cmd
182 }
183 
184 #
185 # how to we precisely name each sub-session within the module?
186 # FIXME the catalog should return an object for a session and
187 # we should be able to query its properties (including media
188 # and protocol) but this info is not in the catalog file format...
189 #
190 ArchiveSystem/Play public play_session { spec media } {
191     #FIXME why does recorder need media type? timestamped conversion?
192 
193     #
194     # FIXME hack - because the catalog file doesn't have the media/proto
195     # info, infer it from the session name.  also, this hack only
196     # works for up to one session per media (i.e., we can't
197     # have two separate video sessions in the same archive
198     # module in this case)
199     #
200     $self instvar srcs_
201     foreach s [array names srcs_] {
202         if { [string first $media $s] >= 0 } {
203             #
204             # found a session of the desired media type
205             # create the playback objects are return
206             #
207             $self create_playback_session $spec $media $s
208             return 1
209         }
210     }
211     return 0
212 }
213 
214 ArchiveSystem/Play private destroy {} {
215     $self instvar sessions_ streamlist_
216     foreach s $sessions_ {
217         delete $s
218     }
219 }
220 
221 #
222 # Create all of the objects necessary to replay a session stored...
223 # FIXME  finish comment.
224 # If an error is encountered, return a string describing the error.
225 # Otherwise, return an empty string.
226 #
227 ArchiveSystem/Play private create_playback_session { spec media sessionTag } {
228         $self instvar start_ end_
229 
230 
231     #FIXME hack - this info should be in catalog not in data files
232     if { $media == "audio" || $media == "video" } {
233         set protocol RTP
234     } else {
235         set protocol Mediaboard
236     }
237     set session [new ArchiveSession/Play/$protocol $media $spec]
238     $self instvar sessions_
239     lappend sessions_ $session
240     $self instvar srcs_ start_ end_ catalog_ streamlist_
241 
242     # FIXME ArchiveFile is really a playback object?
243     # (the dual of the recoder object?)
244     set file [new ArchiveFile]
245     foreach src $srcs_($sessionTag) {
246         #FIXME data_hdr and index_hdr should be tcl objects
247         set datafile [$catalog_ info datafile $src]
248         set indexfile [$catalog_ info indexfile $src]
249         if [catch {$file open $datafile} error] {
250             delete $file
251             return "$datafile: can't open"
252         }
253         if [catch {$file header data_hdr} error] {
254             delete $file
255             return "$datafile: bad header format"
256         }
257         $file close
258         if [catch {$file open $indexfile} error] {
259             delete $file
260             return "$indexfile: can't open"
261         }
262 
263         if [catch {$file header index_hdr} error] {
264             delete $file
265             return "$indexfile: bad header format"
266         }
267         $file close
268 
269         #FIXME these checks should not be necessary...
270         foreach fld "protocol media cname name" {
271             if { $data_hdr($fld) != $index_hdr($fld) } {
272                 delete $file
273                 return \
274                         "data/index attribute mismatch\n\t(attr $fld, data $datafile, index $indexfil)"
275             }
276         }
277 
278         #
279         # Keep track of min start time and max end time
280         # across all the archive files.
281         #
282         if ![info exists start_] {
283             set start_ $data_hdr(start)
284             set end_ $data_hdr(end)
285         } else {
286             if { $data_hdr(start) < $start_ } {
287                 set start_ $data_hdr(start)
288             }
289             if { $data_hdr(end) > $end_ } {
290                 set end_ $data_hdr(end)
291             }
292         }
293 
294         # FIXME these are memory leaks.  These need to be
295         # accounted for and deleted when the object is deleted.
296         set df [new ArchiveFile/Data]
297         $df open $datafile
298         set if [new ArchiveFile/Index]
299         $if open $indexfile
300 
301         set stream [$session create_stream]
302         $stream datafile $df
303         $stream indexfile $if
304         # FIXME
305         # We use a separate LTS for all streams
306         # because the current architecture does not enable
307         # temporal manipultation on a stream granularity...
308         # This should be fixed and then we can go back to
309         # a single lts for all streams.
310         $stream lts [new LTS]
311         $session attach_stream $stream
312 
313         lappend streamlist_ $stream
314     }
315     # initialize lts
316     $self rewind
317 
318     return ""
319 }
320 
321 # This returns a variety of information about the playback session:
322 # start timestamp, end timestamp, session list, and media types
323 
324 #ArchiveSystem/Play public get_info {} {
325 #       $self instvar start_ end_
326 
327 #       set session(Start) $start_
328 #       set session(End) $end_
329 #       set session(sesslist) $sesslist
330 #
331 #       return $session
332 #}
333 
334 
335 
336 ArchiveSystem/Play public get_mapping {} {
337         $self instvar lts_ start_
338 
339         set system [$lts_ now_system]
340         set logical [$lts_ now_logical]
341         set offset [expr $logical - $start_]
342 
343         return "$system $offset"
344 
345 }
346 
347 ArchiveSystem/Play public get_start {} {
348         $self instvar start_
349 
350         return $start_
351 }
352 
353 ArchiveSystem/Play public get_end {} {
354         $self instvar end_
355 
356         return $end_
357 }
358 
359 ArchiveSystem/Play public rewind {} {
360     $self goto 0
361 }
362 
363 ArchiveSystem/Play public goto { t } {
364     $self instvar start_ streamlist_ lts_
365     $lts_ now_logical [expr $start_ + $t]
366     foreach s $streamlist_ {
367         [$s lts] now_logical [expr $start_ + $t - [$s set offset_]]
368     }
369 }
370 
371 ArchiveSystem/Play public start {} {
372     $self instvar streamlist_ lts_
373     $lts_ speed 1.0
374     foreach s $streamlist_ {
375         [$s lts] speed 1.0
376     }
377 }
378 
379 ArchiveSystem/Play public stop {} {
380     $self instvar streamlist_ lts_
381     $lts_ speed 0.0
382     foreach s $streamlist_ {
383         [$s lts] speed 0.0
384     }
385 }
386 
387 ArchiveSystem public close { } {
388     $self instvar catalog_
389     delete $catalog_
390     unset catalog_
391 }
392 
393 #
394 # Arrange to record an RTP session to the currently opened
395 # archive module.
396 #
397 ArchiveSystem public record_rtp_session { spec media tag } {
398     #FIXME why does recorder need media type? timestampd conversion?
399     set session [new ArchiveSession/Record/RTP $media $spec]
400     $self instvar catalog_ module_
401     $session catalog $catalog_
402     $session save_in $module_
403     $session session_id $tag\_$media
404     #$session attach_observer $self
405     #
406     # keep list of sessions so we can tear them down gracefully
407     #
408     $self instvar sessions_
409     lappend sessions_ $session
410 }
411 
412 #
413 # Arrange to record an mediaboard session to the currently opened
414 # archive module.  FIXME this should only have to know about srm.
415 #
416 ArchiveSystem public record_mb_session { spec tag } {
417     #FIXME why does recorder need media type? timestampd conversion?
418     set session [new ArchiveSession/Record/Mediaboard mediaboard $spec]
419     $self instvar catalog_ module_
420     $session catalog $catalog_
421     $session save_in $module_
422     $session session_id $tag\_mb
423     #$session attach_observer $self
424     #
425     # keep list of sessions so we can tear them down gracefully
426     #
427     $self instvar sessions_
428     lappend sessions_ $session
429 }
430 
431 
432 #
433 # Arrange to record all a session's media to the currently opened
434 # archive module.
435 #
436 ArchiveSystem public record_program { program tag } {
437 
438     set session_list {}
439 
440     # Extract SDP information needed to record.
441     set msg [$program base]
442     set all_media [$msg set allmedia_]
443     set num_media [llength $all_media]
444     while { $num_media > 0 } {
445 
446         # Find the mediatype.
447         set num_media [expr $num_media - 1]
448         set media [lindex $all_media $num_media]
449         set mediatype [string tolower [$media set mediatype_]]
450 
451         # Construct the spec which has the form, addr/port/fmt/ttl
452         set fmt [$media set fmt_]
453         set addr_and_ttl [split [$media set caddr_] /]
454         set addr [lindex $addr_and_ttl 0]
455         set ttl [lindex $addr_and_ttl 1]
456         set port [$media set port_]
457         set spec ""
458         append spec $addr "/" $port "/" $fmt "/" $ttl
459 
460         # For now, only record audio and video sessions; don't
461         # record whiteboard or text sessions because of a
462         # smash problem.
463         if { $mediatype == "audio" || $mediatype == "video" } {
464             $self record_rtp_session $spec $mediatype $tag
465         } else {
466                 $self record_mb_session $spec $tag
467         }
468     }
469 }
470 
471 
472 #
473 # This method takes an SDP Program and writes the message information
474 # to the catalog file.
475 #
476 ArchiveSystem public write_announcement { program } {
477     $self instvar catalog_
478     $catalog_ write_sdp [[$program base] obj2str]
479 }
480 
481 
482 ArchiveSystem public write_info { info } {
483     $self instvar catalog_
484     $catalog_ write_info $info
485 }
486 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.