tldm-universe/Ardent/UV/APP.PROGS/SQLINTCHK.B

117 lines
4.4 KiB
Plaintext
Raw Normal View History

2024-09-09 21:51:08 +00:00
******************************************************************************
*
* SQL Integrity Check 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/07/96 18144 CSM Generate error message if referential problem
* 07/02/93 11741 PVW Changed messages and call for error code 8
* 06/30/93 11741 PVW Made a few enhancements and comments
* 06/23/93 11741 PVW Handle SQL Integrity Constraint Checking.
*
*******************************************************************************
SUBROUTINE SqlIntegrityCheck(dynamic.array,file.var,key,file.name,io.var)
* io.var contains information passed to this subroutine by the calling
* routine. The value of io.var<1> determines what error messages are
* to be printed. A value of:
* 0 means do not print any error messages.
* 1 means print error messages (before write attempted)
* 2 means print error messages (after write attempted)
PrintStatus = io.var<1>
io.var = ICHECK(dynamic.array,file.var,key)
error.code = io.var<1>
IF error.code THEN
column = io.var<2>
IF column = -1 THEN
column = "(multi)"
END ELSE
IF column = 0 THEN column = "primary_key"
END
constraint = io.var<3>
BEGIN CASE
CASE error.code = 1 ;* SINGLEVALUED
IF PrintStatus THEN
* 'Integrity Constraint Violation, column %s, not SINGLEVALUED'
CALL *UVPRINTMSG(923001,column)
END
CASE error.code = 2 ;* NOT NULL failure
IF PrintStatus THEN
* 'Integrity Constraint Violation, column %s, NULL'
CALL *UVPRINTMSG(923002,column)
END
CASE error.code = 3 ;* NOT EMPTY failure
IF PrintStatus THEN
* 'Integrity Constraint Violation, column %s, EMPTY'
CALL *UVPRINTMSG(923003,column)
END
CASE error.code = 4 ;* ROWUNIQUE failure
IF PrintStatus THEN
* 'Integrity Constraint Violation, column %s, not ROWUNIQUE'
CALL *UVPRINTMSG(923005,column)
END
CASE error.code = 5 OR error.code = 6 ;* UNIQUE failure
IF PrintStatus THEN
* 'Integrity Constraint Violation, column %s, not UNIQUE'
CALL *UVPRINTMSG(923004,column)
END
CASE error.code = 7 ;* KEY ROWUNIQUE
IF PrintStatus THEN
* 'integrity constraint violation'
CALL *UVPRINTMSG(923000,"")
END
CASE error.code = 8 ;* CHECK CONSTRAINT
IF PrintStatus THEN
* 'Integrity Constraint Violation, constraint %s'
CALL *UVPRINTMSG(923007,constraint)
END
CASE error.code = 9 ;* PRIMARY KEY FAILURE
IF PrintStatus THEN
* 'Integrity Constraint Violation, key has too many fields'
CALL *UVPRINTMSG(923009,"")
END
CASE error.code = 10 ;* REFERENTIAL FAILURE
IF PrintStatus THEN
* 'Integrity Constraint Violation, column %s, REFERENTIAL'
CALL *UVPRINTMSG(923006,column)
END
CASE error.code = 11 ;* INVALID REFERENCED COLUMN VALUE
IF PrintStatus THEN
* 'Referenced column %s has invalid value, must be numeric'
CALL *UVPRINTMSG(923019,column)
END
CASE 1
IF PrintStatus THEN
* 'integrity constraint violation'
CALL *UVPRINTMSG(923000,"")
END
END CASE
IF PrintStatus THEN
IF PrintStatus = 2 THEN
* 'Write Aborted. '
CALL *UVPRINTMSG(923017,"")
END
file.name = trim(file.name)
* 'Filename : %s Key : %s'
CALL *UVPRINTMSG(923018,file.name:@fm:key)
END
END ELSE
io.var = ""
END
RETURN
END