133 lines
3.9 KiB
Plaintext
133 lines
3.9 KiB
Plaintext
|
********************************************************************************
|
||
|
|
*
|
||
|
|
* Support of PR1ME INFORMATION suboutine '!VOC.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/14/98 23801 SAP Change copyrights.
|
||
|
|
* 10/01/93 12299 LA Initial implementation.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
* START-DESCRIPTION
|
||
|
|
*
|
||
|
|
* This subroutine allows the user to get either the DATA or DICT portion of a
|
||
|
|
* specified VOC entry as a fully qualified pathname.
|
||
|
|
*
|
||
|
|
* Multi-file DATA pathnames are returned as dynamic arrays, so dynamic
|
||
|
|
* array accessing will be needed to extract the separate paths, RESULT<1>,
|
||
|
|
* RESULT<2> etc.
|
||
|
|
*
|
||
|
|
* CALL !VOC.PATHNAME(DICT, VOCENTRYNAME, RESULT, STATUS)
|
||
|
|
*
|
||
|
|
* where DICT (I) IK$DICT, or 'DICT' - return the fully qualified
|
||
|
|
* pathname of the DICT portion
|
||
|
|
* of the specified VOC entry
|
||
|
|
* IK$DATA or '' - return the fully qualified
|
||
|
|
* pathname of the DATA portion
|
||
|
|
* of the specified VOC entry
|
||
|
|
* VOCENTRYNAME (I) is the VOC entryname
|
||
|
|
* RESULT (O) is the resultant pathname(s)
|
||
|
|
* STATUS (O) status of the operation:
|
||
|
|
* 0 = Success
|
||
|
|
* IE$PAR = Bad parameters given, either DICT
|
||
|
|
* or VOCENTRYNAME
|
||
|
|
* IE$VOC.OPEN.FAILED
|
||
|
|
* = Unable to open VOC file
|
||
|
|
* IE$RNF = VOC entry record not found
|
||
|
|
* IE$VNF = VOC entry not a file record
|
||
|
|
*
|
||
|
|
* END-DESCRIPTION
|
||
|
|
|
||
|
|
SUBROUTINE PR1ME(DICT.DATA, VOCENTRYNAME, VOC.PATH, STATUS)
|
||
|
|
|
||
|
|
$OPTIONS DEFAULT
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE INFO_ERRS.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE INFO_KEYS.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE UVKEYS.H
|
||
|
|
|
||
|
|
L.VOCNAME = VOCENTRYNAME
|
||
|
|
VOC.PATH = ''
|
||
|
|
STATUS = 0
|
||
|
|
|
||
|
|
PATHNAME = ''
|
||
|
|
UVPATH = "*UVPATHNAME"
|
||
|
|
|
||
|
|
IF LEN(L.VOCNAME) = 0 THEN
|
||
|
|
STATUS = IE$PAR
|
||
|
|
GOTO ERROR.EXIT
|
||
|
|
END
|
||
|
|
|
||
|
|
BEGIN CASE
|
||
|
|
CASE DICT.DATA = '' OR DICT.DATA = 'DATA' OR DICT.DATA = IK$DATA
|
||
|
|
FIELD.NO = 2
|
||
|
|
CASE DICT.DATA = 'DICT' OR DICT.DATA = IK$DICT
|
||
|
|
FIELD.NO = 3
|
||
|
|
CASE 1
|
||
|
|
STATUS = IE$PAR
|
||
|
|
GOTO ERROR.EXIT
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
* Open the VOC file and check that the record requested is a file record
|
||
|
|
|
||
|
|
OPEN 'VOC' TO VOC.FILE ELSE
|
||
|
|
STATUS = IE$VOC.OPEN.FAILED
|
||
|
|
GOTO ERROR.EXIT
|
||
|
|
END
|
||
|
|
|
||
|
|
READ RECORD FROM VOC.FILE, L.VOCNAME ELSE
|
||
|
|
STATUS = IE$RNF
|
||
|
|
GOTO ERROR.EXIT
|
||
|
|
END
|
||
|
|
|
||
|
|
IF RECORD<1>[1,1] = 'F' OR RECORD<1>[1,1] = 'f' THEN
|
||
|
|
|
||
|
|
* Expand path (multiple paths if multi-volumed file)
|
||
|
|
|
||
|
|
VOC.PATH = RECORD<FIELD.NO>
|
||
|
|
RESULT = ''
|
||
|
|
CALL @UVPATH(UVK$CREATEPATH, @PATH, VOC.PATH, RESULT, STATUS)
|
||
|
|
IF STATUS = IE$NOTRELATIVE
|
||
|
|
THEN
|
||
|
|
STATUS = 0
|
||
|
|
CALL @UVPATH(UVK$PATHNAME, VOC.PATH, '', RESULT, STATUS)
|
||
|
|
END
|
||
|
|
|
||
|
|
IF STATUS # 0 THEN GOTO ERROR.EXIT
|
||
|
|
|
||
|
|
VOC.PATH = RESULT
|
||
|
|
|
||
|
|
* If key is DATA and this is a multi-file record, then use what we
|
||
|
|
* have in VOC.PATH as the directory part and set up a multi-valued
|
||
|
|
* result using the values in field 8
|
||
|
|
|
||
|
|
IF FIELD.NO = 2 AND (RECORD<4> = 'M' OR RECORD<4> = 'm') THEN
|
||
|
|
BASE = VOC.PATH
|
||
|
|
VOC.PATH = ''
|
||
|
|
FILE.PATHS = RECORD<8>
|
||
|
|
FOR VALUE.NO = 1 TO DCOUNT(FILE.PATHS, @VM)
|
||
|
|
CALL @UVPATH(UVK$CREATEPATH, BASE, FILE.PATHS<1, VALUE.NO>,
|
||
|
|
RESULT, STATUS)
|
||
|
|
IF STATUS # 0 THEN GOTO ERROR.EXIT
|
||
|
|
VOC.PATH<1, VALUE.NO> = RESULT
|
||
|
|
NEXT VALUE.NO
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
STATUS = IE$VNF
|
||
|
|
END
|
||
|
|
|
||
|
|
ERROR.EXIT:
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|