! Copyright © Oracle Corporation 1995.  All Rights Reserved.
SUB ERROR_HANDLER(LONG RDB$STATUS, retry_count, success_flag, lock_error_flag)

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This subroutine handles run-time errors trapped by         ! 
! the ON ERROR clause in the sample RDBPRE BASIC programs.   !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

OPTION TYPE = EXPLICIT

DECLARE LONG 		return_status,		&
			seconds_to_wait

DECLARE STRING		error_record               

! Declare variables, symbolic error codes, and system
! service library routines.
      
EXTERNAL LONG CONSTANT	RDB$_STREAM_EOF,	&
			RDB$_DEADLOCK,		&
			RDB$_LOCK_CONFLICT,	&
			RDB$_INTEG_FAIL,	&
			RDB$_NO_DUP,		&
			RDO$_INDNOTDEF,		&
			RDB$_NO_RECORD,		&
			RDB$_NOT_VALID

EXTERNAL LONG FUNCTION 	RDB$SIGNAL,		&
			LIB$MATCH_COND,		&
			LIB$SIGNAL,		&
			LIB$CALLG,		&
			LIB$SYS_GETMSG

COMMON (Rdb$MESSAGE_VECTOR) INTEGER 	Rdb$MESSAGE_VECTOR, &
					Rdb$LU_STATUS, &
					Rdb$ALU_ARGUMENTS(17)

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(RDB$STATUS,		&
				RDB$_LOCK_CONFLICT,	&
				RDB$_DEADLOCK,		&
				RDB$_NO_DUP,		&
				RDB$_NOT_VALID,		&
				RDB$_INTEG_FAIL,	&
				RDB$_NO_RECORD)

! The CASE statement directs program to appropriate statements
! to execute depending on the error that 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 Record_deleted 
END SELECT
    
EXIT SUB

Unexpected_error:

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

return_status  = LIB$SYS_GETMSG(rdb$status BY REF,	&
				msg_len BY REF,		&
				msg_txt BY DESC,	&
				mask BY REF,		&
				out_array BY REF)
PRINT msg_txt
PRINT #1%,msg_txt
CLOSE #1%
return_status = LIB$CALLG(rdb$message_vector by ref,LOC(LIB$SIGNAL) by value)
RETURN



Lock_problem:

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

lock_error_flag = -1%
IF (retry_count > 5)
THEN 
	PRINT "Another user is accessing data you attempted to access"
	success_flag = 0%
ELSE 
	SLEEP seconds_to_wait
	retry_count = retry_count + 1%
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"

! Display the error message to see what index violated the
! duplicate clause.

CALL SYS$PUTMSG(Rdb$MESSAGE_VECTOR)

RETURN

Invalid_data:

PRINT "In the data you entered, you specified an invalid value"
PRINT

! Display the error message to see what data was invalid

CALL SYS$PUTMSG(Rdb$MESSAGE_VECTOR)

PRINT "Please correct the error and try again"
RETURN

Integrity_failure:

PRINT "In the data you entered, you violated a constraint"
PRINT

! Display error message to see cause the integrity failure.   

CALL SYS$PUTMSG(Rdb$MESSAGE_VECTOR)

PRINT "Please correct the error and try again"
RETURN

Record_deleted:

PRINT "Record entered has been deleted"
RETURN

END SUB