313 lines
10 KiB
Plaintext
313 lines
10 KiB
Plaintext
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* UniVerse Objects ReadNamedField host subroutine
|
||
|
|
*
|
||
|
|
* 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.
|
||
|
|
* 08/13/96 16749 DW Return a status of 1 if field was not found in DICT.
|
||
|
|
* 08/08/96 19021 ALC Initialise the RSLT in case we leave with an error.
|
||
|
|
* 05/20/96 18472 PGW Added support for Pick-style dictionary entries
|
||
|
|
* 11/23/95 17679 GMM Module created (copied from the UV/NT version)
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* This subroutine is designed to be called from the ReadNamedField method
|
||
|
|
* of uniVerse Objects. It implements all the functions of ReadNamedField,
|
||
|
|
* because doing all this on the server is faster than having the client make
|
||
|
|
* repeated calls to get things done.
|
||
|
|
*
|
||
|
|
* Calling sequence:
|
||
|
|
*
|
||
|
|
* CALL -UVORNF(answer, file.name, lock.type, record.ID,
|
||
|
|
* field.name, status.value, code)
|
||
|
|
*
|
||
|
|
* answer will contain the result
|
||
|
|
*
|
||
|
|
* file.name is the name of the file to be read (would be nice to use
|
||
|
|
* the file descriptor opened by interCALL, but we can't)
|
||
|
|
*
|
||
|
|
* lock.type defines the type of lock required
|
||
|
|
*
|
||
|
|
* record.ID is the ID of the data record
|
||
|
|
*
|
||
|
|
* field.name is the name of the field required
|
||
|
|
*
|
||
|
|
* status.value is set to the STATUS() value when a record is locked
|
||
|
|
*
|
||
|
|
* code is set to a status code; 0 means success.
|
||
|
|
*
|
||
|
|
SUBROUTINE UVORNF(RSLT, FILE.NAME, LOCK.TYPE, RECORD.ID,
|
||
|
|
FIELD.NAME, STATUS.VALUE, CODE)
|
||
|
|
|
||
|
|
COMMON /UVOCOM/ UVO.FILE.OPEN,
|
||
|
|
UVO.FILE.NAME,
|
||
|
|
UVO.DATA.FILE,
|
||
|
|
UVO.DICT.FILE,
|
||
|
|
UVO.RECORD.ID,
|
||
|
|
UVO.DATA.RECORD,
|
||
|
|
UVO.FIELD.NAME,
|
||
|
|
UVO.DICT.RECORD
|
||
|
|
|
||
|
|
* Key values used. The values of these tokens *must* agree with the
|
||
|
|
* corresponding tokens in INTCALL.TXT.
|
||
|
|
EQU IK$READ TO 0
|
||
|
|
EQU IK$READU TO 2
|
||
|
|
EQU IK$READUW TO 3
|
||
|
|
EQU IK$READL TO 4
|
||
|
|
EQU IK$READLW TO 5
|
||
|
|
|
||
|
|
* Error codes used. The values of these tokens *must* agree with the
|
||
|
|
* corresponding tokens in UVOAIF.TXT.
|
||
|
|
EQU UVE$RNF TO 30001
|
||
|
|
EQU UVE$LCK TO 30002
|
||
|
|
EQU UVE$NVR TO 31000
|
||
|
|
EQU UVE$BADPARAM TO 40003
|
||
|
|
EQU UVE$INVALID.DATAFIELD TO 40007
|
||
|
|
EQU UVE$BAD.DICTIONARY.ENTRY TO 40008
|
||
|
|
EQU UVE$BAD.CONVERSION.DATA TO 40009
|
||
|
|
EQU UVS$RNF.RNF.DICT TO 1
|
||
|
|
|
||
|
|
CODE = 0
|
||
|
|
STATUS.VALUE = 0
|
||
|
|
RSLT = 0
|
||
|
|
|
||
|
|
* Check to see if this is the same file as last time. If so, don't
|
||
|
|
* bother to open it again.
|
||
|
|
IF UVO.FILE.OPEN AND UVO.FILE.NAME = FILE.NAME THEN
|
||
|
|
* ok, we can use this one
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
GOSUB OPEN.FILES
|
||
|
|
IF CODE THEN RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
* Read the data record. Don't cache it, because it may have changed,
|
||
|
|
* and because the lock type required may be different.
|
||
|
|
UVO.RECORD.ID = RECORD.ID
|
||
|
|
GOSUB READ.DATA.RECORD
|
||
|
|
IF CODE THEN RETURN
|
||
|
|
|
||
|
|
* Check to see if this is the same field as last time. If so, there
|
||
|
|
* is no need to read the dictionary again.
|
||
|
|
IF FIELD.NAME # UVO.FIELD.NAME THEN
|
||
|
|
UVO.FIELD.NAME = FIELD.NAME
|
||
|
|
READ UVO.DICT.RECORD FROM UVO.DICT.FILE, FIELD.NAME
|
||
|
|
ELSE
|
||
|
|
UVO.FIELD.NAME = ""
|
||
|
|
CODE = UVE$RNF
|
||
|
|
* indicate the problem is in the DICT
|
||
|
|
STATUS.VALUE = UVS$RNF.RNF.DICT
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
* Now for the actual evaluation.
|
||
|
|
FIELD.TYPE = UVO.DICT.RECORD[1, 1]
|
||
|
|
BEGIN CASE
|
||
|
|
CASE FIELD.TYPE = "D"
|
||
|
|
FIELD.LOC = UVO.DICT.RECORD<2>
|
||
|
|
FIELD.CONV = UVO.DICT.RECORD<3>
|
||
|
|
IF LEN(FIELD.LOC) = 0 OR NOT(NUM(FIELD.LOC)) THEN
|
||
|
|
UVO.FIELD.NAME = ""
|
||
|
|
CODE = UVE$BAD.DICTIONARY.ENTRY
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF FIELD.LOC = 0 THEN
|
||
|
|
RSLT = UVO.RECORD.ID
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
RSLT = UVO.DATA.RECORD<FIELD.LOC>
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE FIELD.TYPE = "I"
|
||
|
|
FIELD.CONV = UVO.DICT.RECORD<3>
|
||
|
|
* Check that the I-descriptor has been compiled.
|
||
|
|
IF INDEX(UVO.DICT.RECORD, @FM, 15) <= 0 THEN
|
||
|
|
UVO.FIELD.NAME = ""
|
||
|
|
CODE = UVE$BAD.DICTIONARY.ENTRY
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
@ID = UVO.RECORD.ID
|
||
|
|
@RECORD = UVO.DATA.RECORD
|
||
|
|
RSLT = ITYPE(UVO.DICT.RECORD)
|
||
|
|
|
||
|
|
CASE FIELD.TYPE = "A" OR FIELD.TYPE = "S"
|
||
|
|
FIELD.LOC = UVO.DICT.RECORD<2>
|
||
|
|
FIELD.CONV = UVO.DICT.RECORD<7>
|
||
|
|
FIELD.CORREL = UVO.DICT.RECORD<8>
|
||
|
|
IF LEN(FIELD.LOC) = 0 OR NOT(NUM(FIELD.LOC)) THEN
|
||
|
|
RSLT = UVO.RECORD.ID
|
||
|
|
END
|
||
|
|
ELSE IF FIELD.LOC = 0 THEN
|
||
|
|
RSLT = UVO.RECORD.ID
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
RSLT = UVO.DATA.RECORD<FIELD.LOC>
|
||
|
|
END
|
||
|
|
IF LEN(FIELD.CORREL) > 0 THEN
|
||
|
|
@ID = UVO.RECORD.ID
|
||
|
|
@RECORD = UVO.DATA.RECORD
|
||
|
|
RSLT = OCONVS(RSLT, FIELD.CORREL)
|
||
|
|
IF STATUS() = 1 THEN
|
||
|
|
CODE = UVE$BAD.CONVERSION.DATA
|
||
|
|
RSLT = ""
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF STATUS() = 2 THEN
|
||
|
|
UVO.FIELD.NAME = ""
|
||
|
|
CODE = UVE$BAD.DICTIONARY.ENTRY
|
||
|
|
RSLT = ""
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE 1
|
||
|
|
UVO.FIELD.NAME = ""
|
||
|
|
CODE = UVE$BAD.DICTIONARY.ENTRY
|
||
|
|
RETURN
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
IF LEN(FIELD.CONV) > 0 AND LEN(RSLT) > 0 THEN
|
||
|
|
RSLT = OCONVS(RSLT, FIELD.CONV)
|
||
|
|
* Check for invalid conversion?
|
||
|
|
IF STATUS() = 1 THEN
|
||
|
|
CODE = UVE$BAD.CONVERSION.DATA
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF STATUS() = 2 THEN
|
||
|
|
UVO.FIELD.NAME = ""
|
||
|
|
CODE = UVE$BAD.DICTIONARY.ENTRY
|
||
|
|
RSLT = ""
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
********************************************************************************
|
||
|
|
*
|
||
|
|
OPEN.FILES:
|
||
|
|
*
|
||
|
|
* Opening a new file. Both dictionary and data portions are needed.
|
||
|
|
*
|
||
|
|
* Clear all the common variables, to force reading
|
||
|
|
* of both data and dictionary records.
|
||
|
|
UVO.FILE.OPEN = 0
|
||
|
|
UVO.FILE.NAME = ""
|
||
|
|
UVO.DATA.FILE = ""
|
||
|
|
UVO.DICT.FILE = ""
|
||
|
|
UVO.RECORD.ID = ""
|
||
|
|
UVO.DATA.RECORD = ""
|
||
|
|
UVO.FIELD.NAME = ""
|
||
|
|
UVO.DICT.RECORD = ""
|
||
|
|
RSLT = ""
|
||
|
|
|
||
|
|
IF FILE.NAME[1,5] = "DICT " THEN
|
||
|
|
DATA.FILE.NAME = FILE.NAME[6, LEN(FILE.NAME)]
|
||
|
|
DATA.FILE.FLAG = "DICT"
|
||
|
|
DICT.FILE.NAME = "DICT.DICT"
|
||
|
|
DICT.FILE.FLAG = ""
|
||
|
|
END ELSE
|
||
|
|
DATA.FILE.NAME = FILE.NAME
|
||
|
|
DATA.FILE.FLAG = ""
|
||
|
|
DICT.FILE.NAME = FILE.NAME
|
||
|
|
DICT.FILE.FLAG = "DICT"
|
||
|
|
END
|
||
|
|
|
||
|
|
OPEN DATA.FILE.FLAG, DATA.FILE.NAME TO UVO.DATA.FILE ELSE
|
||
|
|
* The client has already opened this file before ReadNamedField
|
||
|
|
* is called, so there is no way this can fail unless something
|
||
|
|
* is badly wrong.
|
||
|
|
CODE = UVE$BADPARAM
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
OPEN DICT.FILE.FLAG, DICT.FILE.NAME TO UVO.DICT.FILE ELSE
|
||
|
|
* This code cannot tell what the actual error was
|
||
|
|
CODE = UVE$NVR
|
||
|
|
UVO.DATA.FILE = ""
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
UVO.FILE.OPEN = 1
|
||
|
|
UVO.FILE.NAME = FILE.NAME
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
********************************************************************************
|
||
|
|
*
|
||
|
|
READ.DATA.RECORD:
|
||
|
|
*
|
||
|
|
* Read the data record required, honouring any locking requested by the client.
|
||
|
|
*
|
||
|
|
BEGIN CASE
|
||
|
|
|
||
|
|
CASE LOCK.TYPE = IK$READ
|
||
|
|
* Read without any locking at all
|
||
|
|
READ UVO.DATA.RECORD FROM UVO.DATA.FILE, UVO.RECORD.ID
|
||
|
|
ELSE
|
||
|
|
CODE = UVE$RNF
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE LOCK.TYPE = IK$READU
|
||
|
|
* Read with READU lock, and don't wait if locked
|
||
|
|
READU UVO.DATA.RECORD FROM UVO.DATA.FILE, UVO.RECORD.ID
|
||
|
|
LOCKED
|
||
|
|
CODE = UVE$LCK
|
||
|
|
STATUS.VALUE = STATUS()
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
CODE = UVE$RNF
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE LOCK.TYPE = IK$READUW
|
||
|
|
* Read with READU lock, and wait if locked
|
||
|
|
READU UVO.DATA.RECORD FROM UVO.DATA.FILE, UVO.RECORD.ID
|
||
|
|
ELSE
|
||
|
|
CODE = UVE$RNF
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE LOCK.TYPE = IK$READL
|
||
|
|
* Read with READL lock, and don't wait if locked
|
||
|
|
READL UVO.DATA.RECORD FROM UVO.DATA.FILE, UVO.RECORD.ID
|
||
|
|
LOCKED
|
||
|
|
CODE = UVE$LCK
|
||
|
|
STATUS.VALUE = STATUS()
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
CODE = UVE$RNF
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE LOCK.TYPE = IK$READLW
|
||
|
|
* Read with READL lock, and wait if locked
|
||
|
|
READL UVO.DATA.RECORD FROM UVO.DATA.FILE, UVO.RECORD.ID
|
||
|
|
ELSE
|
||
|
|
CODE = UVE$RNF
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE 1
|
||
|
|
CODE = UVE$BADPARAM
|
||
|
|
RETURN
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|
||
|
|
|