tldm-universe/Ardent/UV/APP.PROGS/MAKE.PATH.B

75 lines
2.5 KiB
Plaintext
Raw Permalink Normal View History

2024-09-09 21:51:08 +00:00
********************************************************************************
*
* Support of PR1ME INFORMATION subtroutine '!MAKE.PATHNAME'
*
* 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/13/98 23801 RGA Change copyright info.
* 09/28/93 12299 LA Initial implementation.
*
*******************************************************************************
* START-DESCRIPTION
*
* This routine allows users to do the following:
*
* - make a pathname from two halves, so long as the second is a
* relative path
* - fully qualify a pathname
* - return the current attach point
*
* CALL !MAKE.PATHNAME(PATH1, PATH2, RESULT, STATUS)
*
* where PATH1 (I) pathname 1 (directoryname or entryname)
* PATH2 (I) pathname 2 (directoryname or entryname)
* (NOTE: if only one of PATH1 or PATH2 is given,
* !MAKE.PATHNAME will return it in its
* fully qualified state, the entryname of
* the pathname does not have to exist.
* If both PATH1 and PATH2 are NULL, then
* !MAKE.PATHNAME will return the current
* attach point)
* RESULT (O) is the resultant pathname
* STATUS (O) returned status of the operation:
* 0 = Success
* IE$NOTRELATIVE = PATH2 was not a relative
* pathname when trying to
* create from two halves
* END-DESCRIPTION
*
SUBROUTINE PR1ME(PATH1, PATH2, RESULT, STATUS)
$OPTIONS DEFAULT
$INCLUDE UNIVERSE.INCLUDE UVKEYS.H
$INCLUDE UNIVERSE.INCLUDE INFO_ERRS.H
L.PATH1 = PATH1
L.PATH2 = PATH2
RESULT = ''
STATUS = 0
UVPATHNAME = "*UVPATHNAME"
BEGIN CASE
CASE (LEN(L.PATH1) > 0) AND (LEN(L.PATH2) > 0)
CALL @UVPATHNAME(UVK$CREATEPATH, L.PATH1, L.PATH2, RESULT, STATUS)
CASE (LEN(L.PATH1) > 0) AND (LEN(L.PATH2) = 0)
CALL @UVPATHNAME(UVK$PATHNAME, L.PATH1, '', RESULT, STATUS)
CASE (LEN(L.PATH2) > 0) AND (LEN(L.PATH1) = 0)
CALL @UVPATHNAME(UVK$PATHNAME, L.PATH2, '', RESULT, STATUS)
CASE (LEN(L.PATH1) = 0) AND (LEN(L.PATH2) = 0)
CALL @UVPATHNAME(UVK$CURRENTPATH, '', '', RESULT, STATUS)
END CASE
RETURN
END