********************************************************************************
*
*	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