/*-------------------------------------------------------------------*/ /* */ /* Module : RTVTRGPGMC */ /* Description : Retrieve trigger-firing program name */ /* */ /* */ /*-------------------------------------------------------------------*/ /* Build instruction: + * + *> ign: DLTSRVPGM SRVPGM(&O/&ON) <* + *> CRTCLMOD MODULE(QTEMP/&N) - <* + *> SRCFILE(&L/&F) - <* + *> DBGVIEW(&DV) <* + *> CRTSRVPGM SRVPGM(&O/&ON) - <* + *> MODULE(QTEMP/&N) - <* + *> EXPORT(*ALL) - <* + *> ACTGRP(*CALLER) - <* + *> TEXT(&X) <* + *> DLTMOD MODULE(QTEMP/&N) <* + *> ADDBNDDIRE BNDDIR(MGGPL/MGGPL) - <* + *> OBJ((*LIBL/&ON)) <* + */ PGM PARM(&TRIGPGM &TRIGLIB &RETPGM &IND1 &IND2) /* trigger program name */ DCL VAR(&TRIGPGM) + TYPE(*CHAR) + LEN(10) /* trigger program library */ DCL VAR(&TRIGLIB) + TYPE(*CHAR) + LEN(10) /* output argument, fully qualified program name */ DCL VAR(&RETPGM) + TYPE(*CHAR) + LEN(10) /* null indicators */ DCL VAR(&IND1) + TYPE(*INT) + LEN(2) DCL VAR(&IND2) + TYPE(*INT) + LEN(2) /* local CL variables */ DCL VAR(&RECEIVER) + TYPE(*CHAR) + LEN(32767) DCL VAR(&OFFSET) + TYPE(*INT) + STG(*DEFINED) + DEFVAR(&RECEIVER 13) DCL VAR(&NUMENTRY) + TYPE(*INT) + STG(*DEFINED) + DEFVAR(&RECEIVER 17) DCL VAR(&CALLSTKPTR) + TYPE(*PTR) + ADDRESS(&RECEIVER 1) DCL VAR(&CALLSTKLEN) + TYPE(*INT) + STG(*BASED) + BASPTR(&CALLSTKPTR) DCL VAR(&PGM) + TYPE(*CHAR) + LEN(10) DCL VAR(&PGMLIB) + TYPE(*CHAR) + LEN(10) DCL VAR(&PGMOFFSET) + TYPE(*INT) + LEN(4) + VALUE(0) DCL VAR(&RCVLEN) + TYPE(*INT) + VALUE(32767) DCL VAR(&FMT) + TYPE(*CHAR) + LEN(8) + VALUE('CSTK0100') DCL VAR(&JOBIDENT) + TYPE(*CHAR) + LEN(56) DCL VAR(&JOBNAME) + TYPE(*CHAR) + STG(*DEFINED) + LEN(10) + DEFVAR(&JOBIDENT 1) DCL VAR(&USER) + TYPE(*CHAR) + STG(*DEFINED) + LEN(10) + DEFVAR(&JOBIDENT 11) DCL VAR(&JOBNBR) + TYPE(*CHAR) + STG(*DEFINED) + LEN(6) + DEFVAR(&JOBIDENT 21) DCL VAR(&INTJOBID) + TYPE(*CHAR) + STG(*DEFINED) + LEN(16) + DEFVAR(&JOBIDENT 27) DCL VAR(&RESERVED) + TYPE(*CHAR) + STG(*DEFINED) + LEN(2) + DEFVAR(&JOBIDENT 43) DCL VAR(&THREADIND) + TYPE(*INT) + STG(*DEFINED) + DEFVAR(&JOBIDENT 45) DCL VAR(&THREADID) + TYPE(*CHAR) + STG(*DEFINED) + LEN(8) + DEFVAR(&JOBIDENT 49) DCL VAR(&JOBFMT) + TYPE(*CHAR) + LEN(8) + VALUE('JIDF0100') DCL VAR(&ERRORCODE) + TYPE(*CHAR) + LEN(8) + VALUE(X'0000000000000000') /* loop control variable */ DCL VAR(&LIMIT) + TYPE(*INT) /* local variables for CL service program name retrieval */ DCL VAR(&MATPGMDATA) + TYPE(*CHAR) + LEN(80) DCL VAR(&DATASIZE) + TYPE(*INT) + STG(*DEFINED) + DEFVAR(&MATPGMDATA 1) DCL VAR(&BYTESAVAIL) + TYPE(*INT) + STG(*DEFINED) + DEFVAR(&MATPGMDATA 5) DCL VAR(&PGMFORMAT) + TYPE(*INT) + STG(*DEFINED) + DEFVAR(&MATPGMDATA 9) DCL VAR(&RESERVED2) + TYPE(*INT) + STG(*DEFINED) + DEFVAR(&MATPGMDATA 13) DCL VAR(&THISPGMLIB) + TYPE(*CHAR) + STG(*DEFINED) + LEN(10) + DEFVAR(&MATPGMDATA 19) DCL VAR(&THISPGMNAM) + TYPE(*CHAR) + STG(*DEFINED) + LEN(10) + DEFVAR(&MATPGMDATA 51) /* initialize input arguments for the _MATPGMNM MI built-in call */ CHGVAR VAR(&DATASIZE) + VALUE(80) CHGVAR VAR(&BYTESAVAIL) + VALUE(80) CHGVAR VAR(&PGMFORMAT) + VALUE(0) CHGVAR VAR(&RESERVED2) + VALUE(0) /* get qualified service program name, so we can omit it from consideration */ CALLPRC PRC('_MATPGMNM') + PARM((&MATPGMDATA)) /* initialize QWVRCSTK input arguments */ CHGVAR VAR(&JOBNAME) + VALUE('*') CHGVAR VAR(&RESERVED) + VALUE(X'0000') CHGVAR VAR(&THREADIND) + VALUE(1) CHGVAR VAR(&THREADID) + VALUE(X'0000000000000000') CALL PGM(QWVRCSTK) + PARM(&RECEIVER &RCVLEN &FMT &JOBIDENT &JOBFMT &ERRORCODE) /* walk the call stack list and get the firing trigger program name */ DOFOR VAR(&LIMIT) + FROM(1) + TO(&NUMENTRY) CHGVAR VAR(&CALLSTKPTR) + VALUE(%ADDRESS(&RECEIVER)) CHGVAR VAR(%OFFSET(&CALLSTKPTR)) + VALUE(%OFFSET(&CALLSTKPTR) + &OFFSET) CHGVAR VAR(&PGMOFFSET) + VALUE(&OFFSET + 25) CHGVAR VAR(&PGM) + VALUE(%SST(&RECEIVER &PGMOFFSET 10)) CHGVAR VAR(&PGMOFFSET) + VALUE(&PGMOFFSET + 10) CHGVAR VAR(&PGMLIB) + VALUE(%SST(&RECEIVER &PGMOFFSET 10)) /* omit QSYS programs, this service program, and SQL trigger program name */ IF COND(&PGMLIB *NE 'QSYS' *AND *NOT (&PGM = &THISPGMNAM *AND + &PGMLIB = &THISPGMLIB) *AND *NOT (&PGM = &TRIGPGM *AND + &PGMLIB = &TRIGLIB)) + THEN(DO)/* firing trigger program found */ CHGVAR VAR(&RETPGM) + VALUE(&PGM) RETURN ENDDO CHGVAR VAR(&OFFSET) + VALUE(&OFFSET + &CALLSTKLEN) ENDDO /* entire call stack was QSYS programs, so let's special case this */ CHGVAR VAR(&RETPGM) + VALUE('*IBM_ONLY') ENDPGM --------------------------------------------------------------------------------------------------- //-------------------------------------------------------------------- // Procedure rtvTrgPgm // // Procedure to retrieve the firing program of a trigger. // // peTrgPgm (in) - Name of running trigger program // peTrgLib (in) - Lib of running trigger program // peFiring (out)- Name of program that fired this trigger // peInd1 - SQL null indicator 1 (for call as udf) // peInd2 - SQL null indicator 2 // // Returns. . : nothing // // Remarks. . : // // Example. . : rtvTrgPgm( wwTrgPgm // : wwTrgLib // : wwFiring // : wwNull1 // : wwNull2 // ) ; // // //-------------------------------------------------------------------- d rtvTrgPgm... d PR extproc(*CL : 'RTVTRGPGMC') d peTrgPgm 10A d peTrgLib 10A d peFiring 10A d peInd1 5I 0 d peInd2 5I 0