Subject: Wich constraint was violated (I4GL) ?
From: [email-masked] (Jack Parker)
Date: 13 Jun 1995 19:33:03 -0400
Newsgroups: comp.databases.informix

> 
> 
> 
> Hi there,
> 
> Is there a way in I-4GL to know wich CONSTRAINT has been violated (I don't 
> want to place it in errorlog) ?
> 

The following is an error routine that I modified from one of Peter 
Botcherby's.  It traps constraint errors and identifies the constraint which
failed (by text - not name).  I'm not including the form in question - it's
a very simple form - one display field with 6 lines and wordwrap compress.

------
###############################################################################
#
# errlib.4gl : error library routines.
#
# Called by:    N/A
#
# Syntax:       N/A
#
# Dependencies: None.
#
# Calls:        Nobody
#
# Returns:      N/A
#
# Included routines:
#
#		err_rtn()	error handler
#
#		ident_constr()	identify constraint in error
#
#		idx_parts()	rebuild text of check constraint
#
#
{$Log:	errlib.4gl,v $
Revision 1.2  95/05/26  16:54:29  16:54:29  jparker (Jack Parker)
corrected a typo in a comment which cause a compile failure.

Revision 1.1  95/05/26  15:21:29  15:21:29  jparker (Jack Parker)
Initial revision

}
#
###############################################################################

GLOBALS "dwglob.4gl"

# The above Includes:
# 	DEFINE	logfle	CHAR(80)
# 	DEFINE	admin	CHAR(80)

##############################################################################
# Routine    :	err_rtn
#
# Purpose    :	This function is called "WHENEVER ERROR" error is encountered
#		It will record the error, notify the user and exit gracefully
#
# Arguments  :	none
#
# Returns    :	After constraint errors only.
##############################################################################
function err_rtn()
	define sql_err			smallint
	define str			char(255)
	define ans			char(1)
	define strx			char(80)
	define errm			char(80)
	define cmd_string		char(80)
	define frm_title		char(80)
	define sql_stmt			CHAR(400)

# logfle is defined in the globals.  Supposedly also set on a program by
# program basis before it gets here.  If it wasn't then we need to do 
# something.

        IF LENGTH(logfle) = 0 THEN 
           LET logfle = "/tmp/errmsg"
        END IF

# admin was also set in set_glob() by each program.  In case it wasn't...
	
	IF LENGTH(admin) = 0 THEN
 	   LET admin = "[email-masked]"
	END IF

	WHENEVER ERROR STOP	#THIS MUST BE STOP - as it cannot call itself!!!

# retreive the error info

	let sql_err = status
	let errm = sqlca.sqlerrm

	call err_get(sql_err) returning str

# format the error details into the error message
        LET str=fmt_err(str, errm, "", "", "")

# tack on some extra info:		program name
	let strx = arg_val(0)	# executable name

#					version info on program
        LET cmd_string = 'what ', strx clipped, '>> ', logfle clipped
        RUN cmd_string

#					who was running it.
        LET cmd_string = 'logname >> ', logfle clipped
        RUN cmd_string

#					platform info
        LET cmd_string = 'uname -a >> ', logfle clipped
        RUN cmd_string

#					program name report
	let strx = "Error occured running: ", strx clipped
	call errorlog(strx)
# 					close the error log and mail it.
	let strx = "===END ERROR=^^==========================================="
	call errorlog(strx)

        LET cmd_string = 'mailx -s "Error Log" ' , admin clipped, '<',
                         logfle clipped
        RUN cmd_string

# clear the error log.
        LET cmd_string = 'cat /dev/null > ', logfle clipped
        RUN cmd_string

# Display the error
	open window w_err at 2,3 with FORM "dsp_msg" 
		attribute (border, prompt line last, form line first)
        LET frm_title = "  INFORMIX ERROR # ", sql_err
        display frm_title TO formonly.title
	display str TO formonly.msg

        OPTIONS ACCEPT KEY ESC
# If it was a constraint, then which one.
	if sql_err = -268 
        OR sql_err = -530 
        OR sql_err = -691 THEN
           # ALLOW THEM TO GET MORE INFO ON CONSTRAINTS VIOLATED.
           CALL ident_constr(SQLCA.SQLERRM) RETURNING sql_stmt
           OPEN WINDOW w_cnst at 10,3 with FORM "dsp_msg"
		attribute (border, prompt line last, form line first)
           display "Constraint definition in violation" TO formonly.title
	   display sql_stmt TO formonly.msg

	   prompt "Press any key to continue ..." for char ans
	   close window w_cnst
	   close window w_err
           OPTIONS ACCEPT KEY CONTROL-M
           RETURN

	# RETURN BECAUSE THIS IS A TRAPPED ERROR, NOT A FATAL, THE WHOLE
	# POINT OF THIS EXERCISE IS SO THAT THEY CAN CORRECT THE PROBLEM
	# WITHOUT LOSING THEIR WORK TO DATE.

	end if

	prompt "Press any key to continue ..." for char ans

	close window w_err

        OPTIONS ACCEPT KEY CONTROL-M

	exit program 1
end function

#####################################################################
# This code comes to you grace au dbdiff.  The intent of that program
# is to turn constraint info stored in the catalogues back into its
# original SQL.  I have not gone through GREAT pains to change that
# bent.  Therefore bear with it.
#####################################################################
# Tell the user more info on the constraint in question.
#####################################################################
FUNCTION ident_constr(constr_name)

DEFINE	constr_rec RECORD
        constr_id   INTEGER,
        constr_name CHAR(18),
        owner       CHAR(8),
        tabid       INTEGER,
        constrtype  CHAR(1),
        idxname     CHAR(18),
        tabname     CHAR(18),
        primary     INTEGER
       END RECORD,
        constr_name CHAR(20),
        sql_stmt    CHAR(500),
        stmt1       CHAR(80),
        i, j        SMALLINT,
        p_colname   CHAR(18),
        p_tabname   CHAR(18),
        col_strng   CHAR(330)   #       16*20+10_just_in_case

#####################################################################
# checks are separate
#####################################################################

#      Split owner off of constraint name
      LET j = LENGTH(constr_name)
      FOR i = 1 TO LENGTH(constr_name)
         IF constr_name[i,i] = "." THEN
            LET i = i + 1
            EXIT FOR
         END IF
      END FOR

      LET constr_name = constr_name[i,j]

# display the constraint
      SELECT sysconstraints.constrid, constrname, 
             sysconstraints.owner, sysconstraints.tabid, constrtype, 
             sysconstraints.idxname, tabname, primary
        INTO constr_rec.*
        FROM sysconstraints, systables, OUTER sysreferences 
       WHERE sysconstraints.tabid = systables.tabid 
         AND sysconstraints.constrid = sysreferences.constrid 
         #AND constrtype != 'C'
         AND constrname = constr_name

                                # constraint type
   CASE constr_rec.constrtype
      WHEN 'P' LET sql_stmt = 'PRIMARY KEY'
      WHEN 'U' LET sql_stmt = 'UNIQUE'
      WHEN 'R' LET sql_stmt = 'FOREIGN KEY'

# Checks are different, so do the work and break out of the rest here
      WHEN 'C' LET sql_stmt = 'CHECK'
         DECLARE c_curs CURSOR FOR
	  SELECT checktext, seqno 
            FROM syschecks 
           WHERE constrid = constr_rec.constr_id 
             AND type = 'T' 
           ORDER BY seqno
         FOREACH c_curs INTO stmt1
            LET sql_stmt = sql_stmt clipped, stmt1
            IF LENGTH(sql_stmt) > 499 THEN
               EXIT FOREACH		# forget it
            END IF
         END FOREACH
	 RETURN sql_stmt

# End of checks
   END CASE

                                # constraint columns
   CALL idx_parts(constr_rec.idxname) RETURNING col_strng

                                # add parens
   IF i > 2 THEN
      LET col_strng = "(", col_strng clipped, ")"
   END IF

                                # add the string to the SQL stmt
   LET sql_stmt = sql_stmt clipped, col_strng clipped

                                # if an 'R' then add on 'REFERENCES' clause
   IF constr_rec.constrtype = 'R' THEN

      LET sql_stmt = sql_stmt clipped, ' REFERENCES'

				# get index name
      SELECT idxname
        INTO p_colname
       FROM sysconstraints, sysreferences
      WHERE sysconstraints.constrid = primary
        AND sysreferences.constrid = constr_rec.constr_id

				# get table name
      SELECT tabname
        INTO p_tabname
        FROM sysreferences, systables
       WHERE sysreferences.ptabid = systables.tabid
         AND sysreferences.constrid = constr_rec.constr_id

                                # get column names
      CALL idx_parts(p_colname) RETURNING col_strng
      LET sql_stmt = sql_stmt clipped, " ", p_tabname clipped, " (",
                                       col_strng clipped, ")"
   END IF

RETURN sql_stmt

END FUNCTION

############################################################################
# idx_parts(idxname)
# I grow weary of the same code in multiple locations.  This routine reads
# the parts[] structure from a sysindexes table and builds a column list
# thence.  It is called for indices and constraints.  Since constraints don't
# use the 'DESC' verb the parts structure should never have a negative value
# so don't worry about it.
############################################################################

FUNCTION idx_parts(p_idxname)

DEFINE  p_idxname       CHAR(18),
        p_tabname       CHAR(18),
        idxrec RECORD
           tabid     INTEGER,
           tabname   CHAR(18),
           idxtype   CHAR(1),
           clustered CHAR(1)
        END RECORD,
        parts ARRAY [16] OF SMALLINT,
        i            SMALLINT,
        p_colname    CHAR(24),
        desc_sw      SMALLINT,
        strg, tmp_strg CHAR(80),
        idx_strng    CHAR(500)

					# get all the index info.
   SELECT systables.tabid, systables.tabname, idxtype, clustered,
             part1, part2, part3, part4, part5, part6, part7, part8,
             part9, part10, part11, part12, part13, part14, part15, part16
    INTO idxrec.*, parts[1], parts[2], parts[3], parts[4],
             parts[5], parts[6], parts[7], parts[8],
             parts[9], parts[10], parts[11], parts[12],
             parts[13], parts[14], parts[15], parts[16]
    FROM sysindexes, systables
   WHERE idxname = p_idxname
     AND sysindexes.tabid = systables.tabid

   LET idx_strng = ""
                                        # add columns
   FOR i = 1 TO 16

      LET desc_sw = 0                   # switch for descending sort

      IF parts[i] = 0 THEN
         EXIT FOR
      ELSE IF parts[i] < 0 THEN         # negative indicates a DESC
            LET desc_sw =1
            LET parts[i]=parts[i] * (-1)        # reset to get col
         END IF
      END IF

      SELECT colname                 # get column name
        INTO p_colname
        FROM syscolumns
       WHERE tabid = idxrec.tabid
         AND colno = parts[i]

      IF desc_sw THEN                   # check for descending and fix
         LET p_colname = p_colname CLIPPED, " DESC"
      END IF

      LET idx_strng = idx_strng CLIPPED, " ", p_colname CLIPPED, ","

   END FOR

   LET i=LENGTH(idx_strng) - 1
   LET idx_strng = idx_strng[1,i]
   RETURN idx_strng

END FUNCTION
------
_____________________________________________________________________________
Jack Parker - Hewlett Packard, BSMC Boise, Idaho, USA
[email-masked] 
_____________________________________________________________________________
	"Character is what you are in the dark" - Emilio Lizardo
_____________________________________________________________________________
   Any opinions expressed herein are my own and not those of my employers.
_____________________________________________________________________________