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

Open Mash Cross Reference
mash/tcl/archive/catalog.tcl

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

  1 # catalog.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1997-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/catalog.tcl,v 1.13 2002/02/03 04:25:07 lim Exp $
 32 
 33 
 34 # This class implements functionality dealing with the catalog file,
 35 # which is used in the archive system.  Catalog files list all the
 36 # stream files which make up a presentation.  Optionally, catalog file
 37 # may contain the sdp announcement from when the presentation was
 38 # recorded.
 39 # Status: Beta
 40 # Author: Yatin Chawathe
 41 Class SessionCatalog
 42 
 43 
 44 SessionCatalog public init { } {
 45     $self instvar sdp_
 46 
 47     $self next
 48     $self set file_ ""
 49     $self set filename_ ""
 50     $self set sdp_ ""
 51     $self set info_ ""
 52 }
 53 
 54 
 55 SessionCatalog public destroy { } {
 56     $self close
 57     $self next
 58 }
 59 
 60 # Open a catalog file
 61 SessionCatalog public open { filename { mode "r" } { permissions 0644 } } {
 62     $self instvar file_ filename_ line_no_
 63     set file_ [open $filename $mode $permissions]
 64 
 65     $self clear
 66     set filename_ $filename
 67 }
 68 
 69 
 70 
 71 SessionCatalog private clear { } {
 72     $self set filename_ ""
 73     $self set line_no_ 0
 74 
 75     $self instvar streams_
 76     catch { unset streams_ }
 77     set streams_(all) ""
 78 }
 79 
 80 
 81 SessionCatalog instproc close { } {
 82     $self instvar file_
 83     if { $file_!="" } {
 84         close $file_
 85         set file_ ""
 86         set filename_ ""
 87     }
 88 }
 89 
 90 
 91 SessionCatalog instproc is_opened { } {
 92     $self instvar file_
 93     if { $file_=="" } { return 0 } else { return 1 }
 94 }
 95 
 96 
 97 SessionCatalog instproc filename { } {
 98     return [$self set filename_]
 99 }
100 
101 
102 SessionCatalog instproc write_sdp { sdp } {
103     $self instvar file_
104     if { $file_=="" } { error "file not opened" }
105     puts $file_ "START_SDP"
106     puts $file_ $sdp
107     puts $file_ "END_SDP"
108     flush $file_
109 }
110 
111 
112 SessionCatalog instproc write_info { info } {
113     $self instvar file_
114     if { $file_ == "" } { error "file not opened" }
115     puts $file_ "START_INFO"
116     puts $file_ $info
117     puts $file_ "END_INFO"
118     flush $file_
119 }
120 
121 
122 SessionCatalog instproc write_stream { id session datafile indexfile } {
123     $self instvar file_
124     if { $file_=="" } { error "file not opened" }
125     puts $file_ "START_STREAM"
126     puts $file_ "\tid=$id"
127     puts $file_ "\tsession=$session"
128     puts $file_ "\tdatafile=$datafile"
129     puts $file_ "\tindexfile=$indexfile"
130     puts $file_ "END_STREAM"
131     flush $file_
132 }
133 
134 # Parse a catalog file, where the file has already been open ed
135 SessionCatalog public read { } {
136     $self instvar file_ line_no_
137     if { $file_=="" } { error "file not opened" }
138 
139     while { [$self read_line_ line] } {
140         if { ![regexp "START_(.*)" $line dummy block_type] } {
141             # we ought to have got a START_something line
142             error "parse error at line $line_no_ in header file"
143         }
144 
145         $self read_block_ [string tolower $block_type]
146     }
147 }
148 
149 # Parse a catalog file, where the content is handed through the msg parameter.
150 # msg should be a list of lines
151 SessionCatalog public parse {msg} {
152         $self instvar msg_ cur_line_
153 
154         $self clear
155 
156 
157 
158         set msg_ [split [string trim $msg] "\n"]
159         for {set cur_line_ 0} {$cur_line_ < [llength $msg_]} {incr cur_line_} {
160                 set line [lindex $msg_ $cur_line_]
161                 if { ![regexp "START_(.*)" $line dummy block_type] } {
162                         error "parse error ($line)"
163                 }
164                 incr cur_line_
165                 $self parse_block_ [string tolower $block_type]
166     }
167 
168 }
169 
170 
171 
172 SessionCatalog private read_line_ { lineVar } {
173     upvar $lineVar line
174     $self instvar file_ line_no_
175     while { ![eof $file_] } {
176         incr line_no_
177         gets $file_ line
178         set line [string trim $line]
179         if { [string length $line]!=0 && [string index $line 0]!="#"} {
180             # this is neither an empty line nor a comment
181             return 1
182         }
183     }
184 
185     return 0
186 }
187 
188 SessionCatalog private parse_block_ { block_type  } {
189         $self instvar msg_ cur_line_
190 
191         set msg {}
192         for {} {$cur_line_ < [llength $msg_]} {incr cur_line_} {
193                 set line [lindex $msg_ $cur_line_]
194                 if { [regexp "END_(.*)" $line dummy end_type] } {
195                         # we got an END; check if it is the correct one,
196                         # and return
197                         set end_type [string tolower $end_type]
198                         if { $block_type != $end_type } {
199                                 # expected an END_"block_type"
200                                 error "expected END_$block_type;\
201                                                 got END_$end_type at\
202                                                 line $line_no_ in header file"
203                         }
204 
205                         $self handle_read_${block_type}_ $msg
206                         return
207                 }
208                 append msg "$line\n"
209         }
210         error "unexpected EOF at line $cur_line_; expected END_$block_type"
211 }
212 
213 
214 
215 SessionCatalog private read_block_ { block_type } {
216     set msg {}
217     while { [$self read_line_ line] } {
218         if { [regexp "END_(.*)" $line dummy end_type] } {
219             # we got an END; check if it is the correct one,
220             # and return
221             set end_type [string tolower $end_type]
222             if { $block_type != $end_type } {
223                 # expected an END_"block_type"
224                 error "expected END_$block_type;\
225                         got END_$end_type at\
226                         line $line_no_ in header file"
227             }
228 
229             $self handle_read_${block_type}_ $msg
230             return
231         }
232 
233         append msg "$line\n"
234     }
235 
236     error "unexpected EOF at line $line_no_; expected END_$block_type"
237 }
238 
239 
240 SessionCatalog instproc handle_read_info_ { msg } {
241     $self instvar info_
242     append info_ $msg
243     return
244 }
245 
246 
247 # The DESC block is used in the mars/rover system.  It's used to pass
248 # server address and presentation file name to the rover client.
249 SessionCatalog private handle_read_descr_ {msg } {
250         $self instvar desc_
251 
252         set desc_ $msg
253         return
254 
255 }
256 
257 
258 SessionCatalog private handle_read_sdp_ { msg } {
259     $self instvar sdp_
260 
261     set sdp_ $msg
262 
263 # Printing all SDP Messages slows down the mash_server playback_agent.
264 #    puts "SDP----"
265 #    puts $msg
266 #    puts "SDP----"
267 
268     return
269 }
270 
271 
272 SessionCatalog public get_sdp {} {
273     $self instvar sdp_
274     return $sdp_
275 }
276 
277 
278 SessionCatalog public get_html_time { type } {
279         set time [$self get_info record_$type]
280         if { $time == {} } { return {} }
281 
282         set day   [lindex $time 0]
283         set month [lindex $time 1]
284         set date  [lindex $time 2]
285         set year  [lindex $time 3]
286         set time  [lindex $time 5]
287 
288         set m [string tolower $month]
289         set month [lsearch "january february march april may june july august\
290                         september october november december" $m]
291         if { $month == -1 } {
292                 set month [lsearch "jan feb mar apr may jun jul aug sep oct\
293                                 nov dec" $m]
294                 if { $month == -1 } { set month $m } else { incr month }
295         } else { incr month }
296         set date [string trim $date ,]
297         set year [string range $year 2 end]
298 
299         return "$day $month/$date/$year $time"
300 }
301 
302 
303 SessionCatalog public get_info { type } {
304 
305     $self instvar info_
306 
307     set return_info ""
308     set info_list [split $info_ "=\n"]
309     set index [lsearch -exact $info_list $type]
310     if { $index != -1 } {
311         set return_info [lindex $info_list [expr $index + 1]]
312     }
313     return $return_info
314 }
315 
316 
317 SessionCatalog public get_desc {} {
318 
319     $self instvar desc_
320     return $desc_
321 }
322 
323 
324 SessionCatalog private handle_read_stream_ { msg } {
325 
326     $self instvar streams_ filename_ line_no_
327 
328     foreach line [split $msg "\n"] {
329         if { $line=={} } continue
330         set line [split $line "="]
331         set attribute [string trim [lindex $line 0]]
332         set value     [string trim [lindex $line 1]]
333         set header($attribute) $value
334     }
335 
336     # check if all the fields exist:
337     if { ![info exists header(id)] } {
338         error "could not find the \"id\" field in STREAM block at\
339                 line $line_no_"
340     }
341     set id $header(id)
342 
343     if { ![info exists header(session)] } {
344         error "could not find the \"session\" field in STREAM block at\
345                 line $line_no_"
346     }
347     set streams_($id,session) $header(session)
348 
349     if { ![info exists header(datafile)] } {
350         error "could not find the \"datafile\" field in STREAM block\
351                 at line $line_no_"
352     } else {
353         # if this is a relative path, prepend the directory path of the
354         # header file to this path
355 
356         set streams_($id,datafile) [file join \
357                 [file dirname $filename_] $header(datafile)]
358     }
359 
360     if { [info exists header(indexfile)] } {
361         # if this is a relative path, prepend the directory path of the
362         # header file to this path
363 
364         if { $header(indexfile)=="" } {
365             set streams_($id,indexfile) ""
366         } else {
367             set streams_($id,indexfile) [file join [file dirname \
368                     $filename_] $header(indexfile)]
369         }
370     } else {
371         # a non-existent index field
372         # automatically use [datafile minus extension].idx
373 
374         set streams_($id,indexfile) "[file rootname \
375                 $streams_($id,datafile)].idx"
376     }
377 
378     lappend streams_(all) $id
379 }
380 
381 
382 SessionCatalog instproc info { method args } {
383     eval [list $self] [list info.$method] $args
384 }
385 
386 
387 SessionCatalog instproc info.streams { } {
388     $self instvar streams_
389     return $streams_(all)
390 }
391 
392 
393 SessionCatalog instproc info.session { id } {
394     $self instvar streams_
395     return $streams_($id,session)
396 }
397 
398 
399 SessionCatalog instproc info.datafile { id } {
400     $self instvar streams_
401     return $streams_($id,datafile)
402 }
403 
404 
405 SessionCatalog instproc info.indexfile { id } {
406     $self instvar streams_
407     return $streams_($id,indexfile)
408 }
409 
410 

~ [ 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.