Use APIs to determine and resolve current lock holders.
Last month, in "Problems Allocating an Object?," we looked at the program AllocObj. With AllocObj, we used the List Object Locks (QWCLOBJL) API to get a list of all jobs holding a lock on a given object and then displayed the name of the first job (that wasn't the current job) in that list. This month's "API Corner" will expand the capabilities of AllocObj. The updated AllocObj will, if run in an interactive job, build a subfile listing those jobs with locks on the object. From this list, the user can decide to contact someone about one or more of these jobs, end one of more of these jobs, and/or cancel the current running of AllocObj. If the current job is not interactive, then (at least for this month) AllocObj will run as it did in last month's article. Next month, we'll look at some of the batch opportunities for enhancements to AllocObj.
Below is the source that we will use for display file AllocObjFM. Assuming this source is stored in member ALLOCOBJFM of source file QDDSSRC, you can create the *DSPF using the command CRTDSPF.
A CA03(03 'Exit')
A**************************************************************
A R RSFL01 SFL
A H1JOBNAME 28A H
A S1OPT 1A B 13 3VALUES(' ' 'E' 'F')
A S1JOBNAME 28A O 13 6
A S1JOBSTS 20A O 13 40
A**************************************************************
A R RCTL01 SFLCTL(RSFL01)
A CF05(05 'Refresh')
A CF08(08 'End all controlled')
A CF09(09 'End all immediate')
A OVERLAY
A 32 SFLDSP
A 33 SFLDSPCTL
A 30 SFLCLR
A 32 SFLEND(*MORE)
A SFLSIZ(0009)
A SFLPAG(0008)
A 1 3'ALLOCOBJ '
A COLOR(BLU)
A 1 72DATE
A EDTCDE(Y)
A COLOR(BLU)
A*
A 2 29'Work with Object Locks'
A COLOR(WHT)
A 2 72TIME
A COLOR(BLU)
A*
A 4 2'The following jobs +
A currently hold locks on'
A OBJID 32A 4 45
A*
A 5 2'The current job cannot +
A continue until these +
A locks are released.'
A*
A 6 2'NOTE: Exiting with F3 will +
A most likely cause the current +
A job to FAIL'
A*
A 8 2'Type options, press +
A Enter.'
A COLOR(BLU)
A*
A 10 2'E=End job controlled'
A COLOR(BLU)
A 10 25'F=End job immediate'
A COLOR(BLU)
A*
A 12 2'Opt'
A COLOR(WHT)
A DSPATR(UL)
A 12 6'Job name '
A COLOR(WHT)
A DSPATR(UL)
A 12 40'Status '
A COLOR(WHT)
A DSPATR(UL)
A****************************************************************
A R RCTL01F
A 22 2'F3=Exit'
A COLOR(BLU)
A 22 30'F5=Refresh'
A COLOR(BLU)
A*
A 23 2'F8=End unmarked controlled'
A COLOR(BLU)
A 23 30'F9=End unmarked immediate'
A COLOR(BLU)
For each unique job holding a lock on the object AllocObj is trying to allocate, the user will be presented the name of the job and the status of the job. Currently, the only status shown (other than blanks) is that the job is in the process of ending. For each job in the list, the user can elect to cancel the job in a controlled fashion (option 'E') or immediately (option 'F'). In addition, the user can use:
- F3 to end the AllocObj program without allocating the object
- F5 to get a refreshed list of the jobs holding locks on the object
- F8 to end all jobs in the list (that are not selected with option 'F') using OPTION(*CNTRLD) of the End Job (ENDJOB) command
- F9 to end all jobs in the list (that are not selected with option 'E') using OPTION(*IMMED) of the End Job (ENDJOB) command
To support this subfile, the updated source for AllocObj is shown below. To compile AllocObj, you can use the command CRTBNDRPG PGM(ALLOCOBJ).
h DftActGrp(*no)
fAllocObjFMcf e workstn usropn
f sfile(RSFL01 :SRRN01)
d AllocObj pr
d Obj_In 10a const
d Lib_In 10a const
d ObjTyp_In 10a const
d GotAlc_In n
d AllocObj pi
d Obj_In 10a const
d Lib_In 10a const
d ObjTyp_In 10a const
d GotAlc_In n
*******************************************************************
d Allocate pr n
d ChkForDDM pr
d CrtUsrSpc pr extpgm('QUSCRTUS')
d QualUsrSpcN 20a const
d XAttr 10a const
d IntSize 10i 0 const
d IntValue 1a const
d PubAut 10a const
d TxtDesc 50a const
d ReplaceOpt 10a const options(*nopass)
d ErrCde likeds(QUSEC) options(*nopass)
d Domain 10a const options(*nopass)
d TfrSize 10i 0 const options(*nopass)
d OptSpcAlgn 1a const options(*nopass)
d EndCntrld pr
d JobName 28a const
d EndImmed pr
d JobName 28a const
d EnterKey pr
d GetLckHldrs pr
d LstObjLcks pr extpgm('QWCLOBJL')
d QualSpcName 20a const
d Format 8a const
d QualObjName 20a const
d ObjType 10a const
d MbrName 10a const
d ErrCde likeds(QUSEC)
d Path 1a const options(*nopass)
d LenPath 10i 0 const options(*nopass)
d ASP 10a const options(*nopass)
d MassEnd pr
d PrcLcksB pr
d PrcLcksI pr
d RtvJobI pr extpgm('QUSRJOBI')
d RcvVar 1a options(*varsize)
d LenRcvVar 10i 0 const
d Format 8a const
d QualJobName 26a const
d IntJobID 16a const
d ErrCde likeds(QUSEC) options(*nopass)
d ResetPfrDta 1a const options(*nopass)
d RtvUsrSpcPtr pr extpgm('QUSPTRUS')
d QualUsrSpcN 20a const
d UsrSpcPtr *
d ErrCde likeds(QUSEC) options(*nopass)
d RunCmd pr extpgm('QCAPCMD')
d SrcCmdStr 4096a const options(*varsize)
d LenSrcStr 10i 0 const
d OptCtlBlk 4096a const options(*varsize)
d LenCtlBlk 10i 0 const
d Format 8a const
d ChgCmdStr 1a options(*varsize)
d LenChgStr 10i 0 const
d LenRtnChgStr 10i 0
d ErrCde likeds(QUSEC)
*******************************************************************
d LckSpcPtr s *
d LckHdr ds likeds(QUSH0100)
d based(LckSpcPtr)
d APIHdrPtr s *
d APIHdr ds likeds(QWCOBJLH)
d based(APIHdrPtr)
d JobEntPtr s *
d JobEnt ds likeds(QWC0100L)
d based(JobEntPtr)
d ErrCde ds qualified
d Hdr likeds(QUSEC)
d MsgDta 256a
*******************************************************************
d SRRN01 s 5s 0
d Answer s 1a
d Cmd s 4096a varying
d Exit s n
d LckSpcName s 20a inz('ALLOCOBJ QTEMP')
d LenRtnCmd s 10i 0
d RtnCmd s 1a
d X s 10i 0
*******************************************************************
/copy qsysinc/qrpglesrc,qcapcmd
/copy qsysinc/qrpglesrc,qusec
/copy qsysinc/qrpglesrc,qusgen
/copy qsysinc/qrpglesrc,qusrjobi
/copy qsysinc/qrpglesrc,qwclobjl
*******************************************************************
/free
// Loop until we get the object allocation
dow (not Allocate());
if Exit;
leave;
endif;
GetLckHldrs();
if Exit;
leave;
endif;
enddo;
*inlr = *on;
return;
// ***************************************************************
begsr *inzsr;
// Set API QUSEC parameter to send exceptions
QUSBPrv = 0;
// Set API ErrCde parameter to not send exceptions
ErrCde.Hdr.QUSBPrv = %size(ErrCde);
// Set QCAPCMD Options Control Block for running CL commands
QCAP0100 = *Allx'00';
QCACmdPT = 0;
QCABCSDH = '0';
QCAPA = '0';
QCACmdSS = '0';
QCAMK = *blanks;
QCASIDCS = 0;
// Get access to user space for object lock info
RtvUsrSpcPtr(LckSpcName :LckSpcPtr :ErrCde);
select;
when ErrCde.Hdr.QUSBAvl = 0;
// All is OK
when ErrCde.Hdr.QUSEI = 'CPF9801';
// UsrSpc not found, so create it
CrtUsrSpc(LckSpcName :'OBJ_LOCKS' :4096
:x'00' :'*ALL' :'List of lock holders'
:'*YES' :QUSEC :'*DEFAULT' :0 :'1');
// Get accessibility to user space
RtvUsrSpcPtr(LckSpcName :LckSpcPtr :QUSEC);
other;
// Something seriously wrong, return in same
// manner as with MsgD problem
return;
endsl;
// Get job information
RtvJobI(QUSI010000 :%size(QUSI010000) :'JOBI0100' :'*' :' ' :QUSEC);
// Set GotAlc_In parameter to lock not obtained
GotAlc_In = *off;
endsr;
/end-free
*******************************************************************
p Allocate b
d Allocate pi n
/free
Cmd = 'AlcObj Obj((' +
%trimr(Lib_In) + '/' + %trimr(Obj_In) + ' ' +
%trimr(ObjTyp_In) + ' *EXCL)) Conflict(*RqsRls)';
RunCmd(Cmd :%len(Cmd) :QCAP0100 :%size(QCAP0100)
:'CPOP0100' :RtnCmd :0 :LenRtnCmd :ErrCde);
select;
when ErrCde.Hdr.QUSBAvl = 0;
// We got the lock so no need to worry about
// other jobs having a lock.
GotAlc_In = *on;
return *on;
when ErrCde.Hdr.QUSEI = 'CPF1002';
// Return letting caller know that someone has a lock
return *off;
other;
// Return letting caller know that we have a problem
// beyond being unable to allocate the object.
Exit = *on;
return *off;
endsl;
/end-free
p Allocate e
*******************************************************************
p GetLckHldrs b
d GetLckHldrs pi
/free
// Get list of jobs holding locks
LstObjLcks(LckSpcName :'OBJL0100'
:(Obj_In + Lib_In) :ObjTyp_In :'*NONE' :QUSEC);
if QUSJT02 = 'I';
// Interactive, use subfile
PrcLcksI();
else;
// Batch, use messages (next month)
PrcLcksB();
endif;
/end-free
p GetLckHldrs e
*******************************************************************
p PrcLcksI b
d PrcLcksI pi
d Jobs s 26 dim(9999)
d NbrJobs s 5i 0
/free
SRRN01 = 0;
NbrJobs = 0;
S1Opt = *blanks;
if ((LckHdr.QUSIS = 'C') or (LckHdr.QUSIS = 'P'));
for X = 1 to LckHdr.QUSNbrLE;
if X = 1;
JobEntPtr = LckSpcPtr + LckHdr.QUSOLD;
else;
JobEntPtr += LckHdr.QUSSEE;
endif;
if ((JobEnt.QWCJN01 = QUSJN01) and
(JobEnt.QWCJUN = QUSUN01) and
(JobEnt.QWCJNbr = QUSJNbr01));
// Do not count current job
iter;
endif;
if NbrJobs = 0;
NbrJobs = 1;
Jobs(NbrJobs) = (JobEnt.QWCJN01 +
JobEnt.QWCJUN +
JobEnt.QWCJNbr);
if (not %open(AllocObjFM));
open AllocObjFM;
ObjID = %trimr(ObjTyp_In) + ' ' +
%trimr(Lib_In) + '/' +
Obj_In;
endif;
*in30 = *on;
write RCtl01;
*in30 = *off;
exsr UpdSFL;
else;
// As one job can have multiple locks,
// have we already seen this job?
if %lookup((JobEnt.QWCJN01 + JobEnt.QWCJUN +
JobEnt.QWCJNbr)
:Jobs :1 :NbrJobs) = 0;
NbrJobs += 1;
Jobs(NbrJobs) = (JobEnt.QWCJN01 +
JobEnt.QWCJUN +
JobEnt.QWCJNbr);
exsr UpdSFL;
else;
// Previously processed
iter;
endif;
endif;
endfor;
if SRRN01 > 0;
// Jobs with locks found
*in32 = *on;
*in33 = *on;
write RCtl01F;
exfmt RCtl01;
select;
when *in03;
Exit = *on;
when *in05;
when *in08;
MassEnd();
when *in09;
MassEnd();
other;
EnterKey();
endsl;
endif;
if NbrJobs = 0;
// No one found so check if DDMF
if ObjTyp_In = '*FILE';
ChkForDDM();
endif;
endif;
endif;
return;
// ***************************************************************
begsr UpdSFL;
RtvJobI(QUSI0600 :%size(QUSI0600) :'JOBI0600'
:(JobEnt.QWCJN01 + JobEnt.QWCJUN + JobEnt.QWCJNbr)
:' ' :ErrCde);
select;
when ErrCde.Hdr.QUSBAvl > 0;
if ErrCde.Hdr.QUSEI = 'CPF1321';
// Job is gone
leavesr;
else;
S1JobSts = 'Error ' + ErrCde.Hdr.QUSEI;
endif;
when QUSJS14 = '*OUTQ';
// Job is effectively gone
leavesr;
when QUSES00 = '1';
S1JobSts = 'In process of ending';
other;
S1JobSts = *blanks;
endsl;
S1JobName = %trimr(JobEnt.QWCJN01) + '/' +
%trimr(JobEnt.QWCJUN) + '/' +
JobEnt.QWCJNbr;
H1JobName = JobEnt.QWCJNbr + '/' +
%trimr(JobEnt.QWCJUN) + '/' +
%trimr(JobEnt.QWCJN01);
SRRN01 += 1;
write RSFL01;
endsr;
/end-free
p PrcLcksI e
*******************************************************************
p MassEnd b
d MassEnd pi
/free
X = SRRN01;
for SRRN01 = 1 to X;
chain SRRN01 RSFL01;
select;
when S1Opt = *blanks;
select;
when *in08;
EndCntrld(H1JobName);
when *in09;
EndImmed(H1JobName);
endsl;
when S1Opt = 'E';
EndCntrld(H1JobName);
when S1Opt = 'F';
EndImmed(H1JobName);
endsl;
endfor;
/end-free
p MassEnd e
*******************************************************************
p EnterKey b
d EnterKey pi
/free
readc RSFL01;
dow (not %eof(AllocObjFM));
select;
when S1Opt = *blanks;
// Null entry
when S1Opt = 'E';
EndCntrld(H1JobName);
when S1Opt = 'F';
EndImmed(H1JobName);
endsl;
readc RSFL01;
enddo;
/end-free
p EnterKey e
*******************************************************************
p EndCntrld b
d EndCntrld pi
d JobName 28a const
/free
Cmd = 'EndJob Job(' + %trimr(JobName) +
') Option(*Cntrld)';
RunCmd(Cmd :%len(Cmd) :QCAP0100 :%size(QCAP0100)
:'CPOP0100' :RtnCmd :0 :LenRtnCmd :ErrCde);
/end-free
p EndCntrld e
*******************************************************************
p EndImmed b
d EndImmed pi
d JobName 28a const
/free
Cmd = 'EndJob Job(' + %trimr(JobName) +
') Option(*Immed)';
RunCmd(Cmd :%len(Cmd) :QCAP0100 :%size(QCAP0100)
:'CPOP0100' :RtnCmd :0 :LenRtnCmd :ErrCde);
/end-free
p EndImmed e
*******************************************************************
p PrcLcksB b
d PrcLcksB pi
d FoundOne s n
/free
if ((LckHdr.QUSIS = 'C') or (LckHdr.QUSIS = 'P'));
for X = 1 to LckHdr.QUSNbrLE;
if X = 1;
JobEntPtr = LckSpcPtr + LckHdr.QUSOLD;
else;
JobEntPtr += LckHdr.QUSSEE;
endif;
if ((JobEnt.QWCJN01 <> QUSJN01) or
(JobEnt.QWCJUN <> QUSUN01) or
(JobEnt.QWCJNbr <> QUSJNbr01));
// Someone other than current job found
FoundOne = *on;
dsply ('Lock held by ' +
%trimr(JobEnt.QWCJN01) + '/' +
%trimr(JobEnt.QWCJUN) + '/' +
JobEnt.QWCJNbr) ' ' Answer;
Exit = *on;
endif;
endfor;
if (not FoundOne);
// No one found so check if DDMF
if ObjTyp_In = '*FILE';
ChkForDDM();
endif;
endif;
endif;
/end-free
p PrcLcksB e
*******************************************************************
p ChkForDDM b
d ChkForDDM pi
/free
// Check API header for extended attribute of the file
APIHdrPtr = LckSpcPtr + LckHdr.QUSOHS;
if APIHdr.QWCEObjA = 'DDM';
Exit = *on;
endif;
/end-free
p ChkForDDM e
As we've added a subfile capability to AllocObj, using the display file ALLOCOBJFM, one change in the source code is the addition of an F-spec. The F-spec for AllocObjFM indicates that it's an externally described workstation file, that the file is USROPN (as AllocObj might not be running interactively), and that there is one subfile that will be used: RSFL01.
Other changes, prior to getting to the procedures of AllocObj, are the definition of several new procedures. These procedures are:
- EndCntrld to implement ENDJOB with Option(*Cntrld)
- EndImmed to implement ENDJOB Option(*Immed)
- EnterKey to implement subfile option processing when the Enter key is used
- MassEnd to implement F8 and F9 subfile processing
- PrcLcksB to implement lock processing when AllocObj is running in batch
- PrcLcksI to implement lock processing when AllocObj is running interactively
The first procedural change is found in GetLckHldrs(). That is, the *INZSR and mainline of AllocObj have not changed since last month. While GetLckHldrs() continues to generate the list of lock holders, the remainder of last month's processing (determining the first job that has a lock on the object) has now moved to PrcLcksB(), as AllocObj for this month will continue to handle running in batch the same way it did last month.
The update to GetLckHldrs() follows the generation of the list of lock holders. GetLckHldrs() now determines if AllocObj is running in an interactive job or not and, if so, runs the PrcLcksI procedure. You may recall from last month that we used the Retrieve Job Information (QUSRJOBI) API and format JOBI0100 within the *INZSR subroutine to access the qualified name of the current job. At that time, it was mentioned that the API was being used, rather than accessing the qualified job name from the PSDS, as we would have a later need for job-related information that was not available in the PSDS. That time is now. In addition to the job name information used last month, format JOBI0100 also returns the Job Type. Job type can be one of several values, with the value we're interested in being 'I' for interactive. As we're using the IBM-provided QSYSINC definitions for the API format, job type corresponds to variable QUSJT02, so GetLckHldrs() calls procedure PrcLcksI if the job type is interactive; otherwise, PrcLcksB is called. As mentioned earlier, PrcLcksB() is essentially the processing logic we reviewed last month and will not be discussed any further today.
After some initial setup, PrcLcksI() enters a For loop to process all list entries returned by the List Object Locks API. Within this For loop, two initial checks are made. The first is to bypass any entry identifying the current job. The second is to check for multiple entries identifying the same job. Just as the Work with Object Locks (WRKOBJLCK) command will return multiple locks being held by a job as separate entries, so too will the List Object Locks API. As the user of AllocObj really only cares about jobs that hold a lock, not how many locks the job holds, AllocObj uses the Jobs array to detect when a job has been previously processed. The Jobs array is defined with dim(9999) to correspond to the maximum number of entries that can be written to a subfile. If an entry returned by QWCLOBJL passes these two checks, then it is passed to the subroutine UpdSFL.
UpdSFL, prior to writing the entry to the subfile, performs some additional checking and then formats the job name. This additional checking is conducted by calling the Retrieve Job Information (QUSRJOBI) API for the job holding the lock, requesting format JOBI0600. The checks, in this order, are:
- Has the job left the system (ended with no spooled output) since the List Object Locks API generated the list? If so, then there is no need to include the job in the subfile.
- Has the job ended with spooled output since the List Object Locks API generated the list? If so, then there is no need to include the job in the subfile.
- Is the job currently in the process of ending? If so, set the job status to ending so the user can see there's no need to end it again. If not, set the job status to blanks.
The formatting done by UpdSFL is to format:
- a hidden subfile field, H1JobName, in the manner system commands such as ENDJOB and DSPJOB expect to receive a qualified job name
- a displayed subfile field, S1JobName, in the manner I personally prefer to see qualified job names
After the For loop has processed all the entries returned by the List Object Locks API, a check is made to see if any entries were actually written to the subfile. If there were (SRRN01 > 0), then the subfile is displayed. If no jobs were found holding locks, then there's no need to display the subfile, and, like last month, a check is made to determine if this might be a DDM file (in which case the absence of locks can be deceiving).
The actual processing of the subfile is straightforward and, when the subfile processing has completed, control returns to the mainline DOW loop, where AllocObj will again call Allocate() to determine if we can now get an exclusive lock on the object (assuming the user did not use F3). Assuming the user has taken options such as ending the jobs currently holding locks, Allocate() may well succeed this time as the Allocate Object (ALCOBJ) command will, by default, wait for the amount of time specified in the active class description (usually a minimum of 30 seconds) while the various ENDJOB commands should complete in 30 seconds or less. If Allocate() is successful, the program ends; otherwise, we try again by calling GetLckHldrs().
Next month, we'll look at some of the options available to us when AllocObj is running in batch.
As usual, if you have any API questions, send them to me at
More than ever, there is a demand for IT to deliver innovation. Your IBM i has been an essential part of your business operations for years. However, your organization may struggle to maintain the current system and implement new projects. The thousands of customers we've worked with and surveyed state that expectations regarding the digital footprint and vision of the company are not aligned with the current IT environment.
TRY the one package that solves all your document design and printing challenges on all your platforms. Produce bar code labels, electronic forms, ad hoc reports, and RFID tags – without programming! MarkMagic is the only document design and print solution that combines report writing, WYSIWYG label and forms design, and conditional printing in one integrated product. Make sure your data survives when catastrophe hits. Request your trial now! Request Now.
Forms of ransomware has been around for over 30 years, and with more and more organizations suffering attacks each year, it continues to endure. What has made ransomware such a durable threat and what is the best way to combat it? In order to prevent ransomware, organizations must first understand how it works.
Disaster protection is vital to every business. Yet, it often consists of patched together procedures that are prone to error. From automatic backups to data encryption to media management, Robot automates the routine (yet often complex) tasks of iSeries backup and recovery, saving you time and money and making the process safer and more reliable. Automate your backups with the Robot Backup and Recovery Solution. Key features include:
Business users want new applications now. Market and regulatory pressures require faster application updates and delivery into production. Your IBM i developers may be approaching retirement, and you see no sure way to fill their positions with experienced developers. In addition, you may be caught between maintaining your existing applications and the uncertainty of moving to something new.
IT managers hoping to find new IBM i talent are discovering that the pool of experienced RPG programmers and operators or administrators with intimate knowledge of the operating system and the applications that run on it is small. This begs the question: How will you manage the platform that supports such a big part of your business? This guide offers strategies and software suggestions to help you plan IT staffing and resources and smooth the transition after your AS/400 talent retires. Read on to learn:
LATEST COMMENTS
MC Press Online