QWCRLCKI & QWCRLRQI - Retrieve Lock Information,..

QWCRLCKI: Retrieve Lock Information QWCRLRQI: Retrieve Lock Request Information ** ** Program . . : CBX144 ** Description : Retrieve lock information APIs - sample program ** Author . . : Carsten Flensburg ** Published . : Club Tech iSeries Programming Tips Newsletter ** Date . . . : September 29, 2005 ** ** ** Program summary ** --------------- ** ** ** Work management APIs: ** QWCRLCKI Retrieve lock Generates a list of information ** information about lock holders of the object ** specified. ** ** QWCRLRQI Retrieve lock request Takes as input a lock request ** information handle that was returned in other ** APIs and returns information ** about the program that requested ** the lock. ** ** This API must be called from the ** same thread that called the API ** that returned the lock request ** handle. ** ** Message handling API: ** QMHSNDPM Send program message Sends a message to a program stack ** entry (current, previous, etc.) or ** an external message queue. ** ** Both messages defined in a message ** file and immediate messages can be ** used. For specific message types ** only one or the other is allowed. ** ** ILE CEE APIs: ** CEERTX Register call stack Registers a procedure that runs ** entry termination when the call stack entry, for ** user exit procedure which it is registered, is ended ** by anything other than a return ** to the caller. ** ** CEEUTX Unregister call stack Unregisters a procedure that was ** entry termination previously registered by the ** user exit procedure CEERTX API. ** ** The CEEUTX API operates on the ** call stack entry termination user ** exits that are registered for the ** call stack entry from which the ** CEEUTX API is called. ** ** MI builtins: ** _MEMMOVE Copy memory Copies a string from one pointer ** specified location to another. ** ** ** Compile options: ** ** CrtRpgMod Module( CBX144 ) DbgView( *LIST ) ** ** CrtPgm Pgm( CBX144 ) ** Module( CBX146 ) ** ** **-- Header specifications: --------------------------------------------** H Option( *SrcStmt ) **-- Api error data structure: D ERRC0100 Ds Qualified D BytPro 10i 0 Inz( %Size( ERRC0100 )) D BytAvl 10i 0 Inz D MsgId 7a D 1a D MsgDta 128a **-- Global variables: D Idx s 10u 0 D IdxKey s 10u 0 D ApiRcvSiz s 10u 0 D MsgTxt s 512a Varying **-- List API parameters: D LstApi Ds Qualified Inz D NbrKeyRtn 10i 0 Inz( %Elem( LstApi.KeyFld )) D KeyFld 10i 0 Dim( 3 ) **-- Global constants: D OFS_MSGDTA c 16 D NO_RTN_KEY c 0 D TYP_JOBTHR c 0 D TYP_LCKSPC c 1 D ALL_RCD c 0 D OBJ_LVL c 0 D RCD_LVL c 1 **-- Object identification: D LOBJ0100 Ds Qualified D ObjIdSiz 10i 0 Inz( %Size( LOBJ0100 )) D ObjNam 10a D ObjLib 10a D ObjLibAps 10a D ObjTyp 10a D MbrNam 10a D 2a Inz( x'0000' ) D RcdLckI 10i 0 D RelRcdNbr 10u 0 ** D LOBJ0200 Ds Qualified D ObjHdlSiz 10i 0 Inz( %Size( LOBJ0200 )) D ObjLckHdl 64a **-- Lock filter: D LKFL0100 Ds Qualified D FltSiz 10i 0 Inz( %Size( LKFL0100 )) D FltLckStt 10i 0 Inz( *Zero ) D FltLckScp 10i 0 Inz( *Zero ) D FltLckSts 10i 0 Inz( *Zero ) D FltLckHlrTyp 1a Inz( '0' ) D FltMbrLckTyp 1a Inz( '0' ) **-- Lock information: D LCKI0100 Ds Qualified Based( pLckInf ) D BytRtn 10i 0 D BytAvl 10i 0 D TypEnt 10i 0 D ObjNamExt 30a D ObjLib 10a D ObjAsp 10a D ObjLibAsp 10a D ObjAspNbr 10i 0 D ObjLibAspNbr 10i 0 D ObjTyp 10a D ExtObjAtr 10a D NbrLckInfEntA 10i 0 D OfsLckInfEnt 10i 0 D NbrLckInfEntR 10i 0 D LenLckInfEnt 10i 0 ** D LckInfEnt Ds Based( pLckInfEnt ) Qualified D LckStt 10a D 2a D LckSts 10i 0 D LckScp 1a D 3a D LckSpcId 20a D LckRqsHdl 64a D LckCnt 10i 0 D MbrNam 10a D MbrLckTyp 1a D 1a D RelRcdNbr 10i 0 D DisHlrInf 10i 0 D DisKeyInf 10i 0 D NbrKeyRtn 10i 0 D HlrTyp 10i 0 **-- Key information: D KeyInf Ds Based( pKeyInf ) Qualified D FldInfLen 10i 0 D KeyFld 10i 0 D DtaTyp 1a D 3a D DtaLen 10i 0 D Data 64a **-- Lock holder - job/thread format: D HlrJobThr Ds Based( pJobThrFmt ) Qualified D HlrInfSiz 10i 0 D JobNam 10a D UsrNam 10a D JobNbr 6a D ThdId 8a D 2a D ThdHdl 10u 0 **-- Lock holder - lock space format: D HlrLckSpc Ds Based( pLckSpcFmt ) Qualified D HlrInfSiz 10i 0 D HldLckSpcId 20a D UsrNam 10a D JobNbr 6a D ThdId 8a D 2a D ThdHdl 10u 0 **-- Lock request identification: D LRQI0100 Ds 4096 Qualified D BytRtn 10i 0 D BytAvl 10i 0 D OfsStmIds 10i 0 D NbrStmIds 10i 0 D OfsPrcNam 10i 0 D LenPrcNam 10i 0 D PgmNam 10a D PgmLib 10a D PgmAsp 10a D PgmLibAsp 10a D PgmAspNbr 10i 0 D PgmLibAspNbr 10i 0 D MiInstNbr 10i 0 D ModNam 10a D ModLib 10a **-- API return information: D PrcNam s 1024a Inz Varying D StmIds s 10a Inz Dim( 64 ) D pJobThrFmt s * Inz( *Null ) D pLckSpcFmt s * Inz( *Null ) ** D KeyDta Ds Qualified Inz D ActJobSts 4a D FcnNam 10a D MsgRpy 1a **-- Retrieve lock information: D RtvLckInf Pr ExtPgm( 'QWCRLCKI' ) D RcvVar 65535a Options( *VarSize ) D RcvVarLen 10i 0 Const D FmtNam 8a Const D ObjId 68a Const Options( *VarSize ) D ObjIdFmt 8a Const D NbrKeyFld 10i 0 Const D KeyFldRtn 10i 0 Const Options( *VarSize ) Dim( 32 ) D Filter 18a Const Options( *VarSize ) D FltFmt 8a Const D Error 32767a Options( *VarSize ) **-- Retrieve lock request information: D RtvLckRqsInf Pr ExtPgm( 'QWCRLRQI' ) D RcvVar 65535a Options( *VarSize ) D RcvVarLen 10i 0 Const D FmtNam 8a Const D RqsHdl 64a Const D Error 32767a Options( *VarSize ) **-- Send program message: D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' ) D MsgId 7a Const D MsgFq 20a Const D MsgDta 128a Const D MsgDtaLen 10i 0 Const D MsgTyp 10a Const D CalStkE 10a Const Options( *VarSize ) D CalStkCtr 10i 0 Const D MsgKey 4a D Error 32767a Options( *VarSize ) **-- Register termination exit: D CeeRtx Pr ExtProc( 'CEERTX' ) D procedure * ProcPtr Const D token * Options( *Omit ) D fb 12a Options( *Omit ) **-- Unregister termination exit: D CeeUtx Pr ExtProc( 'CEEUTX' ) D procedure * ProcPtr Const D fb 12a Options( *Omit ) **-- Copy memory: D memcpy Pr * ExtProc( '_MEMMOVE' ) D pOutMem * Value D pInpMem * Value D iMemSiz 10u 0 Value **-- Send completion message: D SndCmpMsg Pr 10i 0 D PxMsgDta 512a Const Varying **-- Send escape message: D SndEscMsg Pr 10i 0 D PxMsgId 7a Const D PxMsgF 10a Const D PxMsgDta 512a Const Varying **-- Send message by type: D SndMsgTyp Pr 10i 0 D PxMsgDta 512a Const Varying D PxMsgTyp 10a Const **-- Terminate program: D TrmPgm Pr D pPtr * **-- Entry parameters: D SavOfs Ds Based( pNull ) D NbrElm 5i 0 D DatFrm 7a D TimFrm 6a ** D CBX144 Pr D PxObjNam_q 20a D PxObjTyp 10a D PxMbrNam 10a D PxRelRcdNbr 10p 0 ** D CBX144 Pi D PxObjNam_q 20a D PxObjTyp 10a D PxMbrNam 10a D PxRelRcdNbr 10p 0 /Free //-- Step 1: ExSr InzParms; //-- Step 2a: ApiRcvSiz = 65535; pLckInf = %Alloc( ApiRcvSiz ); LCKI0100.BytAvl = *Zero; DoU LCKI0100.BytAvl <= ApiRcvSiz Or ERRC0100.BytAvl > *Zero; //-- Step 2b: If LCKI0100.BytAvl > ApiRcvSiz; ApiRcvSiz = LCKI0100.BytAvl; pLckInf = %ReAlloc( pLckInf: ApiRcvSiz ); EndIf; RtvLckInf( LCKI0100 : ApiRcvSiz : 'LCKI0100' : LOBJ0100 : 'LOBJ0100' : LstApi.NbrKeyRtn : LstApi.KeyFld : LKFL0100 : 'LKFL0100' : ERRC0100 ); EndDo; //-- Step 3: CeeRtx( %Paddr( TrmPgm ): pLckInf: *Omit ); If ERRC0100.BytAvl > *Zero; SndEscMsg( ERRC0100.MsgId : 'QCPFMSG' : %Subst( ERRC0100.MsgDta: 1: ERRC0100.BytAvl - OFS_MSGDTA ) ); Else; //-- Step 4: ExSr PrcLstEnt; SndCmpMsg( 'Lock API example completed normally.' ); EndIf; //-- Step 5: CeeUtx( %Paddr( TrmPgm ): *Omit ); TrmPgm( pLckInf ); *InLr = *On; Return; BegSr InzParms; LOBJ0100.ObjNam = %Subst( PxObjNam_q: 1: 10 ); LOBJ0100.ObjLib = %Subst( PxObjNam_q: 11: 10 ); LOBJ0100.ObjLibAps = '*'; LOBJ0100.ObjTyp = PxObjTyp; LOBJ0100.MbrNam = PxMbrNam; Select; When PxRelRcdNbr = -1; LOBJ0100.RcdLckI = RCD_LVL; LOBJ0100.RelRcdNbr = ALL_RCD; When PxRelRcdNbr > 0; LOBJ0100.RcdLckI = RCD_LVL; LOBJ0100.RelRcdNbr = PxRelRcdNbr; Other; LOBJ0100.RcdLckI = OBJ_LVL; LOBJ0100.RelRcdNbr = 0; EndSl; LstApi.KeyFld(1) = 101; LstApi.KeyFld(2) = 601; LstApi.KeyFld(3) = 1307; EndSr; BegSr PrcLstEnt; pLckInfEnt = pLckInf + LCKI0100.OfsLckInfEnt; For Idx = 1 to LCKI0100.NbrLckInfEntR; If LckInfEnt.LckStt <> '*NONE'; If LckInfEnt.HlrTyp = TYP_JOBTHR; pJobThrFmt = pLckInfEnt + LckInfEnt.DisHlrInf; Else; pLckSpcFmt = pLckInfEnt + LckInfEnt.DisHlrInf; EndIf; ExSr GetKeyDta; RtvLckRqsInf( LRQI0100 : %Size( LRQI0100 ) : 'LRQI0100' : LckInfEnt.LckRqsHdl : ERRC0100 ); If ERRC0100.BytAvl = *Zero; ExSr PrcRqsEnt; EndIf; // All retrieved data available at this point: If pJobThrFmt <> *Null; // Job or thread information retrieved Else; // Lock space information retrieved EndIf; If Idx < LCKI0100.NbrLckInfEntR; Reset KeyDta; Reset StmIds; Reset PrcNam; Reset pJobThrFmt; Reset pLckSpcFmt; pLckInfEnt += LCKI0100.LenLckInfEnt; EndIf; EndIf; EndFor; EndSr; BegSr PrcRqsEnt; If LRQI0100.OfsPrcNam > *Zero; PrcNam = %Subst( LRQI0100: LRQI0100.OfsPrcNam: LRQI0100.LenPrcNam ); EndIf; If LRQI0100.OfsStmIds > *Zero; memcpy( %Addr( StmIds ) : %Addr( LRQI0100 ) + LRQI0100.OfsStmIds : LRQI0100.NbrStmIds * %Size( StmIds ) ); EndIf; EndSr; BegSr GetKeyDta; pKeyInf = pLckInfEnt + LckInfEnt.DisKeyInf; For IdxKey = 1 To LckInfEnt.NbrKeyRtn; Select; When KeyInf.KeyFld = 101; KeyDta.ActJobSts = %Subst( KeyInf.Data: 1: KeyInf.DtaLen ); When KeyInf.KeyFld = 601; KeyDta.FcnNam = %Subst( KeyInf.Data: 1: KeyInf.DtaLen ); When KeyInf.KeyFld = 1307; KeyDta.MsgRpy = %Subst( KeyInf.Data: 1: KeyInf.DtaLen ); EndSl; If IdxKey < LckInfEnt.NbrKeyRtn; pKeyInf = pKeyInf + KeyInf.FldInfLen; EndIf; EndFor; EndSr; /End-Free **-- Send completion message: ------------------------------------------** P SndCmpMsg B D Pi 10i 0 D PxMsgDta 512a Const Varying ** D MsgKey s 4a /Free SndPgmMsg( 'CPF9897' : 'QCPFMSG *LIBL' : PxMsgDta : %Len( PxMsgDta ) : '*COMP' : '*PGMBDY' : 1 : MsgKey : ERRC0100 ); If ERRC0100.BytAvl > *Zero; Return -1; Else; Return 0; EndIf; /End-Free ** P SndCmpMsg E **-- Send escape message: ----------------------------------------------** P SndEscMsg B D Pi 10i 0 D PxMsgId 7a Const D PxMsgF 10a Const D PxMsgDta 512a Const Varying ** D MsgKey s 4a /Free SndPgmMsg( PxMsgId : PxMsgF + '*LIBL' : PxMsgDta : %Len( PxMsgDta ) : '*ESCAPE' : '*PGMBDY' : 1 : MsgKey : ERRC0100 ); If ERRC0100.BytAvl > *Zero; Return -1; Else; Return 0; EndIf; /End-Free P SndEscMsg E **-- Send message by type: ---------------------------------------------** P SndMsgTyp B D Pi 10i 0 D PxMsgDta 512a Const Varying D PxMsgTyp 10a Const ** D MsgKey s 4a /Free SndPgmMsg( 'CPF9897' : 'QCPFMSG *LIBL' : PxMsgDta : %Len( PxMsgDta ) : PxMsgTyp : '*PGMBDY' : 1 : MsgKey : ERRC0100 ); If ERRC0100.BytAvl > *Zero; Return -1; Else; Return 0; EndIf; /End-Free P SndMsgTyp E **-- Terminate program: ------------------------------------------------** P TrmPgm B D Pi D pPtr * /Free DeAlloc pPtr; *InLr = *On; Return; /End-Free P TrmPgm E /*-------------------------------------------------------------------*/ /* */ /* Program . . : CBX144T */ /* Description : Retrieve lock information APIs - test */ /* Author . . : Carsten Flensburg */ /* Published . : Club Tech iSeries Programming Tips Newsletter */ /* Date . . . : September 29, 2005 */ /* */ /* */ /* Compile options: */ /* CrtClPgm Pgm( CBX144T ) */ /* SrcFile( QCLSRC ) */ /* SrcMbr( *PGM ) */ /* */ /*-------------------------------------------------------------------*/ Pgm Dcl &ObjNam_q *Char 20 Dcl &ObjTyp *Char 10 Dcl &MbrNam *Char 10 Dcl &RelRcdNbr *Dec 10 Dcl &ALL_RCD *Dec 10 -1 Dcl &IGN_RCD *Dec 10 0 /*-- Retrieve object locks: --*/ ChgVar &ObjNam_q '(obj-name)(library )' ChgVar &ObjTyp '(obj-type)' ChgVar &MbrNam '*NONE ' ChgVar &RelRcdNbr &IGN_RCD Call CBX144 Parm( &ObjNam_q &Objtyp &MbrNam &RelRcdNbr ) /*-- Retrieve file member locks: --*/ ChgVar &ObjNam_q '(filename)(library )' ChgVar &ObjTyp '*FILE ' ChgVar &MbrNam '(mbr-name)' ChgVar &RelRcdNbr &IGN_RCD Call CBX144 Parm( &ObjNam_q &Objtyp &MbrNam &RelRcdNbr ) /*-- Retrieve file record lock - specific record: --*/ ChgVar &ObjNam_q '(filename)(library )' ChgVar &ObjTyp '*FILE ' ChgVar &MbrNam '(mbr.name)' ChgVar &RelRcdNbr 27 Call CBX144 Parm( &ObjNam_q &Objtyp &MbrNam &RelRcdNbr ) /*-- Retrieve file record locks - all records: --*/ ChgVar &ObjNam_q '(filename)(library )' ChgVar &ObjTyp '*FILE ' ChgVar &MbrNam '(mbr-name)' ChgVar &RelRcdNbr &ALL_RCD Call CBX144 Parm( &ObjNam_q &Objtyp &MbrNam &RelRcdNbr ) EndPgm: EndPgm Important note: While testing the code included with this article, I ran into some situations where a system module would get stuck in a loop. The situation seems to arise when more than 800?000 locks are held against a specified object, but it never seems to arise when fewer locks are held. I have informed IBM of this problem and am waiting for a response. Until this issue is resolved, please be cautious about running the sample program, to avoid interfering with the workload in a production system. If you do get stuck in a loop, you can exit it by pressing System Request and taking Option 2. Thanks to Carsten Flensburg writing for Club Tech iSeries Programming Tips Newsletter