/* SWPLIBL: This program swaps *libls with a *jobd */ SWPLIBL: PGM PARM(&PQJOBD &PUSRPRF &PQJOB) DCL VAR(&PQJOBD) TYPE(*CHAR) LEN(20) DCL VAR(&PUSRPRF) TYPE(*CHAR) LEN(10) DCL VAR(&PQJOB) TYPE(*CHAR) LEN(26) /********************************************************************/ /* Qualified jobd name breakout... */ DCL VAR(&JOBD) TYPE(*CHAR) LEN(10) DCL VAR(&JOBDLIB) TYPE(*CHAR) LEN(10) /********************************************************************/ /* Qualified job name breakout... */ DCL VAR(&JOB) TYPE(*CHAR) LEN(10) DCL VAR(&USER) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6) DCL VAR(&SLTJOB) TYPE(*CHAR) LEN(26) /********************************************************************/ /* Returned job information structure: *libl info... */ DCL VAR(&JOBI) TYPE(*CHAR) LEN(1000) DCL VAR(&NBRSYSLIB) TYPE(*DEC) LEN(5) DCL VAR(&NBRPRDLIB) TYPE(*DEC) LEN(5) DCL VAR(&NBRCURLIB) TYPE(*DEC) LEN(5) DCL VAR(&NBRUSRLIB) TYPE(*DEC) LEN(5) DCL VAR(&LENUSRLIB) TYPE(*DEC) LEN(5) DCL VAR(&STRLIB) TYPE(*DEC) LEN(5) VALUE(81) /********************************************************************/ /* *Libl working areas... */ DCL VAR(&INLLIBL) TYPE(*CHAR) LEN(275) VALUE('*INIT') DCL VAR(&JOBLIBL) TYPE(*CHAR) LEN(275) DCL VAR(&SYSUSRLIBL) TYPE(*CHAR) LEN(250) /********************************************************************/ /* To substring-parse the QUSRLIBL system value... */ DCL VAR(&OSUL) TYPE(*DEC) LEN(3) VALUE(1) DCL VAR(&OIL) TYPE(*DEC) LEN(3) VALUE(1) /********************************************************************/ /* To build the CHGLIBL command in... */ DCL VAR(&CMD) TYPE(*CHAR) LEN(300) /********************************************************************/ /* To track how far down the stack we've gone... */ DCL VAR(&POP_CTR) TYPE(*DEC) LEN(5) VALUE(0) DCL VAR(&POP_CTR_C) TYPE(*CHAR) LEN(5) + VALUE('00000') /********************************************************************/ /* To create the *usridx consistently... */ DCL VAR(&UILIB) TYPE(*CHAR) LEN(10) VALUE(QTEMP) DCL VAR(&UINAM) TYPE(*CHAR) LEN(10) + VALUE(SWPLIBLIDX) DCL VAR(&UIINITKEY) TYPE(*CHAR) LEN(280) + VALUE('0000000000') DCL VAR(&UIKLEN) TYPE(*DEC) LEN(5 0) VALUE(5) DCL VAR(&UIELEN) TYPE(*DEC) LEN(5 0) VALUE(280) DCL VAR(&UINBRRTV) TYPE(*CHAR) LEN(4) DCL VAR(&UIENT) TYPE(*CHAR) LEN(1008) DCL VAR(&UIELENOFFS) TYPE(*CHAR) LEN(1008) DCL VAR(&HEX0000) TYPE(*CHAR) LEN(4) + VALUE(X'00000000') DCL VAR(&HEX0001) TYPE(*CHAR) LEN(4) + VALUE(X'00000001') /********************************************************************/ MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(STDERR)) /* */ /* Check JOB for a name. Use it if found... */ /* */ IF COND(&PQJOB *NE '*NONE') THEN(DO) /* */ /* Something is in the job name... *SELECT? */ /* */ IF COND(&PQJOB *EQ '*SELECT') THEN(DO) ? SLTJOB ?-SLTJOB(&SLTJOB) CHGVAR VAR(&JOB) VALUE(%SST(&SLTJOB 1 10)) CHGVAR VAR(&USER) VALUE(%SST(&SLTJOB 11 10)) CHGVAR VAR(&JOBNBR) VALUE(%SST(&SLTJOB 21 6)) ENDDO /* &PQJOB *EQ '*SELECT' */ /* */ /* Something is in the job name... but not *SELECT... */ /* */ ELSE CMD(DO) /* &PQJOB *NE '*SELECT' */ CHGVAR VAR(&JOB) VALUE(%SST(&PQJOB 1 10)) CHGVAR VAR(&USER) VALUE(%SST(&PQJOB 11 10)) CHGVAR VAR(&JOBNBR) VALUE(%SST(&PQJOB 21 6)) ENDDO /* &PQJOB *eq '*SELECT' */ /* */ /* We either had a job name or selected one. So, retrieve info... */ /* */ RTVJOBI JOB(&JOBNBR/&USER/&JOB) JOBI(&JOBI) FORMAT(*LIBL) /* gather stats on numbers of libraries... */ CHGVAR VAR(&NBRSYSLIB) VALUE(%BIN(&JOBI 65 4)) CHGVAR VAR(&NBRPRDLIB) VALUE(%BIN(&JOBI 69 4)) CHGVAR VAR(&NBRCURLIB) VALUE(%BIN(&JOBI 73 4)) CHGVAR VAR(&NBRUSRLIB) VALUE(%BIN(&JOBI 77 4)) CHGVAR VAR(&LENUSRLIB) VALUE(&NBRUSRLIB * 11) /* add up the lengths... */ CHGVAR VAR(&STRLIB) VALUE(&STRLIB + ((&NBRSYSLIB + &NBRPRDLIB + + &NBRCURLIB) * 11)) /* and grab the *libl... */ CHGVAR VAR(&INLLIBL) VALUE(%SST(&JOBI &STRLIB &LENUSRLIB)) ENDDO /* &PQJOB *NE '*NONE' */ /* */ /* Use *usrprf, if *jobd not specified... */ /* */ IF COND(&PUSRPRF *NE '*NONE') THEN(DO) /* Use QUSRLIBL if *usrprf *eq *sysval... */ IF COND(&PUSRPRF *EQ '*SYSVAL') THEN(DO) CHGVAR VAR(&INLLIBL) VALUE('*SYSVAL') ENDDO ELSE CMD(DO) RTVUSRPRF USRPRF(&PUSRPRF) JOBD(&JOBD) JOBDLIB(&JOBDLIB) ENDDO ENDDO /* &pusrprf *ne *none... */ /* */ /* ...otherwise, break out the qualified *jobd name... */ /* */ IF COND(&PQJOBD *NE '*NONE') THEN(DO) CHGVAR VAR(&JOBD) VALUE(%SST(&PQJOBD 1 10)) CHGVAR VAR(&JOBDLIB) VALUE(%SST(&PQJOBD 11 10)) ENDDO /* */ /* Build a *usridx to POP *libls into... */ /* */ CHKOBJ OBJ(&UILIB/&UINAM) OBJTYPE(*USRIDX) MONMSG MSGID(CPF9801) EXEC(DO) /* Create one if necessary... */ CRTUSRIDX USRIDX(&UILIB/&UINAM) ENTLEN(&UIELEN) + KEYINS(*YES) KEYLEN(&UIKLEN) + OPTIMIZE(*SEQUENTIAL) /* ...and put an initial entry into it... */ ADDUSRIDXE USRIDX(&UILIB/&UINAM) IDXENTRY(&UIINITKEY) + ENTLEN(&UIELEN) INSTYPE(*REPLACE) ENDDO /* */ /* Request the initial *libl be returned if we get to here and */ /* find that *INIT is (possibly still) in INLLIBL... */ /* */ IF COND(&INLLIBL *EQ '*INIT') THEN(DO) /* Return the initial *libl from the *jobd... */ RTNJOBDILL JOBD(&JOBDLIB/&JOBD) INLLIBL(&INLLIBL) MONMSG MSGID(CPF0000) EXEC(SNDPGMMSG MSGID(CPF9898) + MSGF(QCPFMSG) MSGDTA('Request for the + *jobd''s initial *libl failed') + MSGTYPE(*ESCAPE)) ENDDO /* */ /* When the named *usrprf has a *jobd that references QUSRLIBL or */ /* the SWPLIBL request was *SYSVAL, get the list from QUSRLIBL...*/ /* */ IF COND(&INLLIBL *EQ '*SYSVAL') THEN(DO) RTVSYSVAL SYSVAL(QUSRLIBL) RTNVAR(&SYSUSRLIBL) /* Initialize our offsets... */ CHGVAR VAR(&OSUL) VALUE(1) CHGVAR VAR(&OIL) VALUE(1) /* Parse through the QUSRLIBL system value, moving each library */ /* name into our output parm. QUSRLIBL is not space-delimited; */ /* but the output list is because it'll feed CHGLIBL... */ NXT_LIB: CHGVAR VAR(%SST(&INLLIBL &OIL 11)) + VALUE(%SST(&SYSUSRLIBL &OSUL 10)) /* The length goes from 10 to 11 to add a space between... */ CHGVAR VAR(&OSUL) VALUE(&OSUL + 10) CHGVAR VAR(&OIL) VALUE(&OIL + 11) IF COND(&OSUL *LT 250) THEN(GOTO CMDLBL(NXT_LIB)) ENDDO /* */ /* In case we need to restore it later, get this job's *libl... */ /* */ RTVJOBA USRLIBL(&JOBLIBL) /* */ /* ...and stash it in a *usridx in &UILIB... */ /* */ /* Retrieve the *usridx header entry... */ RTVUSRIDXE ENTRTV(&UIENT) ENTLENOFFS(&UIELENOFFS) + NBRENTRTV(&UINBRRTV) + USRIDX(&UILIB/&UINAM) MAXENT(1) + SCHCTA('00000') SCHCTALEN(&UIKLEN) /* Something's really wrong if we don't find the initial entry... */ IF COND(&UINBRRTV *EQ &HEX0000) THEN(SNDPGMMSG + MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('No + *usridx header found. Notify DP.') + MSGTYPE(*ESCAPE)) /* First 8 is bytes avail/returned; next 5 are KEY... */ CHGVAR VAR(&POP_CTR_C) VALUE(%SST(&UIENT 14 5)) CHGVAR VAR(&POP_CTR) VALUE(&POP_CTR_C) CHGVAR VAR(&POP_CTR) VALUE(&POP_CTR + 1) CHGVAR VAR(&POP_CTR_C) VALUE(&POP_CTR) /* We use a counter to keep track of how many library lists we've */ /* swapped for this job so we can restore them back in order... */ CHGVAR VAR(%SST(&UIINITKEY 6 5)) VALUE(&POP_CTR_C) /* Add the entry with the stashed *libl... */ ADDUSRIDXE USRIDX(&UILIB/&UINAM) IDXENTRY(&POP_CTR_C + *CAT &JOBLIBL) ENTLEN(&UIELEN) + INSTYPE(*REPLACE) /* Update the header with the POP counter... */ ADDUSRIDXE USRIDX(&UILIB/&UINAM) IDXENTRY(&UIINITKEY) + ENTLEN(&UIELEN) INSTYPE(*REPLACE) /* */ /* Put the *jobd *libl into a command string.., */ /* */ CHGVAR VAR(&CMD) VALUE('CHGLIBL LIBL(' *CAT + &INLLIBL *CAT ')') /* ...and change our job's *libl to it... */ PRCCMD CMD(&CMD) CMDLEN(300) RETURN STDERR: MOVDIAGMSG MONMSG MSGID(CPF0000 MCH0000) RSNESCMSG MONMSG MSGID(CPF0000 MCH0000) RETURN ENDPGM