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

Open Mash Cross Reference
mash/tcl/applications/pathfinder/play_agent.tcl

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

  1 # play_agent.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/pathfinder/play_agent.tcl,v 1.10 2002/02/03 04:22:06 lim Exp $
 32 
 33 
 34 Class Play_Agent
 35 
 36 Play_Agent public init { } {
 37 
 38     $self instvar archive_ archive_dir_ play_list_
 39 
 40     # Initialize the archive and schedule directories.
 41     #set o [$self options]
 42     #$o load_preferences "mserver"
 43     set archive_ [$self get_option archive_root]
 44     set archive_dir_ [$self get_option archive_dir]
 45     append archive_ $archive_dir_
 46 
 47     # Initialize the list of sessions that can be played.
 48     set play_list_ {}
 49 }
 50 
 51 
 52 Play_Agent private update_playlist { } {
 53 
 54         $self instvar archive_ play_list_
 55 
 56         cd $archive_
 57         if {[string toupper [$self get_option hierarchy]] == "YES"} {
 58 puts "hier"
 59             set ctgfiles [glob -nocomplain -- */*/*.ctg]
 60         } else {
 61 puts "no hier"
 62             set ctgfiles [glob -nocomplain -- */*.ctg]
 63         }
 64         mtrace trcNet "-> Files received: $ctgfiles"
 65 
 66         # Update the play_list_ with the new catalog files.
 67         set new_play_list ""
 68         foreach f $ctgfiles {
 69                 set elt [lsearch $play_list_ $f]
 70                 if { $elt == -1 } {
 71                         if { [string match *START_STREAM* [read_file $f]] } {
 72 
 73                                 set catalog [new SessionCatalog]
 74                                 $catalog open $f
 75                                 lappend new_play_list $f $catalog
 76                                 $catalog close
 77                         }
 78                 }  else {
 79                         lappend new_play_list [lindex $play_list_ $elt] [lindex $play_list_ [incr elt]]
 80                 }
 81         }
 82         set play_list_ $new_play_list
 83 }
 84 
 85 
 86 
 87 Play_Agent public return_progs { } {
 88 
 89     $self instvar play_list_
 90     $self update_playlist
 91     return $play_list_
 92 }
 93 
 94 
 95 Play_Agent public return_program { filename } {
 96 
 97     $self instvar archive_ play_list_
 98 
 99     set catalog [new SessionCatalog]
100     cd $archive_
101     if [catch {$catalog open $filename}] {
102         return ""
103     }
104     $catalog read
105 
106     set msg [lindex [ [new SDPParser 0] parse [$catalog get_sdp]] 0]
107     set program [new Program $msg]
108 
109     $catalog destroy
110 
111     return $program
112 }
113 
114 
115 Play_Agent public return_file_contents { filename } {
116 
117     $self instvar archive_
118 
119     cd $archive_
120     return [read_file $filename]
121 }
122 
123 
124 Play_Agent public return_full_path { filename } {
125 
126     $self instvar archive_
127 
128     append path $archive_ $filename
129     return $path
130 }
131 
132 
133 Play_Agent public return_rel_path { filename } {
134 
135     $self instvar archive_dir_
136 
137     append path $archive_dir_ $filename
138     return $path
139 }
140 
141 # -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
142 
143 
144 import HTTP_Agent
145 
146 #
147 # The HTTP_Agent/Play_Agent class in an HTTP-aware agent that can be
148 # used in the MASH_Server.
149 #
150 Class HTTP_Agent/Play_Agent -superclass HTTP_Agent
151 
152 
153 HTTP_Agent/Play_Agent public init { } {
154 
155     $self next
156     $self instvar agent_ play_server_
157 
158     set agent_ [new Play_Agent]
159 
160     #set o [$self options]
161     #$o load_preferences "mserver"
162     set play_server_ [$self get_option play_server_addr]
163 }
164 
165 
166 HTTP_Agent/Play_Agent instproc handle_request {url filename source reply_var} {
167     upvar $reply_var reply
168     $self instvar agent_ play_server_
169 
170     mtrace trcNet "-> Play_Agent::handle_request called"
171     set page ""
172     set status 200
173     set type "text/html"
174 
175     # Check for the "magic" URLs.
176     if { $url == "/playback-list.html" } {
177         mtrace trcNet "-> Request for the playback list received."
178         set page [$self get_page playback_list]
179 
180     } elseif { $url == "/playback-desc" } {
181         mtrace trcNet "-> SDP Description requested"
182         # Since the key contains the filename of the catalog file,
183         # extract the SDP message to obtain the Program object.
184         set program [$agent_ return_program $filename]
185         if { $program == "" } {
186             set msg "No session information available."
187             set page [$self get_error_page $msg]
188 
189         } else {
190             set page [$self get_desc_page $filename playback]
191         }
192 
193     } elseif { $url == "/playback" } {
194             mtrace trcNet "-> Request to playback session received."
195             set header "START_DESCR\n"
196             append header "file: [$agent_ return_full_path $filename]\n"
197             append header "server: $play_server_\n"
198             append header "END_DESCR\n"
199 
200             set catalog "$header [$agent_ return_file_contents $filename]"
201             set argv [list -ctg $catalog]
202             set page [$self create_collaborator_mashlet $argv]
203             set type "x-mash/x-script"
204     } elseif { $url == "/asplayback" } {
205             mtrace trcNet "-> Request for assisted playback received."
206             set header "START_DESCR\n"
207             append header "file: [$agent_ return_full_path $filename]\n"
208             append header "server: $play_server_\n"
209             append header "END_DESCR\n"
210             set catalog "$header [$agent_ return_file_contents $filename]"
211             set megafor [$self get_option megafor]
212             set argv [list -ctg $catalog -usemega -unicast $megafor]
213             set page [$self create_collaborator_mashlet $argv]
214             set type "x-mash/x-script"
215     }
216 
217     if { $page != {} } {
218             set reply(headers) [list content-type $type]
219             set reply(data)    $page
220             set reply(status)  $status
221             return 1
222     } else {
223             return 0
224     }
225 }
226 
227 # Previously, this caused the catalog file to be opened, re-read and re-parsed
228 # each time a sort_compare operation came.  Very bad!  For now, just sort
229 # based on alpabetization of directory names.  Eventually, probably want
230 # some sort of hierarchical structure kept in a cache?
231 HTTP_Agent/Play_Agent private sort_compare_ { filename1 filename2 } {
232 
233     $self instvar list_ agent_
234     array set agent_array $list_
235 
236         return [string compare $filename1 $filename2]
237 
238     #set prog1 [$agent_ return_program $filename1]
239     #set prog2 [$agent_ return_program $filename2]
240 
241     #return [string compare \
242         #    [string tolower [[$prog1 base] set session_name_]] \
243         #    [string tolower [[$prog2 base] set session_name_]]]
244 }
245 

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