RE: [perl #26136] localtime(3) calls tzset(3), but localtime_r(3) may not.

[metaconfig.git] / U / modified / Getfile.U

?RCS: $Id: Getfile.U,v 3.0.1.7 1997/02/28 15:01:06 ram Exp $
?RCS:
?RCS: Copyright (c) 1991-1993, Raphael Manfredi
?RCS: 
?RCS: You may redistribute only under the terms of the Artistic Licence,
?RCS: as specified in the README file that comes with the distribution.
?RCS: You may reuse parts of this distribution only within the terms of
?RCS: that same Artistic Licence; a copy of which may be found at the root
?RCS: of the source tree for dist 3.0.
?RCS:
?RCS: $Log: Getfile.U,v $
?RCS: Revision 3.0.1.7  1997/02/28  15:01:06  ram
?RCS: patch61: getfile script now begins with "startsh"
?RCS:
?RCS: Revision 3.0.1.6  1995/02/15  14:11:00  ram
?RCS: patch51: was not working if ~'s allowed with d_portable on (WED)
?RCS:
?RCS: Revision 3.0.1.5  1995/01/11  15:11:25  ram
?RCS: patch45: added support for escaping answers to skip various checks
?RCS: patch45: modified message issued after file expansion
?RCS:
?RCS: Revision 3.0.1.4  1994/10/29  15:53:19  ram
?RCS: patch36: added ?F: line for metalint file checking
?RCS:
?RCS: Revision 3.0.1.3  1994/05/06  14:23:36  ram
?RCS: patch23: getfile could be confused by file name in "locate" requests
?RCS: patch23: new 'p' directive to assume file is in people's path (WED)
?RCS:
?RCS: Revision 3.0.1.2  1994/01/24  14:01:31  ram
?RCS: patch16: added metalint hint on changed 'ans' variable
?RCS:
?RCS: Revision 3.0.1.1  1993/09/13  15:46:27  ram
?RCS: patch10: minor format problems and misspellings fixed
?RCS: patch10: now performs from package dir and not from UU subdir
?RCS:
?RCS: Revision 3.0  1993/08/18  12:04:56  ram
?RCS: Baseline for dist 3.0 netwide release.
?RCS:
?X: 
?X: This unit produces a bit of shell code that must be dotted in in order
?X: to get a file name and make some sanity checks. Optionally, a ~name
?X: expansion is performed.
?X:	
?X: To use this unit, $rp and $dflt must hold the question and the
?X: default answer, which will be passed as-is to the myread script.
?X: The $fn variable must hold the file type (f or d, for file/directory).
?X: If $gfpth is set to a list of space-separated list of directories,
?X: those are prefixes for the filename.  Unless $gfpthkeep is set to 'y',
?X: gfpth is cleared on return from Getfile.
?X:
?X: If is is followed by a ~, then ~name substitution will occur. Upon return,
?X: $ans is set with the filename value. If a / is specified, then only a full
?X: path name is accepted (but ~ substitution occurs before, if needed). The
?X: expanded path name is returned in that case.
?X:
?X: If a + is specified, the existence checks are skipped. This usually means
?X: the file/directory is under the full control of the program.
?X:
?X: If the 'n' (none) type is used, then the user may answer none.
?X: The 'e' (expand) switch may be used to bypass d_portable, expanding ~name.
?X:
?X: If the 'l' (locate) type is used, then it must end with a ':' and then a
?X:	file name. If the answer is a directory, the file name will be appended
?X: before testing for file existence. This is useful in locate-style
?X: questions like "where is the active file?". In that case, one should
?X: use:
?X:
?X:   dflt='~news/lib'
?X:   fn='l~:active'
?X:   rp='Where is the active file?'
?X:   . ./getfile
?X:   active="$ans"
?X: 
?X: If the 'p' (path) letter is specified along with 'l', then an answer
?X: without a leading / will be expected to be found in everyone's path.
?X:
?X: It is also possible to include a comma-separated list of items within
?X: parentheses to specify which items should be accepted as-is with no
?X: further checks. This is useful when for instance a full path is expected
?X: but the user may escape out via "magical" answers.
?X:
?X: If the answer to the question is 'none', then the existence checks are
?X:	skipped and the empty string is returned.
?X:
?MAKE:Getfile: d_portable contains startsh Myread Filexp tr trnl
?MAKE:	-pick add $@ %<
?V:ansexp:fn gfpth gfpthkeep
?F:./getfile
?T:tilde type what orig_rp orig_dflt fullpath already redo skip none_ok \
	value exp_file nopath_ok loc_file fp pf dir direxp
?LINT:change ans
?LINT:change gfpth
: now set up to get a file name
cat <<EOS >getfile
$startsh
EOS
cat <<'EOSC' >>getfile
tilde=''
fullpath=''
already=''
skip=''
none_ok=''
exp_file=''
nopath_ok=''
orig_rp="$rp"
orig_dflt="$dflt"
case "$gfpth" in
'') gfpth='.' ;;
esac

?X: Begin by stripping out any (...) grouping.
case "$fn" in
*\(*)
	: getfile will accept an answer from the comma-separated list
	: enclosed in parentheses even if it does not meet other criteria.
	expr "$fn" : '.*(\(.*\)).*' | $tr ',' $trnl >getfile.ok
	fn=`echo $fn | sed 's/(.*)//'`
	;;
esac

?X: Catch up 'locate' requests early, so that we may strip the file name
?X: before looking at the one-letter commands, in case the file name contains
?X: one of them. Reported by Wayne Davison <davison@borland.com>.
case "$fn" in
*:*)
	loc_file=`expr $fn : '.*:\(.*\)'`
	fn=`expr $fn : '\(.*\):.*'`
	;;
esac

case "$fn" in
*~*) tilde=true;;
esac
case "$fn" in
*/*) fullpath=true;;
esac
case "$fn" in
*+*) skip=true;;
esac
case "$fn" in
*n*) none_ok=true;;
esac
case "$fn" in
*e*) exp_file=true;;
esac
case "$fn" in
*p*) nopath_ok=true;;
esac

case "$fn" in
*f*) type='File';;
*d*) type='Directory';;
*l*) type='Locate';;
esac

what="$type"
case "$what" in
Locate) what='File';;
esac

case "$exp_file" in
'')
	case "$d_portable" in
	"$define") ;;
	*) exp_file=true;;
	esac
	;;
esac

cd ..
while test "$type"; do
	redo=''
	rp="$orig_rp"
	dflt="$orig_dflt"
	case "$tilde" in
	true) rp="$rp (~name ok)";;
	esac
	. UU/myread
?X: check for allowed escape sequence which may be accepted verbatim.
	if test -f UU/getfile.ok && \
		$contains "^$ans\$" UU/getfile.ok >/dev/null 2>&1
	then
		value="$ans"
		ansexp="$ans"
		break
	fi
	case "$ans" in
	none)
		value=''
		ansexp=''
		case "$none_ok" in
		true) type='';;
		esac
		;;
	*)
		case "$tilde" in
		'') value="$ans"
			ansexp="$ans";;
		*)
			value=`UU/filexp $ans`
			case $? in
			0)
				if test "$ans" != "$value"; then
					echo "(That expands to $value on this system.)"
				fi
				;;
			*) value="$ans";;
			esac
			ansexp="$value"
			case "$exp_file" in
			'') value="$ans";;
			esac
			;;
		esac
		case "$fullpath" in
		true)
?X: Perform all the checks on ansexp and not value since when d_portable
?X: is defined, the original un-expanded answer which is stored in value
?X: would lead to "non-existent" error messages whilst ansexp has been
?X: properly expanded. -- Fixed by Jan.Djarv@sa.erisoft.se (Jan Djarv)
?X: Always expand ~user if '/' was requested 
			case "$ansexp" in
			/*) value="$ansexp" ;;
			[a-zA-Z]:/*) value="$ansexp" ;;
			*)
				redo=true
				case "$already" in
				true)
				echo "I shall only accept a full path name, as in /bin/ls." >&4
				echo "Use a ! shell escape if you wish to check pathnames." >&4
					;;
				*)
				echo "Please give a full path name, starting with slash." >&4
					case "$tilde" in
					true)
				echo "Note that using ~name is ok provided it expands well." >&4
						already=true
						;;
					esac
				esac
				;;
			esac
			;;
		esac
		case "$redo" in
		'')
			case "$type" in
			File)
				for fp in $gfpth; do
					if test "X$fp" = X.; then
					    pf="$ansexp"
					else    
					    pf="$fp/$ansexp"
					fi
					if test -f "$pf"; then
						type=''
					elif test -r "$pf" || (test -h "$pf") >/dev/null 2>&1
					then
						echo "($value is not a plain file, but that's ok.)"
						type=''
					fi
					if test X"$type" = X; then
					    value="$pf"
					    break
					fi
				done
				;;
			Directory)
				for fp in $gfpth; do
					if test "X$fp" = X.; then
					    dir="$ans"
					    direxp="$ansexp"
					else    
					    dir="$fp/$ansexp"
					    direxp="$fp/$ansexp"
					fi
					if test -d "$direxp"; then
						type=''
						value="$dir"
						break
					fi
				done
				;;
			Locate)
				if test -d "$ansexp"; then
					echo "(Looking for $loc_file in directory $value.)"
					value="$value/$loc_file"
					ansexp="$ansexp/$loc_file"
				fi
				if test -f "$ansexp"; then
					type=''
				fi
				case "$nopath_ok" in
				true)	case "$value" in
					*/*) ;;
					*)	echo "Assuming $value will be in people's path."
						type=''
						;;
					esac
					;;
				esac
				;;
			esac

			case "$skip" in
			true) type='';
			esac

			case "$type" in
			'') ;;
			*)
				if test "$fastread" = yes; then
					dflt=y
				else
					dflt=n
				fi
				rp="$what $value doesn't exist.  Use that name anyway?"
				. UU/myread
				dflt=''
				case "$ans" in
				y*) type='';;
				*) echo " ";;
				esac
				;;
			esac
			;;
		esac
		;;
	esac
done
cd UU
ans="$value"
rp="$orig_rp"
dflt="$orig_dflt"
rm -f getfile.ok
test "X$gfpthkeep" != Xy && gfpth=""
EOSC