midrange.com code scratchpad
Name:
RTVTRGPGM
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
01/31/2018 09:13:15 pm
IP:
Logged
Description:
Retrieve trigger-firing program name
Code:
  1. /*-------------------------------------------------------------------*/
  2. /*                                                                   */
  3. /*  Module       : RTVTRGPGMC                                        */
  4. /*  Description  : Retrieve trigger-firing program name              */
  5. /*                                                                   */
  6. /*                                                                   */
  7. /*-------------------------------------------------------------------*/
  8.  
  9. /*  Build instruction:                                         +
  10.  *                                                             +
  11.  *> ign: DLTSRVPGM  SRVPGM(&O/&ON)         <*                  +
  12.  *>      CRTCLMOD   MODULE(QTEMP/&N) -     <*                  +
  13.  *>                 SRCFILE(&L/&F) -       <*                  +
  14.  *>                 DBGVIEW(&DV)           <*                  +
  15.  *>      CRTSRVPGM  SRVPGM(&O/&ON) -       <*                  +
  16.  *>                 MODULE(QTEMP/&N) -     <*                  +
  17.  *>                 EXPORT(*ALL) -         <*                  +
  18.  *>                 ACTGRP(*CALLER) -      <*                  +
  19.  *>                 TEXT(&X)               <*                  +
  20.  *>      DLTMOD     MODULE(QTEMP/&N)       <*                  +
  21.  *>      ADDBNDDIRE BNDDIR(MGGPL/MGGPL) -  <*                  +
  22.  *>                 OBJ((*LIBL/&ON))       <*                  +
  23.  */
  24.  
  25.      PGM        PARM(&TRIGPGM &TRIGLIB &RETPGM &IND1 &IND2)
  26.  
  27.      /* trigger program name */
  28.      DCL        VAR(&TRIGPGM) +
  29.                   TYPE(*CHAR) +
  30.                   LEN(10)
  31.      /* trigger program library */
  32.      DCL        VAR(&TRIGLIB) +
  33.                   TYPE(*CHAR) +
  34.                   LEN(10)
  35.      /* output argument, fully qualified program name */
  36.      DCL        VAR(&RETPGM) +
  37.                   TYPE(*CHAR) +
  38.                   LEN(10)
  39.      /* null indicators */
  40.      DCL        VAR(&IND1) +
  41.                   TYPE(*INT) +
  42.                   LEN(2)
  43.      DCL        VAR(&IND2) +
  44.                   TYPE(*INT) +
  45.                   LEN(2)
  46.  
  47.      /* local CL variables */
  48.      DCL        VAR(&RECEIVER) +
  49.                   TYPE(*CHAR) +
  50.                   LEN(32767)
  51.      DCL        VAR(&OFFSET) +
  52.                   TYPE(*INT) +
  53.                   STG(*DEFINED) +
  54.                   DEFVAR(&RECEIVER 13)
  55.      DCL        VAR(&NUMENTRY) +
  56.                   TYPE(*INT) +
  57.                   STG(*DEFINED) +
  58.                   DEFVAR(&RECEIVER 17)
  59.      DCL        VAR(&CALLSTKPTR) +
  60.                   TYPE(*PTR) +
  61.                   ADDRESS(&RECEIVER 1)
  62.      DCL        VAR(&CALLSTKLEN) +
  63.                   TYPE(*INT) +
  64.                   STG(*BASED) +
  65.                   BASPTR(&CALLSTKPTR)
  66.      DCL        VAR(&PGM) +
  67.                   TYPE(*CHAR) +
  68.                   LEN(10)
  69.      DCL        VAR(&PGMLIB) +
  70.                   TYPE(*CHAR) +
  71.                   LEN(10)
  72.      DCL        VAR(&PGMOFFSET) +
  73.                   TYPE(*INT) +
  74.                   LEN(4) +
  75.                   VALUE(0)
  76.      DCL        VAR(&RCVLEN) +
  77.                   TYPE(*INT) +
  78.                   VALUE(32767)
  79.      DCL        VAR(&FMT) +
  80.                   TYPE(*CHAR) +
  81.                   LEN(8) +
  82.                   VALUE('CSTK0100')
  83.      DCL        VAR(&JOBIDENT) +
  84.                   TYPE(*CHAR) +
  85.                   LEN(56)
  86.      DCL        VAR(&JOBNAME) +
  87.                   TYPE(*CHAR) +
  88.                   STG(*DEFINED) +
  89.                   LEN(10) +
  90.                   DEFVAR(&JOBIDENT 1)
  91.      DCL        VAR(&USER) +
  92.                   TYPE(*CHAR) +
  93.                   STG(*DEFINED) +
  94.                   LEN(10) +
  95.                   DEFVAR(&JOBIDENT 11)
  96.      DCL        VAR(&JOBNBR) +
  97.                   TYPE(*CHAR) +
  98.                   STG(*DEFINED) +
  99.                   LEN(6) +
  100.                   DEFVAR(&JOBIDENT 21)
  101.      DCL        VAR(&INTJOBID) +
  102.                   TYPE(*CHAR) +
  103.                   STG(*DEFINED) +
  104.                   LEN(16) +
  105.                   DEFVAR(&JOBIDENT 27)
  106.      DCL        VAR(&RESERVED) +
  107.                   TYPE(*CHAR) +
  108.                   STG(*DEFINED) +
  109.                   LEN(2) +
  110.                   DEFVAR(&JOBIDENT 43)
  111.      DCL        VAR(&THREADIND) +
  112.                   TYPE(*INT) +
  113.                   STG(*DEFINED) +
  114.                   DEFVAR(&JOBIDENT 45)
  115.      DCL        VAR(&THREADID) +
  116.                   TYPE(*CHAR) +
  117.                   STG(*DEFINED) +
  118.                   LEN(8) +
  119.                   DEFVAR(&JOBIDENT 49)
  120.      DCL        VAR(&JOBFMT) +
  121.                   TYPE(*CHAR) +
  122.                   LEN(8) +
  123.                   VALUE('JIDF0100')
  124.      DCL        VAR(&ERRORCODE) +
  125.                   TYPE(*CHAR) +
  126.                   LEN(8) +
  127.                   VALUE(X'0000000000000000')
  128.  
  129.      /* loop control variable */
  130.      DCL        VAR(&LIMIT) +
  131.                   TYPE(*INT)
  132.  
  133.      /* local variables for CL service program name retrieval */
  134.      DCL        VAR(&MATPGMDATA) +
  135.                   TYPE(*CHAR) +
  136.                   LEN(80)
  137.      DCL        VAR(&DATASIZE) +
  138.                   TYPE(*INT) +
  139.                   STG(*DEFINED) +
  140.                   DEFVAR(&MATPGMDATA 1)
  141.      DCL        VAR(&BYTESAVAIL) +
  142.                   TYPE(*INT) +
  143.                   STG(*DEFINED) +
  144.                   DEFVAR(&MATPGMDATA 5)
  145.      DCL        VAR(&PGMFORMAT) +
  146.                   TYPE(*INT) +
  147.                   STG(*DEFINED) +
  148.                   DEFVAR(&MATPGMDATA 9)
  149.      DCL        VAR(&RESERVED2) +
  150.                   TYPE(*INT) +
  151.                   STG(*DEFINED) +
  152.                   DEFVAR(&MATPGMDATA 13)
  153.      DCL        VAR(&THISPGMLIB) +
  154.                   TYPE(*CHAR) +
  155.                   STG(*DEFINED) +
  156.                   LEN(10) +
  157.                   DEFVAR(&MATPGMDATA 19)
  158.      DCL        VAR(&THISPGMNAM) +
  159.                   TYPE(*CHAR) +
  160.                   STG(*DEFINED) +
  161.                   LEN(10) +
  162.                   DEFVAR(&MATPGMDATA 51)
  163.  
  164.      /* initialize input arguments for the _MATPGMNM MI built-in call */
  165.      CHGVAR     VAR(&DATASIZE) +
  166.                   VALUE(80)
  167.      CHGVAR     VAR(&BYTESAVAIL) +
  168.                   VALUE(80)
  169.      CHGVAR     VAR(&PGMFORMAT) +
  170.                   VALUE(0)
  171.      CHGVAR     VAR(&RESERVED2) +
  172.                   VALUE(0)
  173.  
  174.      /* get qualified service program name, so we can omit it from consideration */
  175.      CALLPRC    PRC('_MATPGMNM') +
  176.                   PARM((&MATPGMDATA))
  177.  
  178.      /* initialize QWVRCSTK input arguments */
  179.      CHGVAR     VAR(&JOBNAME) +
  180.                   VALUE('*')
  181.      CHGVAR     VAR(&RESERVED) +
  182.                   VALUE(X'0000')
  183.      CHGVAR     VAR(&THREADIND) +
  184.                   VALUE(1)
  185.      CHGVAR     VAR(&THREADID) +
  186.                   VALUE(X'0000000000000000')
  187.      CALL       PGM(QWVRCSTK) +
  188.                   PARM(&RECEIVER &RCVLEN &FMT &JOBIDENT &JOBFMT &ERRORCODE)
  189.  
  190.      /* walk the call stack list and get the firing trigger program name */
  191.      DOFOR      VAR(&LIMIT) +
  192.                   FROM(1) +
  193.                   TO(&NUMENTRY)
  194.         CHGVAR     VAR(&CALLSTKPTR) +
  195.                      VALUE(%ADDRESS(&RECEIVER))
  196.         CHGVAR     VAR(%OFFSET(&CALLSTKPTR)) +
  197.                      VALUE(%OFFSET(&CALLSTKPTR) + &OFFSET)
  198.         CHGVAR     VAR(&PGMOFFSET) +
  199.                      VALUE(&OFFSET + 25)
  200.         CHGVAR     VAR(&PGM) +
  201.                      VALUE(%SST(&RECEIVER &PGMOFFSET 10))
  202.         CHGVAR     VAR(&PGMOFFSET) +
  203.                      VALUE(&PGMOFFSET + 10)
  204.         CHGVAR     VAR(&PGMLIB) +
  205.                      VALUE(%SST(&RECEIVER &PGMOFFSET 10))
  206.  
  207.         /* omit QSYS programs, this service program, and SQL trigger program name */
  208.         IF         COND(&PGMLIB *NE 'QSYS' *AND  *NOT (&PGM = &THISPGMNAM *AND +
  209.                      &PGMLIB = &THISPGMLIB) *AND  *NOT (&PGM = &TRIGPGM *AND +
  210.                      &PGMLIB = &TRIGLIB)) +
  211.                      THEN(DO)/* firing trigger program found */
  212.            CHGVAR     VAR(&RETPGM) +
  213.                         VALUE(&PGM)
  214.            RETURN
  215.         ENDDO
  216.         CHGVAR     VAR(&OFFSET) +
  217.                      VALUE(&OFFSET + &CALLSTKLEN)
  218.      ENDDO
  219.  
  220.      /* entire call stack was QSYS programs, so let's special case this */
  221.      CHGVAR     VAR(&RETPGM) +
  222.                   VALUE('*IBM_ONLY')
  223.  
  224.      ENDPGM
  225.  
  226.  
  227. ---------------------------------------------------------------------------------------------------
  228.  
  229.       //--------------------------------------------------------------------
  230.       //  Procedure rtvTrgPgm
  231.       //
  232.       //  Procedure to retrieve the firing program of a trigger.
  233.       //
  234.       //  peTrgPgm (in) - Name of running trigger program
  235.       //  peTrgLib (in) - Lib of running trigger program
  236.       //  peFiring (out)- Name of program that fired this trigger
  237.       //  peInd1        - SQL null indicator 1 (for call as udf)
  238.       //  peInd2        - SQL null indicator 2
  239.       //
  240.       //  Returns. . :  nothing
  241.       //
  242.       //  Remarks. . :
  243.       //
  244.       //  Example. . :  rtvTrgPgm( wwTrgPgm
  245.       //                         : wwTrgLib
  246.       //                         : wwFiring
  247.       //                         : wwNull1
  248.       //                         : wwNull2
  249.       //                         ) ;
  250.       //
  251.       //
  252.       //--------------------------------------------------------------------
  253.  
  254.      d rtvTrgPgm...
  255.      d                 PR                  extproc(*CL : 'RTVTRGPGMC')
  256.      d  peTrgPgm                     10A
  257.      d  peTrgLib                     10A
  258.      d  peFiring                     10A
  259.      d  peInd1                        5I 0
  260.      d  peInd2                        5I 0
  261.  
  262.  
  263.  
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css