1 # ihm-script-loader.tcl --
2 #
3 # Responsible for interpreting the service location string, fetching
4 # indiva service scripts and caching of scripts.
5 #
6 # Copyright (c) 1996-2002 The Regents of the University of California.
7 # All rights reserved.
8 #
9 # Redistribution and use in source and binary forms, with or without
10 # modification, are permitted provided that the following conditions are met:
11 #
12 # A. Redistributions of source code must retain the above copyright notice,
13 # this list of conditions and the following disclaimer.
14 # B. Redistributions in binary form must reproduce the above copyright notice,
15 # this list of conditions and the following disclaimer in the documentation
16 # and/or other materials provided with the distribution.
17 # C. Neither the names of the copyright holders nor the names of its
18 # contributors may be used to endorse or promote products derived from this
19 # software without specific prior written permission.
20 #
21 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
22 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
25 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
27 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 #
32 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/indiva/ihm/ihm-script-loader.tcl,v 1.2 2002/03/13 23:39:51 weitsang Exp $
33
34 #--------------------------------------------------------------------------
35 # Class:
36 # IHMScriptLoader
37 # Description:
38 # Retrieve a script locally or from a HTTP server. It also maintains
39 # a cache of recently retrieved scripts.
40 # Members:
41 # scriptfiles_ --
42 # An array that caches service location to filenames of previously
43 # retrieve scripts.
44 #
45 # scripturls_ --
46 # Predefined URL prefix for downloading scripts of type "urn:"
47 #
48 #--------------------------------------------------------------------------
49
50 Class IHMScriptLoader
51
52 #-----------------------------------------------------------------------
53 # Method:
54 # IHMScriptLoader init
55 # Description:
56 # Initialize scripturls to some predefined URLs.
57 #-----------------------------------------------------------------------
58 IHMScriptLoader instproc init { } {
59 $self instvar scripturls_ uniqid_
60
61 set scripturls_ {
62 http://www.bmrc.berkeley.edu/indiva/bin/
63 }
64
65 set uniqid_ 0
66 }
67
68
69 # to autoload the ::http namespace
70 ::http::formatQuery sdsds
71 #-----------------------------------------------------------------------
72 # Method:
73 # IHMScriptLoader get_script
74 # Description:
75 # Return a filename on local disk that corresponds to the executable
76 # for service specified by $name and $srv_loc. Retrieve the script
77 # from an HTTP server and stored it as temporary file if have to.
78 # Previously retrieve scripts are cached in array scriptfiles_.
79 # Arguments:
80 # srv_name -- Name of the service.
81 # srv_loc -- Location of the service's executable. Format is
82 # static:<filename> http:<url> urn:<filename|url>.
83 #-----------------------------------------------------------------------
84 IHMScriptLoader instproc get_script { srv_name srv_loc } {
85 set o [split $srv_loc :]
86 $self instvar scriptfiles_
87 # Check if we already have it
88 if [info exists scriptfiles_($srv_loc)] {
89 return $scriptfiles_($srv_loc)
90 }
91 MashLog info "get_script $srv_name $srv_loc"
92 switch [lindex $o 0] {
93 static {
94 set path [$self get_option execPath]
95 set n $path/[lindex $o 1]
96 if [file isfile $n] {
97 set scriptfiles_($srv_loc) $n
98 return $n
99 }
100 return ""
101 }
102 http {
103 set d [$self get_option scriptDir]
104 if ![file isdirectory $d] {
105 file mkdir $d
106 }
107 $self instvar uniqid_
108 set fname $d/as-$uniqid_.mash
109 incr uniqid_
110 set fd [open $fname w+]
111 set t [::http::geturl $srv_loc -channel $fd]
112 close $fd
113 set code [lindex [::http::code $t] 1]
114 if { $code == "200" } {
115 MashLog info "got script from $srv_loc"
116 set scriptfiles_($srv_loc) $fname
117 ::http::reset $t
118 return $fname
119 } else {
120 MashLog info "can't get script from $srv_loc."
121 ::http::reset $t
122 return ""
123 }
124 }
125 urn {
126 set n [lindex $o 1]
127 # try static first, then url.
128 set s [$self get_script $srv_name static:$n]
129 if { $s != "" } {
130 MashLog info "got $srv_name/$srv_loc from static:$n: $s"
131 set scriptfiles_($srv_loc) $s
132 return $s
133 }
134 $self instvar scripturls_
135 foreach url $scripturls_ {
136 set s [$self get_script $srv_name $url/$n]
137 if { $s != "" } {
138 MashLog info "got $srv_name/$srv_loc from $url: $s"
139 set scriptfiles_($srv_loc) $s
140 return $s
141 }
142 }
143
144 }
145 }
146 return ""
147 }
148
149
150
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.