****************************************************************
* Description.. Library List Functions *
* Program Name. F.LIBL *
* Author....... Bradley V. Stone *
* BVS/Tools - www.bvstools.com *
****************************************************************
H NOMAIN
****************************************************************
* Prototypes *
****************************************************************
D #PushLib PR
D PR_Lib 10 VALUE
D #PopLib PR
D PR_text 10 VALUE OPTIONS(*NOPASS)
D #AddLibLE PR
D PR_Lib 10 VALUE
D PR_Pos 8 VALUE OPTIONS(*NOPASS)
D PR_RefLib 10 VALUE OPTIONS(*NOPASS)
D #ChgLibLJD PR
D PR_JobD 10 VALUE
D PR_JobDLib 10 VALUE
D #RtvLibL PR *
D PR_LibType 10 VALUE
D #VerLib PR 2 0
D PR_Lib 10 VALUE
D PR_LibType 10 VALUE
****************************************************************
* Global Definitions *
****************************************************************
D WPError DS
D EBytesP 1 4B 0 INZ(%size(EData))
D EBytesA 5 8B 0
D EMsgID 9 15
D EReserverd 16 16
D EData 17 56
*
D QCmdCmd S 512 INZ
D QCmdLength S 15 5 INZ(%size(QCmdCmd))
*//////////////////////////////////////////////////////////////*
* (#PushLib) Push a library onto the top of the libary list. *
* *
* Use: #PushLib(library) *
*//////////////////////////////////////////////////////////////*
P #PushLib B EXPORT
*--------------------------------------------------------------*
D #PushLib PI
D Lib 10 VALUE
*--------------------------------------------------------------*
C eval QCmdCmd = 'ADDLIBLE LIB(' +
C %trim(Lib) +
C ') ' +
C 'POSITION(*FIRST)'
*
C CALL 'QCMDEXC' 99
C PARM QCmdCmd
C PARM QCmdLength
*
*--------------------------------------------------------------*
C *PSSR BEGSR
C ENDSR
*--------------------------------------------------------------*
P #PushLib E
*//////////////////////////////////////////////////////////////*
* (#PopLib) Pop a library from the library list. If no value *
* is passed to this procedure, the first library is popped *
* from the library list. *
* *
* Use: #PopLib({library}) *
*//////////////////////////////////////////////////////////////*
P #PopLib B EXPORT
*--------------------------------------------------------------*
D #PopLib PI
D Lib 10 VALUE OPTIONS(*NOPASS)
*
D LibPtr S *
*
D MaxLibs C CONST(25)
*
D LibData DS BASED(LibPtr)
D #Libs 9B 0
D LibArr 10 DIM(MaxLibs)
*--------------------------------------------------------------*
*
C if (%Parms < 1) or (Lib = '*FIRST')
C eval LibPtr = #RtvLibL('*USER')
*
C if (LibPtr <> *NULL) and (#Libs > 0)
C eval Lib = (LibArr(1))
C endif
*
C endif
*
C eval QCmdCmd = 'RMVLIBLE LIB(' +
C %trim(Lib) +
C ') '
*
C CALL 'QCMDEXC' 99
C PARM QCmdCmd
C PARM QCmdLength
*
*--------------------------------------------------------------*
C *PSSR BEGSR
C ENDSR
*--------------------------------------------------------------*
P #PopLib E
*//////////////////////////////////////////////////////////////*
* (#AddLibLE) Add Library List Entry to the specified postion *
* on the library list using the same format as the ADDLIBLE *
* command. If position and/or reference library are not *
* passed, the library is pushed onto the library list. *
* *
* Use: #AddLibLE(library : *
* {*FIRST | *LAST | *
* *AFTER | *BEFORE | *REPLACE} : *
* {Reference Library}) *
*//////////////////////////////////////////////////////////////*
P #AddLibLE B EXPORT
*--------------------------------------------------------------*
D #AddLibLE PI
D Lib 10 VALUE
D Pos 8 VALUE OPTIONS(*NOPASS)
D RefLib 10 VALUE OPTIONS(*NOPASS)
*--------------------------------------------------------------*
C if (%Parms < 3) or (Pos = '*FIRST')
C CALLP #PushLib(Lib)
C else
C eval QCmdCmd = 'ADDLIBLE LIB(' +
C %trim(Lib) +
C ') ' +
C 'POSITION(' +
C %trim(Pos) + ' ' +
C %trim(RefLib) +
C ') '
*
C CALL 'QCMDEXC' 99
C PARM QCmdCmd
C PARM QCmdLength
*
C endif
*--------------------------------------------------------------*
C *PSSR BEGSR
C ENDSR
*--------------------------------------------------------------*
P #AddLibLE E
*//////////////////////////////////////////////////////////////*
* (#ChgLibLJD) Change Library List to the initial library list *
* given on the inputted job description. *
* *
* Use: #ChgLibLJD(job description : job description library) *
*//////////////////////////////////////////////////////////////*
P #ChgLibLJD B EXPORT
*--------------------------------------------------------------*
D #ChgLibLJD PI
D JobD 10 VALUE
D JobDLib 10 VALUE
*
D JobDRtn DS
D Filler1 1 360
D LLOffSet 361 364B 0
D #Libs 365 368B 0
D Filler2 369 600
*
D MaxLibs C CONST(25)
*
D LibL S 11 DIM(MaxLibs)
*
D JobDLen S 9B 0 INZ(%size(JobDRtn))
D JobDFmt S 8 INZ('JOBD0100')
D JobDLoc S 20
*
D LLCurLib S 11 INZ('*SAME')
D LLPrdLib S 11 INZ('*SAME')
D LL2PrdLib S 11 INZ('*SAME')
*
D x S 9B 0
D y S 9B 0
*--------------------------------------------------------------*
C eval JobDLoc = (JobD + JobDLib)
*
C CALL 'QWDRJOBD'
C PARM JobDRtn
C PARM JobDLen
C PARM JobDFmt
C PARM JobDLoc
C PARM WPError
*
C eval y = (LLOffSet + 1)
*
C 1 do #Libs x
C eval LibL(x) = %subst(JobDRtn:y:10)
C eval y = (y + 11)
C enddo
*
C CALL 'QLICHGLL'
C PARM LLCurLib
C PARM LLPrdLib
C PARM LL2PrdLib
C PARM LibL
C PARM #Libs
C PARM WPError
*
*--------------------------------------------------------------*
C *PSSR BEGSR
C ENDSR
*--------------------------------------------------------------*
P #ChgLibLJD E
*//////////////////////////////////////////////////////////////*
* (#RtvLibL) Retrieve Library List and return the data as a *
* pointer to a data structure that contains the library *
* information. If the pointer returned contains the value *
* *NULL, an error occured. *
* *
* Use: #RtvLibL(*SYSTEM | *PRODCUT | *CURRENT | *USER) *
*//////////////////////////////////////////////////////////////*
P #RtvLibL B EXPORT
*--------------------------------------------------------------*
D #RtvLibL PI *
D LibType 10 VALUE
*
D RtvRtnVar DS
D RtvSysLibs 65 68B 0
D RtvPrdLibs 69 72B 0
D RtvCurLibs 73 76B 0
D RtvUsrLibs 77 80B 0
D RtvData 81 400
*
D MaxLibs C CONST(25)
*
D SysData DS STATIC
D #SysLibs 9B 0
D SysArr 10 DIM(MaxLibs)
*
D PrdData DS STATIC
D #PrdLibs 9B 0
D PrdArr 10 DIM(MaxLibs)
*
D CurData DS STATIC
D #CurLibs 9B 0
D CurArr 10 DIM(MaxLibs)
*
D UsrData DS STATIC
D #UsrLibs 9B 0
D UsrArr 10 DIM(MaxLibs)
*
D RtvLen S 9B 0 INZ(400)
D RtvFmt S 8 INZ('JOBI0700')
D RtvJobName S 26 INZ('*')
D RtvID S 16
*
D x S 9B 0
D y S 9B 0
*--------------------------------------------------------------*
C CALL 'QUSRJOBI'
C PARM RtvRtnVar
C PARM RtvLen
C PARM RtvFmt
C PARM RtvJobName
C PARM RtvID
*
C eval y = 1
C eval #SysLibs = RtvSysLibs
C eval #PrdLibs = RtvPrdLibs
C eval #CurLibs = RtvCurLibs
C eval #UsrLibs = RtvUsrLibs
*
C select
C when (LibType = '*SYSTEM')
*
C 1 do #SysLibs x
C eval SysArr(x) = %subst(RtvData:y:10)
C eval y = (y + 11)
C enddo
*
C RETURN %addr(SysData)
*
C when (LibType = '*PRODUCT')
C eval y = (y + (#SysLibs * 11))
*
C 1 do #PrdLibs x
C eval PrdArr(x) = %subst(RtvData:y:10)
C eval y = (y + 11)
C enddo
*
C RETURN %addr(PrdData)
*
C when (LibType = '*CURRENT')
C eval y = (y +
C ((#SysLibs + #PrdLibs) * 11))
*
C 1 do #CurLibs x
C eval CurArr(x) = %subst(RtvData:y:10)
C eval y = (y + 11)
C enddo
*
C RETURN %addr(CurData)
*
C when (LibType = '*USER')
C eval y = (y +
C ((#SysLibs + #PrdLibs + #CurLibs) * 11))
*
C 1 do #UsrLibs x
C eval UsrArr(X) = %subst(RtvData:y:10)
C eval y = (y + 11)
C enddo
*
C RETURN %addr(UsrData)
C other
C RETURN *NULL
C endsl
*--------------------------------------------------------------*
C *PSSR BEGSR
C RETURN *NULL
C ENDSR
*--------------------------------------------------------------*
P #RtvLibL E
*//////////////////////////////////////////////////////////////*
* (#VerLib) Verify that a library is in the library list and *
* return the postion that the library is in. If the value *
* returned is 0, the library is not in the library list. If *
* the value -1 is returned, an error occured. *
* *
* Use: #VerLib(library : *
* *SYSTEM | *PRODCUT | *CURRENT | *USER) *
*//////////////////////////////////////////////////////////////*
P #VerLib B EXPORT
*--------------------------------------------------------------*
D #VerLib PI 2 0
D Lib 10 VALUE
D LibType 10 VALUE
*
D LibPtr S *
*
D MaxLibs C CONST(25)
*
D LibData DS BASED(LibPtr)
D #Libs 9B 0
D LibArr 10 DIM(MaxLibs)
*
D i S 2 0
*--------------------------------------------------------------*
C eval LibPtr = #RtvLibL(LibType)
*
C if (LibPtr = *NULL)
c RETURN -1
C endif
*
C eval i = 1
C Lib LOOKUP LibArr(i) 99
*
C if (*IN99)
C RETURN i
C else
C RETURN 0
C endif
*--------------------------------------------------------------*
C *PSSR BEGSR
C RETURN -1
C ENDSR
*--------------------------------------------------------------*
P #VerLib E
|