| 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 tr 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 dir direxp |
| 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 | [a-zA-Z]:/*) value="$ansexp" ;; |
| 223 | *) |
| 224 | redo=true |
| 225 | case "$already" in |
| 226 | true) |
| 227 | echo "I shall only accept a full path name, as in /bin/ls." >&4 |
| 228 | echo "Use a ! shell escape if you wish to check pathnames." >&4 |
| 229 | ;; |
| 230 | *) |
| 231 | echo "Please give a full path name, starting with slash." >&4 |
| 232 | case "$tilde" in |
| 233 | true) |
| 234 | echo "Note that using ~name is ok provided it expands well." >&4 |
| 235 | already=true |
| 236 | ;; |
| 237 | esac |
| 238 | esac |
| 239 | ;; |
| 240 | esac |
| 241 | ;; |
| 242 | esac |
| 243 | case "$redo" in |
| 244 | '') |
| 245 | case "$type" in |
| 246 | File) |
| 247 | for fp in $gfpth; do |
| 248 | if test "X$fp" = X.; then |
| 249 | pf="$ansexp" |
| 250 | else |
| 251 | pf="$fp/$ansexp" |
| 252 | fi |
| 253 | if test -f "$pf"; then |
| 254 | type='' |
| 255 | elif test -r "$pf" || (test -h "$pf") >/dev/null 2>&1 |
| 256 | then |
| 257 | echo "($value is not a plain file, but that's ok.)" |
| 258 | type='' |
| 259 | fi |
| 260 | if test X"$type" = X; then |
| 261 | value="$pf" |
| 262 | break |
| 263 | fi |
| 264 | done |
| 265 | ;; |
| 266 | Directory) |
| 267 | for fp in $gfpth; do |
| 268 | if test "X$fp" = X.; then |
| 269 | dir="$ans" |
| 270 | direxp="$ansexp" |
| 271 | else |
| 272 | dir="$fp/$ansexp" |
| 273 | direxp="$fp/$ansexp" |
| 274 | fi |
| 275 | if test -d "$direxp"; then |
| 276 | type='' |
| 277 | value="$dir" |
| 278 | break |
| 279 | fi |
| 280 | done |
| 281 | ;; |
| 282 | Locate) |
| 283 | if test -d "$ansexp"; then |
| 284 | echo "(Looking for $loc_file in directory $value.)" |
| 285 | value="$value/$loc_file" |
| 286 | ansexp="$ansexp/$loc_file" |
| 287 | fi |
| 288 | if test -f "$ansexp"; then |
| 289 | type='' |
| 290 | fi |
| 291 | case "$nopath_ok" in |
| 292 | true) case "$value" in |
| 293 | */*) ;; |
| 294 | *) echo "Assuming $value will be in people's path." |
| 295 | type='' |
| 296 | ;; |
| 297 | esac |
| 298 | ;; |
| 299 | esac |
| 300 | ;; |
| 301 | esac |
| 302 | |
| 303 | case "$skip" in |
| 304 | true) type=''; |
| 305 | esac |
| 306 | |
| 307 | case "$type" in |
| 308 | '') ;; |
| 309 | *) |
| 310 | if test "$fastread" = yes; then |
| 311 | dflt=y |
| 312 | else |
| 313 | dflt=n |
| 314 | fi |
| 315 | rp="$what $value doesn't exist. Use that name anyway?" |
| 316 | . UU/myread |
| 317 | dflt='' |
| 318 | case "$ans" in |
| 319 | y*) type='';; |
| 320 | *) echo " ";; |
| 321 | esac |
| 322 | ;; |
| 323 | esac |
| 324 | ;; |
| 325 | esac |
| 326 | ;; |
| 327 | esac |
| 328 | done |
| 329 | cd UU |
| 330 | ans="$value" |
| 331 | rp="$orig_rp" |
| 332 | dflt="$orig_dflt" |
| 333 | rm -f getfile.ok |
| 334 | test "X$gfpthkeep" != Xy && gfpth="" |
| 335 | EOSC |
| 336 | |