Commit | Line | Data |
---|---|---|
959f3c4c JH |
1 | ?RCS: $Id: Getfile.U,v 3.0.1.7 1997/02/28 15:01:06 ram Exp $ |
2 | ?RCS: | |
3 | ?RCS: Copyright (c) 1991-1993, Raphael Manfredi | |
4 | ?RCS: | |
5 | ?RCS: You may redistribute only under the terms of the Artistic Licence, | |
6 | ?RCS: as specified in the README file that comes with the distribution. | |
7 | ?RCS: You may reuse parts of this distribution only within the terms of | |
8 | ?RCS: that same Artistic Licence; a copy of which may be found at the root | |
9 | ?RCS: of the source tree for dist 3.0. | |
10 | ?RCS: | |
11 | ?RCS: $Log: Getfile.U,v $ | |
12 | ?RCS: Revision 3.0.1.7 1997/02/28 15:01:06 ram | |
13 | ?RCS: patch61: getfile script now begins with "startsh" | |
14 | ?RCS: | |
15 | ?RCS: Revision 3.0.1.6 1995/02/15 14:11:00 ram | |
16 | ?RCS: patch51: was not working if ~'s allowed with d_portable on (WED) | |
17 | ?RCS: | |
18 | ?RCS: Revision 3.0.1.5 1995/01/11 15:11:25 ram | |
19 | ?RCS: patch45: added support for escaping answers to skip various checks | |
20 | ?RCS: patch45: modified message issued after file expansion | |
21 | ?RCS: | |
22 | ?RCS: Revision 3.0.1.4 1994/10/29 15:53:19 ram | |
23 | ?RCS: patch36: added ?F: line for metalint file checking | |
24 | ?RCS: | |
25 | ?RCS: Revision 3.0.1.3 1994/05/06 14:23:36 ram | |
26 | ?RCS: patch23: getfile could be confused by file name in "locate" requests | |
27 | ?RCS: patch23: new 'p' directive to assume file is in people's path (WED) | |
28 | ?RCS: | |
29 | ?RCS: Revision 3.0.1.2 1994/01/24 14:01:31 ram | |
30 | ?RCS: patch16: added metalint hint on changed 'ans' variable | |
31 | ?RCS: | |
32 | ?RCS: Revision 3.0.1.1 1993/09/13 15:46:27 ram | |
33 | ?RCS: patch10: minor format problems and misspellings fixed | |
34 | ?RCS: patch10: now performs from package dir and not from UU subdir | |
35 | ?RCS: | |
36 | ?RCS: Revision 3.0 1993/08/18 12:04:56 ram | |
37 | ?RCS: Baseline for dist 3.0 netwide release. | |
38 | ?RCS: | |
39 | ?X: | |
40 | ?X: This unit produces a bit of shell code that must be dotted in in order | |
41 | ?X: to get a file name and make some sanity checks. Optionally, a ~name | |
42 | ?X: expansion is performed. | |
43 | ?X: | |
44 | ?X: To use this unit, $rp and $dflt must hold the question and the | |
45 | ?X: default answer, which will be passed as-is to the myread script. | |
46 | ?X: The $fn variable must hold the file type (f or d, for file/directory). | |
47 | ?X: If $gfpth is set to a list of space-separated list of directories, | |
48 | ?X: those are prefixes for the filename. Unless $gfpthkeep is set to 'y', | |
49 | ?X: gfpth is cleared on return from Getfile. | |
50 | ?X: | |
51 | ?X: If is is followed by a ~, then ~name substitution will occur. Upon return, | |
52 | ?X: $ans is set with the filename value. If a / is specified, then only a full | |
53 | ?X: path name is accepted (but ~ substitution occurs before, if needed). The | |
54 | ?X: expanded path name is returned in that case. | |
55 | ?X: | |
56 | ?X: If a + is specified, the existence checks are skipped. This usually means | |
57 | ?X: the file/directory is under the full control of the program. | |
58 | ?X: | |
59 | ?X: If the 'n' (none) type is used, then the user may answer none. | |
60 | ?X: The 'e' (expand) switch may be used to bypass d_portable, expanding ~name. | |
61 | ?X: | |
62 | ?X: If the 'l' (locate) type is used, then it must end with a ':' and then a | |
63 | ?X: file name. If the answer is a directory, the file name will be appended | |
64 | ?X: before testing for file existence. This is useful in locate-style | |
65 | ?X: questions like "where is the active file?". In that case, one should | |
66 | ?X: use: | |
67 | ?X: | |
68 | ?X: dflt='~news/lib' | |
69 | ?X: fn='l~:active' | |
70 | ?X: rp='Where is the active file?' | |
71 | ?X: . ./getfile | |
72 | ?X: active="$ans" | |
73 | ?X: | |
74 | ?X: If the 'p' (path) letter is specified along with 'l', then an answer | |
75 | ?X: without a leading / will be expected to be found in everyone's path. | |
76 | ?X: | |
77 | ?X: It is also possible to include a comma-separated list of items within | |
78 | ?X: parentheses to specify which items should be accepted as-is with no | |
79 | ?X: further checks. This is useful when for instance a full path is expected | |
80 | ?X: but the user may escape out via "magical" answers. | |
81 | ?X: | |
82 | ?X: If the answer to the question is 'none', then the existence checks are | |
83 | ?X: skipped and the empty string is returned. | |
84 | ?X: | |
85 | ?MAKE:Getfile: d_portable contains startsh Myread Filexp trnl | |
86 | ?MAKE: -pick add $@ %< | |
87 | ?V:ansexp:fn gfpth gfpthkeep | |
88 | ?F:./getfile | |
89 | ?T:tilde type what orig_rp orig_dflt fullpath already redo skip none_ok \ | |
90 | value exp_file nopath_ok loc_file fp pf | |
91 | ?LINT:change ans | |
92 | ?LINT:change gfpth | |
93 | : now set up to get a file name | |
94 | cat <<EOS >getfile | |
95 | $startsh | |
96 | EOS | |
97 | cat <<'EOSC' >>getfile | |
98 | tilde='' | |
99 | fullpath='' | |
100 | already='' | |
101 | skip='' | |
102 | none_ok='' | |
103 | exp_file='' | |
104 | nopath_ok='' | |
105 | orig_rp="$rp" | |
106 | orig_dflt="$dflt" | |
107 | case "$gfpth" in | |
108 | '') gfpth='.' ;; | |
109 | esac | |
110 | ||
111 | ?X: Begin by stripping out any (...) grouping. | |
112 | case "$fn" in | |
113 | *\(*) | |
114 | expr $fn : '.*(\(.*\)).*' | tr ',' $trnl >getfile.ok | |
115 | fn=`echo $fn | sed 's/(.*)//'` | |
116 | ;; | |
117 | esac | |
118 | ||
119 | ?X: Catch up 'locate' requests early, so that we may strip the file name | |
120 | ?X: before looking at the one-letter commands, in case the file name contains | |
121 | ?X: one of them. Reported by Wayne Davison <davison@borland.com>. | |
122 | case "$fn" in | |
123 | *:*) | |
124 | loc_file=`expr $fn : '.*:\(.*\)'` | |
125 | fn=`expr $fn : '\(.*\):.*'` | |
126 | ;; | |
127 | esac | |
128 | ||
129 | case "$fn" in | |
130 | *~*) tilde=true;; | |
131 | esac | |
132 | case "$fn" in | |
133 | */*) fullpath=true;; | |
134 | esac | |
135 | case "$fn" in | |
136 | *+*) skip=true;; | |
137 | esac | |
138 | case "$fn" in | |
139 | *n*) none_ok=true;; | |
140 | esac | |
141 | case "$fn" in | |
142 | *e*) exp_file=true;; | |
143 | esac | |
144 | case "$fn" in | |
145 | *p*) nopath_ok=true;; | |
146 | esac | |
147 | ||
148 | case "$fn" in | |
149 | *f*) type='File';; | |
150 | *d*) type='Directory';; | |
151 | *l*) type='Locate';; | |
152 | esac | |
153 | ||
154 | what="$type" | |
155 | case "$what" in | |
156 | Locate) what='File';; | |
157 | esac | |
158 | ||
159 | case "$exp_file" in | |
160 | '') | |
161 | case "$d_portable" in | |
162 | "$define") ;; | |
163 | *) exp_file=true;; | |
164 | esac | |
165 | ;; | |
166 | esac | |
167 | ||
168 | cd .. | |
169 | while test "$type"; do | |
170 | redo='' | |
171 | rp="$orig_rp" | |
172 | dflt="$orig_dflt" | |
173 | case "$tilde" in | |
174 | true) rp="$rp (~name ok)";; | |
175 | esac | |
176 | . UU/myread | |
177 | ?X: check for allowed escape sequence which may be accepted verbatim. | |
178 | if test -f UU/getfile.ok && \ | |
179 | $contains "^$ans\$" UU/getfile.ok >/dev/null 2>&1 | |
180 | then | |
181 | value="$ans" | |
182 | ansexp="$ans" | |
183 | break | |
184 | fi | |
185 | case "$ans" in | |
186 | none) | |
187 | value='' | |
188 | ansexp='' | |
189 | case "$none_ok" in | |
190 | true) type='';; | |
191 | esac | |
192 | ;; | |
193 | *) | |
194 | case "$tilde" in | |
195 | '') value="$ans" | |
196 | ansexp="$ans";; | |
197 | *) | |
198 | value=`UU/filexp $ans` | |
199 | case $? in | |
200 | 0) | |
201 | if test "$ans" != "$value"; then | |
202 | echo "(That expands to $value on this system.)" | |
203 | fi | |
204 | ;; | |
205 | *) value="$ans";; | |
206 | esac | |
207 | ansexp="$value" | |
208 | case "$exp_file" in | |
209 | '') value="$ans";; | |
210 | esac | |
211 | ;; | |
212 | esac | |
213 | case "$fullpath" in | |
214 | true) | |
215 | ?X: Perform all the checks on ansexp and not value since when d_portable | |
216 | ?X: is defined, the original un-expanded answer which is stored in value | |
217 | ?X: would lead to "non-existent" error messages whilst ansexp has been | |
218 | ?X: properly expanded. -- Fixed by Jan.Djarv@sa.erisoft.se (Jan Djarv) | |
219 | ?X: Always expand ~user if '/' was requested | |
220 | case "$ansexp" in | |
221 | /*) value="$ansexp" ;; | |
222 | *) | |
223 | redo=true | |
224 | case "$already" in | |
225 | true) | |
226 | echo "I shall only accept a full path name, as in /bin/ls." >&4 | |
227 | echo "Use a ! shell escape if you wish to check pathnames." >&4 | |
228 | ;; | |
229 | *) | |
230 | echo "Please give a full path name, starting with slash." >&4 | |
231 | case "$tilde" in | |
232 | true) | |
233 | echo "Note that using ~name is ok provided it expands well." >&4 | |
234 | already=true | |
235 | ;; | |
236 | esac | |
237 | esac | |
238 | ;; | |
239 | esac | |
240 | ;; | |
241 | esac | |
242 | case "$redo" in | |
243 | '') | |
244 | case "$type" in | |
245 | File) | |
246 | for fp in $gfpth; do | |
247 | if test "X$fp" = X.; then | |
248 | pf="$ansexp" | |
249 | else | |
250 | pf="$fp/$ansexp" | |
251 | fi | |
252 | if test -f "$pf"; then | |
253 | type='' | |
254 | elif test -r "$pf" || (test -h "$pf") >/dev/null 2>&1 | |
255 | then | |
256 | echo "($value is not a plain file, but that's ok.)" | |
257 | type='' | |
258 | fi | |
259 | if test X"$type" = X; then | |
260 | value="$pf" | |
261 | break | |
262 | fi | |
263 | done | |
264 | ;; | |
265 | Directory) | |
266 | for fp in $gfpth; do | |
267 | if test "X$fp" = X.; then | |
268 | pf="$ansexp" | |
269 | else | |
270 | pf="$fp/$ansexp" | |
271 | fi | |
272 | if test -d "$pf"; then | |
273 | type='' | |
274 | value="$pf" | |
275 | break | |
276 | fi | |
277 | done | |
278 | ;; | |
279 | Locate) | |
280 | if test -d "$ansexp"; then | |
281 | echo "(Looking for $loc_file in directory $value.)" | |
282 | value="$value/$loc_file" | |
283 | ansexp="$ansexp/$loc_file" | |
284 | fi | |
285 | if test -f "$ansexp"; then | |
286 | type='' | |
287 | fi | |
288 | case "$nopath_ok" in | |
289 | true) case "$value" in | |
290 | */*) ;; | |
291 | *) echo "Assuming $value will be in people's path." | |
292 | type='' | |
293 | ;; | |
294 | esac | |
295 | ;; | |
296 | esac | |
297 | ;; | |
298 | esac | |
299 | ||
300 | case "$skip" in | |
301 | true) type=''; | |
302 | esac | |
303 | ||
304 | case "$type" in | |
305 | '') ;; | |
306 | *) | |
307 | if test "$fastread" = yes; then | |
308 | dflt=y | |
309 | else | |
310 | dflt=n | |
311 | fi | |
312 | rp="$what $value doesn't exist. Use that name anyway?" | |
313 | . UU/myread | |
314 | dflt='' | |
315 | case "$ans" in | |
316 | y*) type='';; | |
317 | *) echo " ";; | |
318 | esac | |
319 | ;; | |
320 | esac | |
321 | ;; | |
322 | esac | |
323 | ;; | |
324 | esac | |
325 | done | |
326 | cd UU | |
327 | ans="$value" | |
328 | rp="$orig_rp" | |
329 | dflt="$orig_dflt" | |
330 | rm -f getfile.ok | |
331 | test "X$gfpthkeep" != Xy && gfpth="" | |
332 | EOSC | |
333 |