From: jparker@hpbs3645.boi.hp.com (Jack Parker) Newsgroups: comp.databases.informix Subject: Wich constraint was violated (I4GL) ? Date: 13 Jun 1995 19:33:03 -0400 X-Informix-List-ID: > > > > 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 = "jparker@hpbs3645.boi.hp.com" 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 jparker@hpbs3645.boi.hp.com _____________________________________________________________________________ "Character is what you are in the dark" - Emilio Lizardo _____________________________________________________________________________ Any opinions expressed herein are my own and not those of my employers. _____________________________________________________________________________