371 lines
13 KiB
Plaintext
371 lines
13 KiB
Plaintext
**FREE
|
|
/TITLE GETOBJUR - Get users of an object
|
|
//--------------------------------------------------------------------
|
|
// Given an object and type, this program finds all jobs that have
|
|
// locks on the object. It returns a message suitable for sending
|
|
// to the system operator and/or a file, QTEMP/GETOBJUP, which
|
|
// could be used to send messages to all interactive users of the
|
|
// object, or for some other use.
|
|
// This program is called from CL program GETOBJUC.
|
|
// It calls the QWCLOBJL (List Object Locks) API.
|
|
// Message looks like this:
|
|
// QIWS/QCUSTCDT *FILE is in use by QPAD165916/LENNONS/167740.
|
|
// Or this:
|
|
// QIWS/QCUSTCDT *FILE is in use by CUSTLST/LENNONS/167922,
|
|
// DAILYORD/LENNONS/167924, INV_UPD/LENNONS/167923,
|
|
// QPAD165916/LENNONS/167740 plus 1 more.
|
|
// Compile: CRTBNDRPG PGM(GETOBJUR) SRCFILE(...) DBGVIEW(*LIST)
|
|
//--------------------------------------------------------------------
|
|
// 12/00/97 LENNON Original Writing
|
|
// 07/--/2021 Converted to **FREE and Linear module.
|
|
// There are SQL services now that can provide similar
|
|
// infomations, but as far as I know there is no SQL
|
|
// interface to QWCLOBJL. And there certainly was not in
|
|
// 1997. This code probably performs better than existing
|
|
// SQL interfaces. For most use cases performance may not
|
|
// be a consideration.
|
|
// 02/--/2024 Set for source in IFS
|
|
//--------------------------------------------------------------------
|
|
ctl-opt debug option(*nodebugio: *srcstmt)
|
|
dftactgrp(*no) actgrp(*caller)
|
|
main(Main);
|
|
dcl-f GETOBJUP usage(*output) usropn block(*yes);
|
|
/copy ../Copy_Mbrs/USPHDR.RPGLE
|
|
//=== CRTUSRSPC (QUSCTRUS) Parameters ================================
|
|
dcl-ds *n;
|
|
CusQName char(20);
|
|
CusName char(10) overlay(cusqname) inz('GETOBJUSR');
|
|
CusLib char(10) overlay(cusqname:11) inz('QTEMP');
|
|
end-ds;
|
|
dcl-s CusAttr char(10) inz('GETOBJUSR ');
|
|
dcl-s CusIntSize int(10);
|
|
dcl-s CusIntVal char(1) inz(x'00');
|
|
dcl-s CusAut char(10) inz('*CHANGE');
|
|
dcl-s CusText char(50) inz('GETOBJUSR Command');
|
|
//=== Send Pgm Message (QMHSNDPM) Parameters =========================
|
|
dcl-s MSNMsgId char(7);
|
|
dcl-s MSNFile char(20) inz('QCPFMSG *LIBL ');
|
|
dcl-s MSNData char(1);
|
|
dcl-s MSNLength int(10);
|
|
dcl-s MSNType char(10) inz('*ESCAPE');
|
|
dcl-s MSNStackE char(10) inz('*CTLBDY');
|
|
dcl-s MSNStackC int(10) inz(1);
|
|
dcl-s MSNMsgKey char(4);
|
|
//=== List Object Locks List Entry Layout ============================
|
|
dcl-ds LOLEntry based(LOPtr);
|
|
LOJobName char(10);
|
|
LOJobUser char(10);
|
|
LOJobNum char(6);
|
|
LOLckState char(10);
|
|
LOLckStus int(10);
|
|
LOLckType int(10);
|
|
LOMemName char(10);
|
|
LOShare char(1);
|
|
LOReserved char(1);
|
|
end-ds;
|
|
dcl-s LOPtr pointer inz(*null);
|
|
dcl-s LOEndPtr pointer inz(*null);
|
|
//=== API Error Code Structure =======================================
|
|
dcl-ds APIError len(272);
|
|
APIEProv int(10) inz(216) pos(1);
|
|
APIEAvail int(10) inz(0) pos(5);
|
|
APIErrID char(7) pos(9);
|
|
APIErrRsv char(1);
|
|
APIEData char(256);
|
|
end-ds;
|
|
//=== Misc Field Definitions =========================================
|
|
dcl-s LolFmt char(8) inz('OBJL0100');
|
|
dcl-s ObjMem char(10);
|
|
dcl-s NumJobs packed(5);
|
|
dcl-c MAXJOBS const(4); //Maximum jobs for detailed reporting.
|
|
// If you increase MAXJOBS, increase the message parameter by 30 bytes
|
|
// for each additional job.
|
|
dcl-ds JobName26;
|
|
SavJobName like(lojobname);
|
|
SavJobUser like(lojobuser);
|
|
SavJobNum like(lojobnum);
|
|
end-ds;
|
|
dcl-s JobName28 char(28);
|
|
dcl-s JobType char(1);
|
|
//=== Parameters for SRTUSRSPC =======================================
|
|
// SKeyStart - Array of key starting positions
|
|
// SKeyLgth - Array of key lengths
|
|
// SKeyAorD - Array of ascending/descending sequences
|
|
// SKeyType - Array of key field data types.
|
|
dcl-s SKeyStart packed(5) dim(10); // start position
|
|
dcl-s SKeyLgth packed(5) dim(10); // lengths
|
|
dcl-s SKeyAorD char(1) dim(10); // ascend/descend
|
|
dcl-s SKeyType char(1) dim(10); // data type
|
|
dcl-s S#Keys packed(3) inz(3);
|
|
dcl-s SError char(1);
|
|
//=== Program Entry and Parameters ===================================
|
|
dcl-proc Main ;
|
|
// Input Parameters
|
|
// pObject is object name (10c) + object library (10c)
|
|
// pObjType is *FILE, *DTAARA, etc., standard OS/400 type
|
|
// pObjMem is the member for files, or *NONE if just want users
|
|
// of the file.
|
|
// pMsgYN is *YES to create a message.
|
|
// pFileYN is *YES if file GETOBJUP is to be created in QTEMP
|
|
// Output Parameter
|
|
// PMsgFld is where the message gets created.
|
|
// ---------------------------------------------------------
|
|
dcl-pi *n extpgm('GETOBJUR');
|
|
pObject char(20);
|
|
pObjType char(10);
|
|
pObjMem char(10);
|
|
pMsgYN char(4);
|
|
pMsgFld char(200);
|
|
pFileYN char(4);
|
|
end-pi;
|
|
//------------------------------------------------------
|
|
dcl-pr ListObjLck extpgm('QWCLOBJL');
|
|
*n char(20); // CusQName
|
|
*n char(8); // LolFmt
|
|
*n char(20); // pObject
|
|
*n char(10); // pObjType
|
|
*n char(10); // ObjMem
|
|
*n char(272); // APIError
|
|
end-pr;
|
|
//------------------------------------------------------
|
|
// Gets job type entry for this job.
|
|
// Returns: JobType has the job type. I=interactive, B=batch, etc.
|
|
dcl-pr GetJobType extpgm('GETJOBTR');
|
|
*n char(26); // JobName26
|
|
*n char(1); // JobType
|
|
end-pr;
|
|
//------------------------------------------------------
|
|
dcl-pr p_srtusrspc extpgm('SRTUSRSPC');
|
|
*n char(10); // CusName
|
|
*n char(10); // CusLib
|
|
*n packed(3); // S#keys
|
|
*n packed(5) dim(10); // KeyStart
|
|
*n packed(5) dim(10); // KeyLgth
|
|
*n char(1) dim(10); // Key A or D
|
|
*n char(1) dim(10); // SKeyType
|
|
*n char(1); // SError
|
|
end-pr;
|
|
//------------------------------------------------------
|
|
dcl-pr SendMsg extpgm('QMHSNDPM');
|
|
*n char(7); // MSNMsgId
|
|
*n char(20); // MSNFile
|
|
*n char(256); // APIEData
|
|
*n int(10); // MSNLength
|
|
*n char(10); // MSNType
|
|
*n char(10); // MSNStackE
|
|
*n int(10); // MSNStackC
|
|
*n char(4); // MSNMsgKey
|
|
*n char(272); // APIError
|
|
end-pr;
|
|
//------------------------------------------------------
|
|
dcl-pr UsrSpcCrt extpgm('QUSCRTUS');
|
|
*n char(20); // CusQName
|
|
*n char(10); // CusAttr
|
|
*n int(10); // CusIntSize
|
|
*n char(1); // CusIntVal
|
|
*n char(10); // CusAut
|
|
*n char(50); // Custext
|
|
end-pr;
|
|
//------------------------------------------------------
|
|
dcl-pr UsrSpcDlt extpgm('QUSDLTUS');
|
|
*n char(20); // CusQName
|
|
*n char(272); // APIError
|
|
end-pr;
|
|
//------------------------------------------------------
|
|
dcl-pr UsrSpcPointer extpgm('QUSPTRUS');
|
|
*n char(20); // CusQName
|
|
*n pointer; // UspPtr
|
|
end-pr;
|
|
|
|
//=== Code starts here ===========================================
|
|
exsr Initialize;
|
|
//=== List the Object Locks ======================================
|
|
// Object type should be *NONE if not a file.
|
|
if pObjType='*FILE';
|
|
ObjMem=pObjMem;
|
|
else;
|
|
ObjMem='*NONE';
|
|
endif;
|
|
APIEProv=0;
|
|
ListObjLck(
|
|
CusQName:
|
|
LolFmt:
|
|
pObject:
|
|
pObjType:
|
|
ObjMem:
|
|
APIError);
|
|
exsr SrtUsrSpc;
|
|
// === Main Program Loop =========================================
|
|
// Loop through the entries in the list
|
|
exsr NxtJob;
|
|
dow LOPtr <> *NULL;
|
|
if pFileYN='*YES';
|
|
GetJobType(JobName26: JobType);
|
|
exsr WriteRec;
|
|
endif;
|
|
if pMsgYN='*YES';
|
|
exsr BldMsg;
|
|
endif;
|
|
exsr NxtJob;
|
|
enddo;
|
|
// === End of Program ============================================
|
|
if pFileYN='*YES';
|
|
close GETOBJUP;
|
|
endif;
|
|
if pMsgYN='*YES';
|
|
select;
|
|
when NumJobs >= 1 and NumJobs <=MAXJOBS;
|
|
pMsgFld=%trimr(pMsgFld) + '.';
|
|
when NumJobs > MAXJOBS;
|
|
pMsgFld=%trimr(pMsgFld) + ' plus ' +
|
|
%trim(%editc(NumJobs-MAXJOBS:'J')) +
|
|
' more.';
|
|
other;
|
|
endsl;
|
|
endif;
|
|
*inlr=*on;
|
|
// === NxtJob ====================================================
|
|
// A job can have more than one lock on an object. We just want a
|
|
// job once.
|
|
// Sets LOPtr to the first entry, or to the next different entry.
|
|
// LOPtr assumed to be *NULL on first call.
|
|
// Returns: LOPtr=*NULL if no more entries.
|
|
// NumJobs=number of unique jobs so far
|
|
begsr NxtJob;
|
|
select;
|
|
when LOPtr=*NULL;
|
|
if UspLst#Ent > 0;
|
|
LOPtr=UspPtr+UspLstOfs;
|
|
LOEndPtr=LOPtr+(UspLst#Ent*UspLstEntSz);
|
|
NumJobs=0;
|
|
exsr SavJobInf;
|
|
endif;
|
|
other;
|
|
LOPtr=LOPtr+UspLstEntSz;
|
|
dow LOPtr < LOEndPtr
|
|
and SavJobName=LOJobName
|
|
and SavJobUser=LOJobUser
|
|
and SavJobNum=LOJobNum ;
|
|
LOPtr=LOPtr+UspLstEntSz;
|
|
enddo;
|
|
if LOPtr < LOEndPtr;
|
|
exsr SavJobInf;
|
|
else;
|
|
LOPtr=*NULL;
|
|
endif;
|
|
endsl;
|
|
endsr;
|
|
// === BldMsg ====================================================
|
|
|
|
// Adds current job to the message until MAXJOBS have been added.
|
|
begsr BldMsg;
|
|
JobName28=%trimr(SavJobName) + '/' +
|
|
%trimr(SavJobUser) + '/' +
|
|
SavJobNum;
|
|
select;
|
|
when NumJobs=1;
|
|
pMsgFld=
|
|
%trimr(%subst(pObject:11:10)) +'/' +
|
|
%trimr(%subst(pObject:1:10)) + ' ' +
|
|
%trimr(pObjType) +
|
|
' is in use by ' +
|
|
JobName28;
|
|
when NumJobs >= 2 and NumJobs <=MAXJOBS;
|
|
pMsgFld=%trimr(pMsgFld) + ', ' +
|
|
JobName28;
|
|
endsl;
|
|
endsr;
|
|
// === SavJobInf =================================================
|
|
// Saves current job indentification information and counts
|
|
// number of unique jobs found.
|
|
// LOPtr must be initialized.
|
|
begsr SavJobInf;
|
|
NumJobs=NumJobs+1;
|
|
SavJobName=LOJobName;
|
|
SavJobUser=LOJobUser;
|
|
SavJobNum=LOJobNum;
|
|
endsr;
|
|
// === WriteRec ==================================================
|
|
|
|
// Builds and writes a record to the file GETOBJUP
|
|
// LOPtr must be initialized.
|
|
begsr WriteRec;
|
|
OUJOBNAME=LOJobname;
|
|
OUJOBUSER=LOJobUser;
|
|
OUJOBNUM=LOJobNum;
|
|
OUJOBTYPE=JobType;
|
|
write GETOBJU;
|
|
endsr;
|
|
// === Sort User Space ===========================================
|
|
|
|
begsr SrtUsrSpc;
|
|
p_srtusrspc(
|
|
CusName:
|
|
CusLib:
|
|
S#Keys:
|
|
SKeyStart:
|
|
SKeyLgth:
|
|
SKeyAorD:
|
|
SKeyType:
|
|
SError);
|
|
endsr;
|
|
// ===============================================================
|
|
// === Initialization ============================================
|
|
begsr Initialize;
|
|
// === Delete the User Space =================================
|
|
APIEProv=%LEN(APIError);
|
|
UsrSpcDlt(CusQName: APIError);
|
|
// If user space doesn't exist, accept message CPF2105, else
|
|
// something nasty is wrong - pass escape message back.
|
|
if APIEAvail <> 0
|
|
and APIErrId <> 'CPF2105';
|
|
APIEProv=0;
|
|
MSNMsgId=APIErrId;
|
|
MSNLength=APIEAvail-16;
|
|
SendMsg(
|
|
MSNMsgId:
|
|
MSNFile:
|
|
APIEData:
|
|
MSNLength:
|
|
MSNType:
|
|
MSNStackE:
|
|
MSNStackC:
|
|
MSNMsgKey:
|
|
APIError);
|
|
endif;
|
|
// === Create User Space =====================================
|
|
// Allow for 100,000 entries, which should be more than enough
|
|
APIEProv = 0;
|
|
CusIntSize=%size(UspHdr) + (%size(LOLEntry)*100000);
|
|
UsrSpcCrt(
|
|
CusQName:
|
|
CusAttr:
|
|
CusIntSize:
|
|
CusIntVal:
|
|
CusAut:
|
|
CusText);
|
|
// === Get Pointer to User Space =============================
|
|
UsrSpcPointer(CusQName: UspPtr);
|
|
// === Initialize requested outputs ==========================
|
|
if pFileYN='*YES';
|
|
open GETOBJUP;
|
|
endif;
|
|
if pMsgYN='*YES';
|
|
clear pMsgFld;
|
|
endif;
|
|
// === Set SRTUSRSPC paremeters ==============================
|
|
SKeyStart(1)=1;
|
|
SKeyStart(2)=11;
|
|
SKeyStart(3)=21;
|
|
SKeyLgth(1)=10;
|
|
SKeyLgth(2)=10;
|
|
SKeyLgth(3)=6;
|
|
SKeyAorD(1)='A';
|
|
SKeyAorD(2)='A';
|
|
SKeyAorD(3)='A';
|
|
SKeyType(1)='C';
|
|
SKeyType(2)='C';
|
|
SKeyType(3)='C';
|
|
endsr;
|
|
end-proc;
|