1 # mashlet-publisher.tcl --
2 #
3 # Using an importTable, generate a mashlet per object, and publish each
4 # mashlet on a web-server.
5 #
6 # Copyright (c) 1998-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/common/mashlet-publisher.tcl,v 1.6 2002/02/03 04:25:43 lim Exp $
33
34
35 #
36 # Using an importTable, generate a mashlet per object,
37 # and publish each mashlet on a web-server.
38 #
39 Class MashletPublisher
40
41 #
42 # For each object in the importTable in the provided directory
43 # <i>import_dir</i>, generate and publish a mashlet (named
44 # <object>.mash) in the provided directory <i>publish_dir</i>. The user
45 # is reponsible for cleaning out stale mashlets from this directory and
46 # making the directory readable & executable. <i>publish_url</i> is
47 # expected to be the URL to which the <i>publish_dir</i> is mapped.
48 #
49 MashletPublisher public init { import_dir publish_dir publish_url } {
50 $self instvar publishDir_ publishURL_
51 set publishDir_ $publish_dir
52 set publishURL_ $publish_url
53
54 set objects [$self read_import_table $import_dir]
55 foreach object $objects {
56 $self publish_mashlet $object
57 }
58 }
59
60 #
61 # Create an array of lists called table_. The array will be indexed using
62 # the name of a Mash object. The value of the array at that index will
63 # be assigned a list of files (paths relative to the provided directory
64 # <i>dir</i>) in which the Mash object and methods on it are defined
65 # according to the importTable in the provided directory <i>dir</i>.
66 # Return a list of all of the objects mapped in the importTable.
67 #
68 MashletPublisher instproc read_import_table { dir } {
69 $self instvar table_ objects_ import_
70
71 set import_ [new Import]
72 $import_ read_dir $dir
73 $import_ instvar {table_ importTable_}
74 array set table_ [array get importTable_]
75
76 set objects_ ""
77 foreach object [array names table_] {
78 # Add all the uncommented-out objects in the importTable to a list
79 if {[string range $object 0 0] != "#" } {
80 lappend objects_ $object
81 }
82 }
83
84 return $objects_
85 }
86
87 #
88 # Return a unique pathname for the supplied filename taken from the table_.
89 #
90 MashletPublisher private get_uniq_path { filename } {
91 return $filename
92 $self instvar objects_ table_ magicNumTailEls_ import_
93
94 # Determine the number of tail elements that need to be returned to provide a unique filename
95 if { ![info exists magicNumTailEls_] } {
96 # accumulate a listing of all files
97 foreach object $objects_ {
98 if [info exists files] {
99 set files [concat $files $table_($object)]
100 } else {
101 set files $table_($object)
102 }
103 }
104
105 # eliminate duplicates from the list
106 set files [lsort_uniq $files]
107
108 set numTailEls 1
109 while 1 {
110 foreach file $files {
111 # break each element in the list into a prefix and suffix
112 set parsedName [file split $file]
113 set preStart 0
114 set suffEnd [expr [llength $parsedName] - 1]
115 set suffStart [expr $suffEnd - $numTailEls + 1]
116 set preEnd [expr $suffStart - 1]
117 set prefix ""
118 foreach pathEl [lrange $parsedName $preStart $preEnd] {
119 set prefix [$import_ file join $prefix $pathEl]
120 }
121 lappend prefixes $prefix
122 set suffix ""
123 foreach pathEl [lrange $parsedName $suffStart $suffEnd] {
124 set suffix [$import_ file join $suffix $pathEl]
125 }
126 lappend suffixes $suffix
127 }
128 # when all of the suffixes are unique, we have found the magic number
129 if { [llength [lsort_uniq $suffixes]] == [llength $suffixes] } {
130 break
131 } else {
132 incr numTailEls
133 unset prefixes
134 unset suffixes
135 }
136 }
137 set magicNumTailEls_ $numTailEls
138 }
139
140 set parsedName [file split $filename]
141 set suffEnd [expr [llength $parsedName] - 1]
142 set suffStart [expr $suffEnd - $magicNumTailEls_ + 1]
143 set suffix ""
144 foreach pathEl [lrange $parsedName $suffStart $suffEnd] {
145 set suffix [$import_ file join $suffix $pathEl]
146 }
147 return $suffix
148 }
149
150 #
151 # Sorts the provided list, eliminating duplicate elements.
152 #
153 proc lsort_uniq { list } {
154 foreach element $list {
155 set dummy_array($element) blah
156 }
157 return [array names dummy_array]
158 }
159
160 #
161 # In the publishDir_, publish a mashlet for the provided <i>object</i>
162 # by publishing the tcl files in which methods or defns for this object
163 # are found and then sourcing these tcl files in a file called
164 # <object>.mash
165 #
166 MashletPublisher private publish_mashlet { object } {
167 $self instvar table_ writtento_ publishDir_ publishURL_
168
169 # error msg if object was not found in importTable
170 if ![info exist table_($object)] {
171 puts stderr "*** warning: can't find import entry for $object"
172 return
173 }
174
175 # assign a filename for mashlet to be written to
176 $self instvar import_
177 set htmlable [$import_ class_to_file $object]
178 set mashlet [$import_ file join $publishDir_ $htmlable.mash]
179 puts stdout "Publishing $mashlet"
180
181 # publish the files in which methods or defns of this object are found
182 # and source them in a published mashlet
183 foreach fileIn $table_($object) {
184 # if this is the first time I am appending to this mashlet,
185 # clean out any old stuff beforehand
186 if {[file exists $mashlet] && ![info exists writtento_($mashlet)]} {
187 file delete $mashlet
188 }
189
190 # copy $fileIn contents into a published file, $fileOut
191 if [catch {open $fileIn r} fileInId] {
192 puts stderr "Cannot open $fileIn: $fileInId"
193 continue
194 } else {
195 set relativeFileName [$self get_uniq_path $fileIn]
196 set fileOut [$import_ file join $publishDir_ $relativeFileName]
197 set URL [$import_ file join $publishURL_ $relativeFileName]
198 #puts "trying to copy $fileIn to $fileOut"
199
200 # create the mirror directory within the publishDir_ if it doesn't already exist
201 set fileOutDir [$import_ file dirname $fileOut]
202 if { ![file exists $fileOutDir] } {
203 #puts stdout "Creating directory: $fileOutDir"
204 file mkdir $fileOutDir
205 }
206 # make sure the directory path from the publishDir_ to fileOut is executable
207 set path $fileOut
208 while { [set dir [$import_ file dirname $path]] != $publishDir_ } {
209 #puts stdout "Making $dir executable"
210 file attributes $dir -permissions 0775
211 set path $dir
212 }
213
214 #puts "trying to open $fileOutId"
215 if [catch {open $fileOut w 0664} fileOutId] {
216 puts stderr "Cannot open $fileOut: $fileOutId"
217 close $fileInId
218 continue
219 }
220 #puts "done trying to open $fileOutId"
221 file attributes $fileOut -permissions 0664
222 # puts stdout "Copying $fileIn to $fileOut"
223 puts -nonewline $fileOutId [read $fileInId]
224 close $fileInId
225 close $fileOutId
226 }
227
228 # add source command to mashlet
229 if [catch {open $mashlet a 0664} mashletFileId] {
230 puts stderr "Cannot open $mashlet: $mashletFileId"
231 continue
232 } else {
233 file attributes $mashlet -permissions 0664
234 # append a source command for the current file
235 # puts stdout "Sourcing $URL in $mashlet"
236 puts $mashletFileId "source $URL"
237 # set flag to indicate that I have dumped to this mashlet
238 set writtento_($mashlet) 1
239 close $mashletFileId
240 }
241 }
242 }
243
244
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.