311 lines
9.0 KiB
Plaintext
Executable File
311 lines
9.0 KiB
Plaintext
Executable File
********************************************************************************
|
|
*
|
|
* Subroutine to perform pathname manipulation
|
|
*
|
|
* Module %M% Version %I% Date %H%
|
|
*
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
|
* The copyright notice above does not evidence any actual or intended
|
|
* publication of such source code.
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
* Maintenence log - insert most recent change descriptions at top
|
|
*
|
|
* Date.... GTAR# WHO Description.........................................
|
|
* 10/14/98 23801 SAP Change copyrights.
|
|
* 10/03/96 19383 DJD Fix handling of drive letters.
|
|
* 07/30/96 18934 RKM Directory separator preserved in do.extractdir when
|
|
* pathname is '/' or '\'.
|
|
* 06/06/96 18438 JC Port to NT
|
|
* 03/13/96 17797 AGM Replace 'SH -c' with OS.EXEC
|
|
* 09/23/93 12299 LA Initial implementation.
|
|
*
|
|
*******************************************************************************
|
|
* START-DESCRIPTION:
|
|
*
|
|
* CALL *UVPATHNAME(KEY, PATHNAME, ENTRYNAME, RETURN_PATH, STATUS)
|
|
*
|
|
* where:
|
|
*
|
|
* KEY (I) UVK$CREATEPATH - create the pathname from
|
|
* pathname/entryname specified
|
|
* UVK$EXTRACTDIR - extract the directory
|
|
* portion of a pathname
|
|
* UVK$EXTRACTENTRY - extract the entryname
|
|
* portion of a pathname
|
|
* UVK$CURRENTPATH - return the full pathname
|
|
* of the current attach point
|
|
* UVK$PATHNAME - return fully qualified
|
|
* pathname
|
|
* UVK$ISRELATIVEPATH - return indication of whether
|
|
* pathname is relative or not
|
|
* PATHNAME (I) is the input pathname 1
|
|
* ENTRYNAME (I) is the input pathname 2, if required
|
|
* RETURN_PATH (O) is where the resultant pathname is returned
|
|
* STATUS (O) is the status of the operation
|
|
*
|
|
* PLEASE NOTE : As this runs on NT and UNIX, note that you need to check
|
|
* for '/' and '\'.
|
|
*
|
|
* END-DESCRIPTION
|
|
*
|
|
|
|
$OPTIONS DEFAULT
|
|
|
|
subroutine UVPATHNAME(key, path1, path2, return.path, status)
|
|
|
|
$INCLUDE UNIVERSE.INCLUDE UVKEYS.H
|
|
$INCLUDE UNIVERSE.INCLUDE INFO_ERRS.H
|
|
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
|
|
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
|
|
|
|
status = 0
|
|
return.path = ""
|
|
|
|
execute OS.EXEC:" '":PWD.CMD:"'" capturing cwd
|
|
cwd = cwd<1>
|
|
|
|
BEGIN CASE
|
|
CASE key = UVK$CREATEPATH
|
|
GOSUB do.createpath
|
|
CASE key = UVK$EXTRACTENTRY
|
|
GOSUB do.extractentry
|
|
CASE key = UVK$EXTRACTDIR
|
|
GOSUB do.extractdir
|
|
CASE key = UVK$PATHNAME
|
|
GOSUB do.pathname
|
|
CASE key = UVK$CURRENTPATH
|
|
return.path = cwd
|
|
CASE 1
|
|
return.path = ''
|
|
END CASE
|
|
RETURN
|
|
|
|
******************************************************************************
|
|
* do.createpath subroutine:
|
|
*
|
|
* if just pathname supplied, return it
|
|
* if just entry name supplied, return error if not relative, otherwise
|
|
* return fully qualified path
|
|
* if neither supplied, return error
|
|
* if both supplied, return error if entryname not relative, otherwise
|
|
* catenate & return
|
|
*
|
|
******************************************************************************
|
|
do.createpath:
|
|
IF path1 NE '' THEN
|
|
pathname = path1
|
|
IF path2 NE '' THEN
|
|
|
|
* Only add delimeter if PATHNAME not root symbol
|
|
|
|
IF path1 NE "/" and path1 NE "\" THEN pathname := UV.FSEP
|
|
BEGIN CASE
|
|
CASE path2[1,1] = "/" or path2[1,1] = "\" or path2[2,2] = ":\"
|
|
status = IE$NOTRELATIVE
|
|
CASE path2[1,2] = "./" or path2[1,2] = ".\"
|
|
temp.len = LEN(path2)
|
|
pathname := path2[3, temp.len - 2]
|
|
CASE 1
|
|
pathname := path2
|
|
END CASE
|
|
END ;* path2 supplied
|
|
END ELSE ;* path1 not supplied
|
|
IF path2 NE '' THEN
|
|
IF path2[1,1] = "/" or path2[1,1] = "\" or path2[2,2] = ":\" THEN
|
|
status = IE$NOTRELATIVE
|
|
END ELSE
|
|
pathname = path2
|
|
END
|
|
END ELSE status = IE$PAR
|
|
END
|
|
IF status = 0 THEN
|
|
GOSUB compress.path
|
|
return.path = pathname
|
|
END
|
|
RETURN
|
|
|
|
******************************************************************************
|
|
* do.extractentry subroutine:
|
|
*
|
|
* Returns the entryname part of the path1 argument.
|
|
* If no path1 argument supplied, then returns error
|
|
*
|
|
******************************************************************************
|
|
do.extractentry:
|
|
IF path1 = '' THEN status = IE$PAR
|
|
ELSE
|
|
num.delimeters = COUNT(convert('\','/',path1), "/")
|
|
IF num.delimeters = 0 THEN return.path = path1
|
|
ELSE
|
|
pathname = path1
|
|
GOSUB compress.path
|
|
pos = INDEX(convert('\','/',pathname), "/", num.delimeters)
|
|
pathlen = LEN(pathname)
|
|
return.path = pathname[pos + 1, pathlen - pos]
|
|
END
|
|
END
|
|
RETURN
|
|
|
|
******************************************************************************
|
|
* do.extractdir subroutine:
|
|
*
|
|
* Returns directory part of path1 argument.
|
|
* If no path1 argument supplied, returns error.
|
|
*
|
|
******************************************************************************
|
|
do.extractdir:
|
|
IF path1 = '' THEN status = IE$PAR
|
|
ELSE
|
|
num.delimeters = COUNT(convert('\','/',path1), "/")
|
|
BEGIN CASE
|
|
CASE num.delimeters = 0
|
|
return.path = '.'
|
|
CASE num.delimeters = 1 and (path1[1,1] = "/" or path1[1,1] = "\")
|
|
return.path = path1[1,1]
|
|
CASE 1
|
|
pathname = path1
|
|
GOSUB compress.path
|
|
pos = INDEX(convert('\','/',pathname), "/", num.delimeters)
|
|
pathlen = LEN(pathname)
|
|
return.path = pathname[1, pos - 1]
|
|
END CASE
|
|
END
|
|
RETURN
|
|
|
|
******************************************************************************
|
|
* do.pathname subroutine:
|
|
*
|
|
* Returns path1 argument as a fully qualified pathname.
|
|
* If no path1 argument supplied, returns error.
|
|
*
|
|
******************************************************************************
|
|
do.pathname:
|
|
IF path1 = '' THEN status = IE$PAR
|
|
ELSE
|
|
BEGIN CASE
|
|
CASE path1[1,1] = "/" or path1[1,1] = "\"
|
|
pathname = path1
|
|
CASE path1[1,2] = "./" or path1[1,2] = ".\"
|
|
pathname = cwd: path1[2, LEN(path1) - 1]
|
|
CASE path1[1,3] = "../" or path1[1,3] = "..\"
|
|
cwd.len = LEN(cwd)
|
|
LOOP
|
|
cwd.len -= 1
|
|
UNTIL (cwd[cwd.len,1] = "/" or cwd[cwd.len,1] = "\") REPEAT
|
|
pathname = cwd[1,cwd.len]: path1[4,LEN(path1)-3]
|
|
CASE 1
|
|
pathname = cwd:UV.FSEP:path1
|
|
END CASE
|
|
gosub compress.path
|
|
return.path = pathname
|
|
END
|
|
|
|
RETURN
|
|
|
|
******************************************************************************
|
|
* compress.path subroutine:
|
|
*
|
|
* Resolves any imbedded ./ or ../ in the pathname
|
|
*
|
|
******************************************************************************
|
|
compress.path:
|
|
|
|
* Handle special case where path just consists of root symbol
|
|
|
|
if pathname = "/" or pathname = "\" then return
|
|
|
|
* Now handle other cases
|
|
|
|
num.parts = dcount(convert('\','/',pathname), "/")
|
|
path = convert("/", @FM, pathname)
|
|
path = convert("\", @FM, path)
|
|
pathname = ''
|
|
temp.path = ''
|
|
absolute = 0
|
|
|
|
* Handle start of path first
|
|
|
|
part = path<1>
|
|
pathpart = 1
|
|
partno = 1
|
|
stop.part = 0
|
|
begin case
|
|
case part = "."
|
|
pathname<pathpart> = part
|
|
pathpart += 1
|
|
partno += 1
|
|
stop.part = 1
|
|
case part = ""
|
|
pathname<pathpart> = part
|
|
pathpart += 1
|
|
partno += 1
|
|
stop.part = 1
|
|
absolute = 1
|
|
case part = ".."
|
|
loop
|
|
while part = ".." or part = "."
|
|
if part = ".."
|
|
then
|
|
pathname<pathpart> = part
|
|
pathpart += 1
|
|
end
|
|
partno += 1
|
|
part = path<partno>
|
|
repeat
|
|
stop.part = pathpart - 1
|
|
case 1
|
|
pathname<pathpart> = part
|
|
pathpart += 1
|
|
partno += 1
|
|
end case
|
|
|
|
* Now do the rest of it
|
|
|
|
for partno = partno to num.parts
|
|
part = path<partno>
|
|
begin case
|
|
case part = "."
|
|
;* do nothing
|
|
case part = ".."
|
|
pathpart -= 1
|
|
if pathpart = stop.part then
|
|
if absolute then
|
|
pathpart = stop.part + 1
|
|
end else
|
|
pathname<pathpart + 1> = part
|
|
pathpart += 2
|
|
stop.part += 1
|
|
end
|
|
end
|
|
case part = ''
|
|
;* do nothing
|
|
case 1
|
|
if pathpart > stop.part then
|
|
pathname<pathpart> = part
|
|
pathpart += 1
|
|
end else
|
|
print "Error"
|
|
end
|
|
end case
|
|
next partno
|
|
|
|
* Get rid of any extraneous bits
|
|
|
|
for partno = 1 to pathpart - 1
|
|
temp.path<partno> = pathname<partno>
|
|
next partno
|
|
|
|
* Convert from dynamic array back to pathname
|
|
|
|
pathname = convert(@FM, "/", temp.path)
|
|
pathname = convert(@FM, "\", pathname)
|
|
|
|
if pathname = "" then pathname = "."
|
|
|
|
RETURN
|
|
END
|
|
|