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

Open Mash Cross Reference
mash/tcl/applications/recorder/app-recorder.tcl

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

  1 # app-recorder.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/applications/recorder/app-recorder.tcl,v 1.8 2002/02/03 04:22:24 lim Exp $
 32 
 33 
 34 import Application RecorderUI/Input SDPParser SessionCatalog ArchiveSession/Record/RTP ArchiveSession/Record/SRM
 35 
 36 import RecorderApi
 37 
 38 # This class implements policy for the recorder application
 39 # Status: Beta
 40 
 41 Class Application/Recorder -superclass Application
 42 
 43 Application/Recorder instproc init {argv} {
 44     $self next recorder
 45     $self instvar options_
 46     $self instvar api_ apip_
 47 
 48     set options_ [$self options]
 49     $self init_resources $options_
 50     wm withdraw .
 51     $self set input_ui_ [RecorderUI/Input .input_ui]
 52     $self set protonames_(RTP/AVP) RTP
 53 
 54     $self parse_args $argv
 55 
 56     set api_ [new RecorderApi $self $apip_]
 57 }
 58 
 59 
 60 Application/Recorder instproc init_resources o {
 61     $self instvar apip_
 62 
 63     set apip_ 6909
 64 
 65     # FIXME - it doesn't look like these calls to add_default do anything
 66     $o add_default drop 0
 67     $o add_default debug 0
 68     $o add_default rtPlay 0
 69     $o add_default record 0
 70     $o add_default uid none
 71     $o add_default trace none
 72     $o add_default delayParams default
 73 
 74     $o add_default defaultTTL 31
 75 }
 76 
 77 
 78 Application/Recorder instproc destroy { } {
 79     $self instvar input_ui_ status_ui_ catalog_
 80         set error ""
 81 
 82         if [info exists input_ui_ ] { destroy $input_ui_  }
 83         if [info exists status_ui_] { destroy $status_ui_ }
 84         if [info exists catalog_] { delete $catalog_ }
 85         $self next
 86 }
 87 
 88 
 89 Application/Recorder instproc parse_args { argv } {
 90         $self instvar no_input_ input_ui_ sdp_ apip_
 91         set no_input_ 0
 92 
 93         set len [llength $argv]
 94         set idx 0
 95         while { $idx < $len } {
 96                 set option [lindex $argv $idx]
 97                 incr idx
 98                 switch -exact -- $option {
 99                         -directory {
100                                 if { $idx >= $len } {
101                                         error "missing argument for -directory"
102                                 }
103                                 $input_ui_ set_directory [lindex $argv $idx]
104                                 incr idx
105                         }
106 
107                         -sessionid {
108                                 if { $idx >= $len } {
109                                         error "missing argument for -sessionid"
110                                 }
111                                 $input_ui_ set_session_id [lindex $argv $idx]
112                                 incr idx
113                         }
114 
115                         -catalog {
116                                 if { $idx >= $len } {
117                                         error "missing argument for\
118                                                         -catalog"
119                                 }
120                                 $input_ui_ set_catalog_filename \
121                                                 [lindex $argv $idx]
122                                 incr idx
123                         }
124 
125                         -add {
126                                 if { $idx >= $len } {
127                                         error "missing argument for -add"
128                                 }
129                                 set arg [lindex $argv $idx]
130                                 if { [llength $arg] != 3 } {
131                                         error "invalid argument to -add: $arg.\
132                                                         must be \"<protocol>\
133                                                         <media> <addr>\""
134                                 }
135                                 $input_ui_ add_direct [lindex $arg 0] \
136                                                 [lindex $arg 1] [lindex $arg 2]
137                                 incr idx
138                         }
139 
140                         -noinput {
141                                 set no_input_ 1
142                         }
143 
144                         -sdp {
145                                 if { $idx >= $len } {
146                                         error "missing argument for\
147                                                         -sdp"
148                                 }
149                                 set sdp_ [lindex $argv $idx]
150                                 $self handle_sdp
151                                 incr idx
152                         }
153 
154 
155                         -apip {
156                                 if { $idx >= $len } {
157                                         error "missing argument for -apip"
158                                 }
159                                 set apip_ [lindex $argv $idx]
160                                 incr idx
161                         }
162 
163                         default {
164                                 $self usage "Invalid argument \"$option\""
165                         }
166                 }
167         }
168 }
169 
170 
171 Application/Recorder instproc usage { error } {
172         puts "recorder: $error"
173         puts ""
174         puts "Usage: recorder \[options\]"
175         puts "\t-add \"<protocol> <media> <address>\": add this session to"
176         puts "\t                                       the record list"
177         puts "\t\t\t<protocol>: SRM or RTP"
178         puts "\t\t\t<media>:    mediaboard, video, audio, etc."
179         puts "\t\t\t<address>:  <multicast group>/<port number>"
180         puts "\t-directory <dirname>: store all files in this directory"
181         puts "\t-sessionid <id>: used as a prefix for all files generated in"
182         puts "\t                 this session"
183         puts "\t-catalog <file>: name of the catalog file to be created"
184         puts "\t                    this session"
185         puts "\t-noinput: do not pop up the initial input dialog"
186         puts "\t-apip <api port>: port to run API server on"
187         puts "\t-sdp <announcement>/-: if argument is '-', read standard input"
188         puts "\t                       for an SDP announcement\n"
189 
190         exit -1
191 }
192 
193 
194 # This procedure allows the recorder to be started by handing it an sdp
195 # announcement.  The handle_sdp procedure then parses it, and starts
196 # recording with the correct parameters
197 
198 Application/Recorder instproc handle_sdp { } {
199         $self instvar sdp_ input_ui_ protonames_
200 
201         if { $sdp_=="-" } {
202                 # read the whole SDP announcement in
203 
204                 set sdp_ ""
205                 while { [gets stdin line] > 0} {
206                         if { [string length $line] > 0 } {
207                                 append sdp_ "$line\n"
208                         }
209                 }
210         }
211         set sdp_ [string trim $sdp_]
212 
213         puts stderr "SDP announcement is:\n$sdp_------------\n"
214         set parser [new SDPParser]
215         set messages [$parser parse $sdp_]
216         if { [llength $messages]==0 } {
217                 error "invalid SDP announcement"
218         }
219 
220         foreach message $messages {
221                 foreach media [$message set allmedia_] {
222                         set proto [$media set proto_]
223                         if [info exists protonames_($proto)] {
224                                 set proto $protonames_($proto)
225                         }
226 
227                         set mediatype [$media set mediatype_]
228                         if { [Class info instances \
229                                         ArchiveSession/Record/$proto]=="" } {
230                                 puts stderr "Cannot find recorder for protocol\
231                                                 $proto:$mediatype; ignoring..."
232                                 continue
233                         }
234 
235                         set caddr [split [$media set caddr_] "/"]
236                         set addr [lindex $caddr 0]/[$media set port_]
237                         if { [llength $caddr] > 1 } {
238                                 append addr /none/[lindex $caddr 1]
239                         }
240                         $input_ui_ add_direct $proto $mediatype $addr
241                 }
242         }
243 }
244 
245 
246 Application/Recorder instproc run { } {
247         $self instvar no_input_ input_ui_ catalog_
248 
249         while { 1 } {
250                 if { !$no_input_ } {
251                         if { [$input_ui_ invoke]=="" } {
252                                 return 0
253                         }
254                 }
255 
256                 set error [$self check]
257                 if { $error!="" } {
258                         $self invoke_error $error
259                         continue
260                 }
261 
262                 if { ![info exists catalog_] } {
263                         set catalog_ [new SessionCatalog]
264                 }
265                 set catalog_filename [$input_ui_ get_catalog_filename]
266                 if { $catalog_filename!="" } {
267                         if [catch { $catalog_ open $catalog_filename "w"} \
268                                         error] {
269                                 $self invoke_error "$error (while trying to\
270                                                 open catalog file)"
271                                 continue
272                         }
273                 }
274                 break
275         }
276 
277         if { ![$catalog_ is_opened] } {
278                 delete $catalog_
279                 unset catalog_
280         }
281 
282         $self record
283         return 1
284 }
285 
286 
287 Application/Recorder instproc invoke_error { error } {
288         $self instvar no_input_
289         if { $no_input_ } {
290                 error $error
291         }
292 
293         Dialog transient MessageBox -image Icons(warning) \
294                         -text $error
295 }
296 
297 
298 Application/Recorder instproc check { } {
299         $self instvar input_ui_
300 
301         if { ![file isdirectory [$input_ui_ get_directory]] } {
302                 return "invalid directory: [$input_ui_ get_directory]"
303         }
304 
305         if { [$input_ui_ subwidget listbox info numelems] <= 0 } {
306                 return "must have at least one session to record"
307         }
308 
309         return ""
310 }
311 
312 
313 Application/Recorder instproc record { } {
314         $self instvar input_ui_ status_ui_ catalog_ sdp_
315 
316         if { [info exists catalog_] && [info exists sdp_] } {
317                 $catalog_ write_sdp $sdp_
318         }
319 
320         set directory [$input_ui_ get_directory]
321         set catalog_filename [$input_ui_ get_catalog_filename]
322         if { [file dirname $catalog_filename]==$directory } {
323                 set name [file tail $catalog_filename]
324         } else {
325                 set name $catalog_filename
326         }
327 
328         set status_ui_ [RecorderUI/Status .status_ui \
329                         -closecmd "delete $self; exit"]
330         $status_ui_ subwidget session_id insert end [$input_ui_ get_session_id]
331         $status_ui_ subwidget directory  insert end $directory
332         $status_ui_ subwidget catalog    insert end $name
333         $status_ui_ subwidget session_id configure -state disabled
334         $status_ui_ subwidget directory  configure -state disabled
335         $status_ui_ subwidget catalog    configure -state disabled
336 
337         foreach id [$input_ui_ subwidget listbox info all] {
338                 $self create_session $id
339         }
340 
341         $status_ui_ invoke
342 }
343 
344 
345 Application/Recorder instproc create_session { id } {
346         $self instvar input_ui_ status_ui_ catalog_
347         set session_ui [$status_ui_ add [$input_ui_ subwidget listbox \
348                         info value -id $id]]
349         set id [split $id "+"]
350         set protocol [lindex $id 0]
351         set session [new ArchiveSession/Record/$protocol [lindex $id 1] \
352                         [lindex $id 2]]
353         if { [info exists catalog_] } {
354                 $session catalog $catalog_
355         }
356         $session save_in [$input_ui_ get_directory]
357         $session session_id [$input_ui_ get_session_id]
358         $session attach_observer $session_ui
359         $session_ui attach_session $session
360 }
361 
362 
363 Application/Recorder instproc destroy_session { session } {
364 }
365 
366 

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