! Copyright © Oracle Corporation 1995.  All Rights Reserved.
SUB Callable_error_handler(	LONG error_status, 	&
				LONG retry_count, 	&
				LONG lock_error_flag)

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This subroutine is an error handler to handle                !
! run-time errors that occur during a call to RDB$INTERPRET.   !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

OPTION TYPE = EXPLICIT

! Declare variables, including symbolic error codes and 
! system service library routines.

DECLARE LONG 		return_status,		&
			seconds_to_wait

DECLARE STRING		error_record

EXTERNAL LONG CONSTANT	RDB$_STREAM_EOF,	&
			RDB$_DEADLOCK,		&
			RDB$_LOCK_CONFLICT,	&
			RDB$_INTEG_FAIL,	&
			RDB$_NO_DUP,		&
			RDO$_INDNOTDEF,		&
			RDB$_NOT_VALID

EXTERNAL LONG FUNCTION 	RDB$SIGNAL,		&
			LIB$MATCH_COND,		&
			SYS$GETMSG

MAP(getmsgvars) LONG	msg_id,		&
			msg_len,	&
		STRING	msg_txt = 132,	&
		LONG	mask,		&
		STRING	out_array = 4

seconds_to_wait = 5%
mask = 5%

Check_error:

! Use LIB$MATCH_COND to determine which of a series
! of errors might have occurred.

return_status  = Lib$match_cond(error_status,		&
				RDB$_DEADLOCK,		&
				RDB$_LOCK_CONFLICT,	&
				RDB$_NO_DUP,		&
				RDB$_NOT_VALID,		&
				RDB$_INTEG_FAIL,	&
				RDB$_STREAM_EOF)



! The CASE statement directs program logic to appropriate
! statements to execute depending on which error was
! trapped.

SELECT return_status
	CASE 0
		GOSUB Unexpected_error
	CASE 1 to 2
		GOSUB Lock_problem
	CASE 3
		GOSUB Duplicate_not_allowed
	CASE 4
		GOSUB Invalid_data
	CASE 5
		GOSUB Integrity_failure
	CASE 6
		GOSUB End_of_stream
END SELECT
    
EXIT SUB

Unexpected_error:

PRINT "Unexpected error - terminating program" 
OPEN "error.log" AS FILE 1%, ACCESS APPEND

return_status  = SYS$GETMSG(	error_status BY VALUE,	&
				msg_len BY REF,		&
				msg_txt BY DESC,	&
				mask BY VALUE,		&
				out_array BY REF)
PRINT msg_txt
PRINT #1%,msg_txt
CLOSE #1%
return_status = RDB$SIGNAL()
RETURN

Lock_problem:

! Invoked on lock conflict or deadlock.
! Retry 5 times before rolling back.

lock_error_flag = -1%
retry_count = retry_count + 1%
IF (retry_count > 5)
THEN 
	PRINT "Sorry, resources are not available, please retry later"
ELSE 
	PRINT "Others are using data that you want to access"
	PRINT "Trying to access data again..."
	SLEEP seconds_to_wait
END IF
RETURN

Duplicate_not_allowed:

PRINT "You attempted to insert a record with a value already on file"
PRINT
PRINT "Please choose a new value and try again"
RETURN

Invalid_data:

PRINT "In the data you entered, you specified an invalid value"
PRINT
PRINT "Please correct the error and try again"
RETURN

Integrity_failure:

PRINT "In the data you entered, you violated a constraint"
PRINT
PRINT "Please correct the error and try again"
RETURN

End_of_stream:

PRINT "There are no colleges that match that code"
RETURN

END SUB