midrange.com code scratchpad
Name:
inactmon.clle
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
08/08/2008 05:31:15 pm
IP:
Logged
Description:
Associated with the System value . . . . . : QINACTMSGQ
Description . . . . . : Inactive job message queue
Message queue . . . . : INACTMSGQ Name, *ENDJOB, *DSCJOB
Library . . . . . . : QUSRSYS Name
Code:
  1. /*******************************************************************/
  2. /*   Program: INACTMON                                             */
  3. /*   Author:  Michael Ryan, Ryan Technology Resources              */
  4. /*   Date:    03-21-2003                                           */
  5. /*                                                                 */
  6. /*     This program monitors the system inactivity message queue   */
  7. /*     for inactive jobs. A message is sent to the inactivity      */
  8. /*     queue; this program will receive the message and process    */
  9. /*     an action appropriately.                                    */
  10. /*                                                                 */
  11. /*     Idea freely stolen from an IBM SupportLine document.        */
  12. /*                                                                 */
  13. /*     This is an ILE program - Create this program as follows:    */
  14. /*                                                                 */
  15. /*     If INACTMON has changed, use option 15 from PDM or...       */
  16. /*        CRTCLMOD MODULE(<lib>/INACTMON)                          */
  17. /*                 SRCFILE(<lib>/QCLSRC)                           */
  18. /*                 SRCMBR(INACTMON)                                */
  19. /*                                                                 */
  20. /*     If INACTR has changed, use option 15 from PDM or...         */
  21. /*        CRTRPGMOD MODULE(<lib>/INACTR)                           */
  22. /*                  SRCFILE(<lib>/QRPGLESRC)                       */
  23. /*                  SRCMBR(INACTR)                                 */
  24. /*                                                                 */
  25. /*     Create the program with...                                  */
  26. /*        CRTPGM PGM(<lib>/INACTMON)                               */
  27. /*               MODULE(INACTMON INACTR)                           */
  28. /*                                                                 */
  29. /*   Change History:                                               */
  30. /*                                                                 */
  31. /*   04-12-2004  Michael Ryan MR1                                  */
  32. /*               Add CPF1321 (Job Not Found) to MONMSG.            */
  33. /*                                                                 */
  34. /*   11-15-2006  Michael Ryan MR2                                  */
  35. /*               Check for "can't allocate" message on INACTR      */
  36. /*               procedure call. File locked on backup.            */
  37. /*                                                                 */
  38. /*******************************************************************/
  39.  
  40.              PGM
  41.  
  42.              DCL        VAR(&THEQUEUE) TYPE(*CHAR) LEN(20)
  43.              DCL        VAR(&INACTLIB) TYPE(*CHAR) LEN(10)
  44.              DCL        VAR(&INACTQUEUE) TYPE(*CHAR) LEN(10)
  45.              DCL        VAR(&INACTDATA) TYPE(*CHAR) LEN(100)
  46.              DCL        VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
  47.              DCL        VAR(&USER) TYPE(*CHAR) LEN(10)
  48.              DCL        VAR(&NUMBER) TYPE(*CHAR) LEN(6)
  49.              DCL        VAR(&MSGDTALEN) TYPE(*DEC) LEN(5 0)
  50.              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)
  51.              DCL        VAR(&RTNVAL) TYPE(*CHAR) LEN(2)
  52.              DCL        VAR(&ACTION) TYPE(*CHAR) LEN(1)
  53.              DCL        VAR(&CONSOLE) TYPE(*CHAR) LEN(10)
  54.              RTVJOBA    JOB(&JOBNAME)
  55.              RTVJOBA    USER(&USER)
  56.              RTVJOBA    NBR(&NUMBER)
  57.  
  58. /*   Get the fully qualified queue name from the system value.  */
  59.  
  60.              RTVSYSVAL  SYSVAL(QINACTMSGQ) RTNVAR(&THEQUEUE)
  61.              CHGVAR     VAR(&INACTQUEUE) VALUE(%SUBSTRING(&THEQUEUE +
  62.                           1 10))
  63.              CHGVAR     VAR(&INACTLIB) VALUE(%SUBSTRING(&THEQUEUE 11 +
  64.                           10))
  65.  
  66. /*   Get the name of the console from the system value.         */
  67.              RTVSYSVAL  SYSVAL(QCONSOLE) RTNVAR(&CONSOLE)
  68.  
  69.  LOOP:
  70. /*   Wait for a message on the message queue.                   */
  71.              RCVMSG     MSGQ(&INACTLIB/&INACTQUEUE) WAIT(*MAX) +
  72.                           MSGDTA(&INACTDATA) MSGDTALEN(&MSGDTALEN) +
  73.                           MSGID(&MSGID)
  74.  
  75. /*   If 'STOP' message, end the program.                        */
  76.              IF         COND(&INACTDATA *EQ 'STOP') THEN(GOTO +
  77.                           CMDLBL(ENDPGM))
  78.  
  79.   /* If not CPI1126, skip the message.                          */
  80.              IF         COND(&MSGID *NE 'CPI1126') THEN(GOTO +
  81.                           CMDLBL(SKIP))
  82.              CHGVAR     VAR(&JOBNAME) VALUE(%SUBSTRING(&INACTDATA 1 +
  83.                           10)) /* GET JOB NAME */
  84.              CHGVAR     VAR(&USER) VALUE(%SUBSTRING(&INACTDATA 11 +
  85.                           10)) /* GET USER NAME*/
  86.              CHGVAR     VAR(&NUMBER) VALUE(%SUBSTRING(&INACTDATA 21 +
  87.                           6)) /* GET JOB NUM  */
  88.  
  89.   /*   Skip the console.                                         */
  90.              IF         COND(&JOBNAME *EQ &CONSOLE) THEN(GOTO +
  91.                           CMDLBL(SKIP))
  92.  
  93.  /*  Process action for specific user or job. If a CPF4128       */
  94.  /*  message (or more likely, an RNX1217 message) is             */
  95.  /*  encountered, it's because a file can't be allocated         */
  96.  /*  that's needed by the inactivity processor - probably by     */
  97.  /*  the backup. Wait 10 minutes and process the next entry.     */
  98.              CALLPRC    PRC(INACT) PARM(&JOBNAME &USER &NUMBER) +
  99.                           RTNVAL(&RTNVAL)
  100.              MONMSG     MSGID(CPF4128 RNX1217) EXEC(DO) /* MR2 */
  101.              DLYJOB     DLY(600)                       /* MR2 */
  102.              GOTO       CMDLBL(SKIP)                   /* MR2 */
  103.              ENDDO                                     /* MR2 */
  104.  
  105.   /*  Ok...this is just wierd...to return a one byte value from  */
  106.   /*  RPGLE, declare a two byte CL variable and substring out    */
  107.   /*  the first byte - it's in the ILE RPG for AS/400            */
  108.   /*  Programmer's Guide.                                        */
  109.  
  110.              CHGVAR     VAR(&ACTION) VALUE(%SST(&RTNVAL 1 1))
  111.  
  112.   /* If &Action (Returned from procedure INACTR) is...           */
  113.   /*    'N' = No Process                                         */
  114.   /*    'D' = Disconnect Job                                     */
  115.   /*    'E' = End Job                                            */
  116.   /*    'S' = Send a break message                               */
  117.   /* Default is to skip...                                       */
  118.  
  119.              IF         COND(&ACTION *EQ 'N') THEN(GOTO CMDLBL(SKIP))
  120.              IF         COND(&ACTION *EQ 'D') THEN(GOTO CMDLBL(DSCIT))
  121.              IF         COND(&ACTION *EQ 'E') THEN(GOTO CMDLBL(ENDIT))
  122.              IF         COND(&ACTION *EQ 'S') THEN(GOTO CMDLBL(SNDIT))
  123.              GOTO       CMDLBL(SKIP)
  124.  
  125.   /* Disconnect                                                  */
  126. DSCIT:
  127.              DSCJOB     JOB(&NUMBER/&USER/&JOBNAME)
  128.     /* Note: Cannot disconnect a virtual terminal                */
  129.              MONMSG     MSGID(CPF1386 CPF1321) /* MR1 */
  130.              GOTO       CMDLBL(SKIP)
  131.  
  132.   /* Send a break message                                        */
  133. SNDIT:
  134.              SNDBRKMSG  MSG(&USER *CAT ' ' *CAT 'Terminal is +
  135.                           Inactive') TOMSGQ(&JOBNAME)
  136.              GOTO       CMDLBL(SKIP)
  137.  
  138.   /* End the job                                                 */
  139. ENDIT:
  140.              ENDJOB     JOB(&NUMBER/&USER/&JOBNAME) OPTION(*IMMED)
  141.              MONMSG     MSGID(CPF1361 CPF1362 CPF1363 CPF1321) /* +
  142.                           MR1 */
  143.              GOTO       CMDLBL(SKIP)
  144.  
  145. SKIP:
  146.              GOTO       CMDLBL(LOOP)
  147. ENDPGM:
  148.              ENDPGM 
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css