CPP RTVMSGWJLR RPGLE H DFTACTGRP(*NO) ACTGRP(*CALLER) BNDDIR('QC2LE') EXPROPTS(*RESDECPOS) H DATFMT(*ISO) TIMFMT(*ISO) DEBUG H OPTION(*SRCSTMT:*NODEBUGIO) *---------------------------------------------------------------- * RTVMSGWJL Retrieve Job MSGW ErrMsg from Job Log * Copyright (C) 04/03/2008 Vengoal Chang <vengoal@ddsc.com.tw> * This program is free software, you can redistribute it and/or modify it under the terms * of the GNU General Public License as published by the Free Software Foundation. * *---------------------------------------------------------------- * This program retrieve specified job job's log and send err log * to specified MSGQ, you could modify for checking message * type or message id as your request. *---------------------------------------------------------------- * api (application program interfaces) used: * quscrtus create user space * qusptrus retrieve pointer to user space * qmhljobl list job log messages * qezsndmg send message to user *---------------------------------------------------------------- D uSpaceName s 20 inz('RTVMSGWJL QTEMP ') D msgtxt s 768 D msgtxt494 s 494 D msgtxt06 s 256 D msgtxt15 s 256 D msgtxt17 s 256 D QUSLIB s 10 D MsgQDs Ds D MsgQEntSize 4B 0 D MsgQEntStr 20 Dim( 20 ) D Idx S 2 0 D AryIdx S 10I 0 D QualMsgq DS D MsgQ 10 D MsgQLib 10 *Array for contain MsgQStr D MsgQUsrDs Ds D MsgQUsrAry 10 Dim( 20 ) D Inz( *HiVal ) Ascend * ------------------------------------------------------------------- * - User space attributes data structure - * ------------------------------------------------------------------- D QUSAttr DS D QUSNumRec 10I 0 Inz( 1 ) D QUSKey 10I 0 Inz( 3 ) D QUSRecLen 10I 0 Inz( 1 ) D QUSRecData 1A Inz( '1' ) *---------------------------------------------------------------- * Get user space list info from header section. *---------------------------------------------------------------- D ds based(uHeadPtr) D uOffSetToList 125 128i 0 D uNumOfEntrys 133 136i 0 D uSizeOfEntry 137 140i 0 * D uListEntry1 ds Based(uListPtr ) D uOffsetToNext 10i 0 overlay(uListEntry1:1) D uOffsetToFlds 10i 0 overlay(uListEntry1:5) D uNumFldsRetrnd 10i 0 overlay(uListEntry1:9) D uMsgSeverity 10i 0 overlay(uListEntry1:12) D uMsgId 7a overlay(uListEntry1:17) D uMsgType 2a overlay(uListEntry1:24) D uMsgKey 4a overlay(uListEntry1:26) D uMsgFile 20a overlay(uListEntry1:30) D uMsgFileName 10a overlay(uListEntry1:30) D uMsgFileLib 10a overlay(uListEntry1:40) * these fields repeat for each key selected. D uListEntry2 ds Based(uListPtr2) D u2OffsetToNext 10i 0 D u2LengthOfFlds 10i 0 D u2IdentifierF 10i 0 D u2TypeOfData 1a D u2StatOfData 1a D u2Reserved 14a D u2LengthOfData 10i 0 D u2Data 500 *---------------------------------------------------------------- * Error return code parm for APIs. *---------------------------------------------------------------- D vApiErrDs ds D vbytpv 10i 0 inz(%size(vApiErrDs)) D vbytav 10i 0 inz(0) D vmsgid 7a D vresvd 1a D vrpldta 50a * *---------------------------------------------------------------- * Message selection data structure. * * Retrieve JOB Log direction *-----------------------------|-------------|-------------------- * Parameter | From Top | From Bottom *-----------------------------|-------------|-------------------- * msListDirection | *NEXT | *PRV * msStartingMessageKey | X'00000000' | X'FFFFFFFF' *---------------------------------------------------------------- D MsgSelectDS ds D msMaxMsgRequested... D 10i 0 inz(-1) overlay(msgSelectDS:1) num of msg requested D msListDirection... D 10a inz('*NEXT') overlay(msgSelectDS:5) List direction D msQualifiedJobName... D 10a inz('*') overlay(msgSelectDS:15) * = current job D msQualifiedUserName... D 10a inz(' ') overlay(msgSelectDS:25) = current job D msQualifiedJobNumber... D 6a inz(' ') overlay(msgSelectDS:35) = current job D msInternalJobIdentifier... D 16a inz(' ') overlay(msgSelectDS:41) = current job D msStartingMessageKey... D 4a inz(x'00000000') start newest message D overlay(msgselectDS:57) D msMaxMsgLength... D 10i 0 inz(500) overlay(msgSelectDS:61) id 301,302 lengths D msMaxMsgHelpLength... D 10i 0 inz(100) overlay(msgSelectDS:65) id 401,402,403,404 D msOffsetToIdentifiersOfFieldstoReturn... D 10i 0 inz(84) overlay(msgSelectDS:69) to start of array D msNumberOfFieldsToReturn... D 10i 0 inz(1) overlay(msgSelectDS:73) D msOffsetToCallMsgQname... D 10i 0 inz(88) overlay(msgSelectDS:77) D msLengthOfCallMsgQname... D 10i 0 inz(1) overlay(msgSelectDS:81) D msIndentifiersOfFieldsToReturn... D 10i 0 inz(0302) overlay(msgSelectDS:85) D msCallMessageQueueName... D 1a inz('*') overlay(msgSelectDS:89) *---------------------------------------------------------------- * Create Prototypes for calls * -------------------------------------------------------------------- * - QusCrtUs - Create User Space API - * - - * - Usage Length Type Parameter Description - * - - * - Input 20 Character Qualified user space name - * - Input 10 Character Extended attribute - * - Input 4 0 Binary Initial size - * - Input 1 Character Initial value - * - Input 10 Character Public authority - * - Input 50 Character Text description - * - Replace 10 Character Replace - * -------------------------------------------------------------------- D quscrtus PR ExtPgm('QUSCRTUS') D 20 D 10 const D 10i 0 const D 1 const D 10 const D 50 const D 10 const Db like(vApiErrDS) * ------------------------------------------------------------------- * - Qusptrus - Get user space pointer API - * - - * - Usage Length Type Parameter Description - * - - * - Input 20 Character Qualified user space name - * - Output * Pointer UserSpace Pointer - * - Output Error Code - * - ----------------------------------------------------------------- D qusptrus PR ExtPgm('QUSPTRUS') retrieve pointer D 20 Space Name D * pointer Db like(vApiErrDS) error parm * ------------------------------------------------------------------- * - Quscusat - Change User Space Attributes API - * - - * - Usage Length Type Parameter Description - * - - * - Output 10 Character Returned library - * - Input 20 Character Qualified user space name - * - Input 13 Character Attribute structure - * - Output Error code - * ------------------------------------------------------------------- D quscusat PR ExtPgm( 'QUSCUSAT' ) D 10A Const D 20A Const D 13A Const Db like(vApiErrDS) * --------------------------------------------------------------- D system PR 10I 0 extproc('system') D i_cmd * value options(*string) * D EXCP_MSGID S 7A import('_EXCP_MSGID') * -------------------------------------------------------------- D qmhljobl PR ExtPgm('QMHLJOBL ') D 20 D 8 const Db like(MsgSelectDS) D 10i 0 const D 8 const Db like(vApiErrDS) * -------------------------------------------------------------- D qmhsndm PR ExtPgm('QMHSNDM') D msgid 7 const D msgfil 20 const D msgtxt 256 const D msglen 10i 0 const D msgtype 10 const D msgq 10 const D msgq# 10i 0 const D rpymq 20 const D msgkey 4 const Db like(vApiErrDS) * -------------------------------------------------------------- D QEZSNDMG PR ExtPgm('QEZSNDMG') D Msgtype 10A const D DelivMode 10A const D MsgTxt 32767A const options(*varsize) D MsgLen 10I 0 const D MsgQ 10A const D dim(32767) options(*varsize) D NumMsgQ 10I 0 const D MsgSent 10I 0 D FuncReq 10I 0 D ErrorCode 32767A options(*varsize) D DspScrn 1A const options(*nopass) D ReplyQ 20A const options(*nopass) D NameType 4A const options(*nopass) D CCSID 10I 0 const options(*nopass) D ErrorCode DS D BytesProv 10I 0 inz(0) D BytesAvail 10I 0 inz(0) D msgTypeA s 10 D sentcode s 10I 0 D funccode s 10I 0 D main PR extpgm('RTVMSGWJLR') D jobname 10 D jobuser 10 D jobnumber 6 D msgtype 5 D msgQDsInput like(MsgQDs) D main PI D jobname 10 D jobuser 10 D jobnumber 6 D msgtype 5 D msgQDsInput like(MsgQDs) *---------------------------------------------------------------- * Main Process *---------------------------------------------------------------- C eval *inlr = *on C eval msQualifiedJobName = jobname C eval msQualifiedUserName = jobuser C eval msQualifiedJobNumber = jobnumber c eval msgTypeA = MsgType C eval msgQDs = msgQDsInput C Eval Idx = 0 C Eval AryIdx = 0 C DoW Idx < MsgQEntSize C Eval Idx = Idx + 1 C Eval QualMsgQ = MsgQEntStr(Idx) * only msgq show onec * regardless of number times used. C If AryIdx = 0 or C %lookup(MsgQ :MsgQUsrAry:1:AryIdx) = 0 C Eval AryIdx = AryIdx + 1 C Eval MsgQUsrAry(AryIdx) = MsgQ C EndIf C EndDo *---------------------------------------------------------------- * Create user space C callp QUSCRTUS( C uSpaceName: C 'TEST': C 1500000: C x'00': C '*ALL': C 'User Space CHKJOBLOG' : C '*YES': C vApiErrDs) * set UserSpace to autoextended C CallP QUSCUSAT( QUSLib : C uSpaceName : C QUSAttr : C vApiErrDs ) * Get pointer to user space C callp QUSPTRUS( C uSpaceName: C uHeadPtr: C vApiErrDs) * call api to load job log into user space. C callp QMHLJOBL( C uSpaceName: C 'LJOB0100': C MsgSelectDS: C %len(MsgSelectDS): C 'JSLT0100': C vApiErrDs) * Process elements * C eval uListPtr = uHeadPtr + uOffSetToList 1B C do uNumOfEntrys * Message Type Example * 15 Escape, exception already handled when API is called MCH1211 * 17 Escape, exception not handled when API is called CPF9999 * 06 Sender's copy RNQ0102 * * Example Error: divide by zero * Job log sequence : MCH1211 Attempt made to divide by zero * for fixed point operation. * CPF9999 Function check. MCH1211 * unmonitored by TESTERR at statement 0000000007, instruction X'0000' * reply message=> RNQ0102 Attempt to divide by zero (C G D F). C If uMsgType = '06' or C uMsgType = '15' or C uMsgType = '17' C eval uListPtr2 = uHeadPtr + uOffsetToFlds C If uMsgType = '15' C eval msgtxt15 = C %subst(u2Data:1:U2LengthOfData) C EndIf C If uMsgType = '17' C eval msgtxt17 = C %subst(u2Data:1:U2LengthOfData) C EndIf C If uMsgType = '06' C eval msgtxt06 = C %subst(u2Data:1:U2LengthOfData) C EndIf C EndIf C eval uListPtr = uHeadPtr + uOffsetToNext 1E C enddo C eval msgtxt = '*** Job MSGW Error Message' + C ' *** ' + C 'Job ' + C %trim(jobnumber) + '/' + C %trim(jobuser) + '/' + C %trim(jobname) + ' ' + C 'error text:' + ' ' + C %trim(msgtxt15) + ' ' + C %trim(msgtxt17) + ' ' + C %trim(msgtxt06) C eval msgtxt494 = msgtxt C if %len(%trim(msgtxt15) + C %trim(msgtxt17) + C %trim(msgtxt06)) > 0 C exsr SndEzMsg C EndIf C return ********************************************************************** C SndEzMsg BegSr C callp QEZSNDMG( msgTypeA C : '*BREAK' C : msgtxt494 C : %len(msgtxt494) C : MsgQUsrAry C : AryIdx C : sentcode C : funccode C : ErrorCode C : 'N' C : *blanks C : '*USR' C : 0 ) C EndSr Command Source RTVMSGWJL CMD /* =============================================================== */ /* = Command....... RtvMsgwJL = */ /* = Source type... CMD = */ /* = Description... Retrieve MSGW Job ErrMsg from Job Log = */ /* = = */ /* = CPP........... RtvMsgwJLR = */ /* = = */ /* =============================================================== */ /* = Date : 2008/03/21 = */ /* = Author: Vengoal Chang = */ /* =============================================================== */ /* = Create strp: = */ /* = CRTBNDRPG PGM(RtvMsgwJLR) SRCFILE(LIB/QRPGLESRC) = */ /* = CRTCMD CMD(RtvMsgwJL) PGM(RtvMsgwJLR) + = */ /* = SRCFILE(LIB/QCMDSRC) = */ /* =============================================================== */ /*------------------------------------------------*/ /* Command Definition */ /*------------------------------------------------*/ CMD PROMPT('RTV MSGW Job Log and Send') PARM KWD(JOB) TYPE(*SNAME) LEN(10) MIN(1) + PROMPT('Job name') PARM KWD(USER) TYPE(*SNAME) LEN(10) MIN(1) + PROMPT('User name') PARM KWD(JOBNBR) TYPE(*CHAR) LEN(6) RANGE(000000 + 999999) MIN(1) PROMPT('Job number') PARM KWD(MSGTYPE) TYPE(*CHAR) LEN(5) RSTD(*YES) + DFT(*INFO) VALUES(*INFO *INQ) + PROMPT('Message type') PARM KWD(TOMSGQ) TYPE(MSGQ) MAX(20) PROMPT('Send + log to message queue') MSGQ: QUAL TYPE(*NAME) LEN(10) SPCVAL((QSYSOPR)) + EXPR(*YES) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL) (*CURLIB)) EXPR(*YES) + PROMPT(Library)