Managing Record Locks
Create a generic record lock handler
Record locks were something many developers (and shop standards) failed to address in the past. There is no excuse for not providing exception manange for this type of error. After all, there are many solutions to address the issue. Committment control comes to mind but many shops rejected the notion of incurring the overhead of journaling. I eventually developed an application development system that avoided record locks entirely by encapsulating a database file with a service program. All applications made requests to the file manager for inserts, deletes, and updates. Since the file existed in only one application (the service program) record locks were not an issue. Long before then, I had written a generic record lock handling program that managed record locks, interactively and in batch mode. Until the day I retired, I never understood why record lock handling was not a standard part of application development. No user should ever CPF5027 appear on their workstation. Exception management makes better applications and better relations with the user community.
H/TITLE ** Standard error handler to record locks **
H DEBUG(*YES) BNDDIR('SOFTCODE')
H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP('QILE')
********************************************************************
* PROGRAM NAME - SC0130RP *
* *
* FUNCTION - This program will function as the standard *
* record lock monitor for interactive and batch *
* programs. Interactively if will display a *
* pop-up window to the user with lock information. *
* In batch mode the program will send a message *
* to the system operator message queue. *
* *
* PROGRAMMER - STEVE CROY 06/22/2005 *
********************************************************************
********************************************************************
* ** INDICATOR USAGE *** *
* ** ON ** ** OFF ** *
* 50 -- ALLOW FUNCTION KEY TO BY-PASS UPDATE *
* F3 -- EXIT *
* *
* ** ERROR INDICATORS ** *
* *
********************************************************************
********************************************************************
* MODIFICATION LOG *
* *
* DATE PROGRAMMER DESCRIPTION *
* *
********************************************************************
FSC0130DF CF E WORKSTN USROPN
F MAXDEV(*FILE)
F INFDS(DSPDS)
D CF E DS EXTNAME(SCKEYSPF) qualified Function keys
D PGMDS ESDS EXTNAME(SCPSTSPf) Pgm status map
D DSPDS E DS EXTNAME(SCDSPFPF) Display INFDS
/copy qrpglesrc sc0000_pr
D SC0130RP PR
D CPFMessage 80
D CallingPgm 10
D ExitAllowed 1
D BypassLock 1
D FileLocked 8
D SC0130RP PI
D CPFMessage 80
D CallingPgm 10
D ExitAllowed 1
D BypassLock 1
D FileLocked 8
D QMHSNDM PR ExtPgm('QMHSNDM')
D MsgID 7A const
D QualMsgF 20A const
D MsgTxt 32767A const options(*varsize)
D MsgTxtLen 10I 0 const
D MsgType 10A const
D MsgQueues 20A const dim(50) options(*varsize)
D NumQueues 10I 0 const
D RpyQueue 20A const
D MsgKey 4A
D ErrorCode 8000A options(*varsize)
D CCSID 10I 0 const options(*nopass)
D QMHRCVPM PR ExtPgm('QMHRCVPM')
D MsgInfo 32767A options(*varsize)
D MsgInfoLen 10I 0 const
D Format 8A const
D StackEntry 10A const
D StackCount 10I 0 const
D MsgType 10A const
D MsgKey 4A const
D WaitTime 10I 0 const
D MsgAction 10A const
D ErrorCode 8000A options(*varsize)
D RCVM0100 DS qualified
D BytesRtn 10I 0
D BytesAvail 10I 0
D MsgSev 10I 0
D MsgID 7A
D MsgType 2A
D MsgKey 4A
D 7A
D CCSID_status 10I 0
D CCSID 10I 0
D MsgDtaLen 10I 0
D MsgDtaAvail 10I 0
D MsgDta 8000A
D ErrorCode ds qualified
D BytesProv 10I 0 inz(0)
D BytesAvail 10I 0 inz(0)
*---------------------------------------------------------------------
* Define constants
*---------------------------------------------------------------------
D #YES C CONST('Y')
D #NO C CONST('N')
*---------------------------------------------------------------------
* START of work fields
*---------------------------------------------------------------------
D action1 s 25A inz('Reply R to retry lock')
D action2 s 30A inz('reply C cancel (by-pass) lock')
D Function S 10
D JobAttr S 1A
D NbrSecs S 15 5 inz(180)
D Cmd S 256 inz('Dspmsg')
D Len S 15 5 inz(6)
D Message s 256A varying
D MsgKey s 4A
D MsgQ s 20A dim(1) inz('*SYSOPR')
D Reply s 100A
*---------------------------------------------------------------------
* END of work fields
*---------------------------------------------------------------------
JobAttr = GetJobAtr() ;
IF JobAttr = 'I' ;
EXSR @Interactive ;
ELSE ;
EXSR @BatchMode ;
ENDIF ;
*INLR = *ON ;
RETURN ;
BEGSR @BatchMode ;
//----------------------------------------------------
// Create a message to send to the system operator.
// Send an *INQ message to QSYSOPR asking for a reply.
//----------------------------------------------------
Reply = 'R' ;
Message = %trim(cpfmessage) + ' ' + %trim(action1) ;
IF ExitAllowed = #YES ;
Message = %trim(Message) + ' ' + %trim(action2) + '.' ;
ELSE ;
Message = %trim(Message) + '.' ;
ENDIF ;
QMHSNDM( *blanks :
*blanks :
Message :
%len(Message) :
'*INQ' :
MsgQ :
%elem(MsgQ) :
'*PGMQ' :
MsgKey :
ErrorCode ) ;
//----------------------------------------------------
// Wait up to 5 minutes (300 seconds) for a reply to the
// above message. If you change the value of 300 below to
// a value of -1 it will wait indefinitely.
//----------------------------------------------------
QMHRCVPM( RCVM0100 :
%size(RCVM0100) :
'RCVM0100' :
'*' :
0 :
'*RPY' :
MsgKey :
300 :
'*REMOVE' :
ErrorCode ) ;
//----------------------------------------------------
// The "Reply" Variable contains the operator's reply
// If the reply was C (cancel) by-pass update
//----------------------------------------------------
IF RCVM0100.BytesRtn > 0 AND RCVM0100.MsgDta <> *blank ;
Reply = %subst(RCVM0100.MsgDta: 1: RCVM0100.MsgDtaLen) ;
ENDIF ;
IF Reply = *blank ;
Reply = 'R' ;
ENDIF ;
Reply = UpperCase(Reply:%size(Reply)) ;
IF %subst(Reply:1:1) = 'C' ;
BypassLock = *ON ;
ELSE ;
BypassLock = *OFF ;
ENDIF ;
ENDSR ;
BEGSR @Interactive ;
//----------------------------------------------------
// Open the display file to show the lock window
//----------------------------------------------------
IF not %open(SC0130DF) ;
OPEN SC0130DF ;
ENDIF ;
cf = FunctionKeys() ;
BypassLock = *OFF ;
z$msg1 = %subst(CPFMessage:1:40) ;
z$msg2 = %subst(CPFMessage:41:40) ;
errpgm = CallingPgm ;
errnam = FileLocked ;
// Determine if user allowed to use ESCAPE
*IN50 = ExitAllowed = #YES ;
//----------------------------------------------------
// Display record lock message until request to exit
// If F3 was used then by-pass update if allowed
//----------------------------------------------------
WRITE SC013001 ;
DOU Function = 'EXIT' ;
MONITOR ;
WRITE SC013002 ;
READ SC0130DF ;
ON-ERROR *FILE ;
KeyPressed = cf.ENTER ;
ENDMON ;
SELECT ;
WHEN KeyPressed = cf.F3 ;
IF *IN50 ;
BypassLock = *ON ;
ENDIF ;
Function = 'EXIT' ;
WHEN KeyPressed = cf.ENTER ;
Function = 'EXIT' ;
ENDSL ;
ENDDO ;
//----------------------------------------------------
// Close lock warning display
//----------------------------------------------------
IF %open (SC0130DF) ;
CLOSE SC0130DF ;
ENDIF ;
ENDSR ;
The program is bound to a service program so it has access to the procedures to determine if the job is interactive or batch. The display file will not open in batch mode--to avoid generating an error in the error handling program!
For a look at the code behind the generic record lock handler, read the PDF. The document contains an example of the lock handler in use (demo), in an interactive job and in a batch process. There is also a copy of the RPG and DDS souce included.