Archive a source member
Find a way to archive our old source members without purchasing any new software.
We were instructed by the powers-that-be to find a way to archive our old source members WITHOUT purchasing any new software.
The command ARCSRCM accepts the source file, library, and member name to archive.
CL program ARCSRCM1 runs behind the command and verifies the existence of the source file and member. If it does not exist, an appropriate message is displayed and the command is cancelled. If it does exist, CL program ARCSRCM2 is called to complete the process.
CL program ARCSRCM2 verifies that a source file exists in the archive library having the same name as the source member. (In our case, we have created the library SRCARCHIVE to hold all archived source files.) If the source file does not exist, one is created, its file text being the same as the member text. The program then assigns a member name based on the next available version number. (VER0000001, VER0000002, etc.) The text of the new member contains the date and time the archive process was completed, the library and source file of the original member, and the user ID of individual who performed the archive.
We have also added the user-defined option 'AR' allowing the process to be executed from within PDM.
CALL PGM(ARCSRCM1) PARM(&L &F &N)
ARCSRCM
/* ARCSRCM - Archive a source member */
/* PARMS - FILE(XXXXXXXXXX/XXXXXXXXXX) SRCMBR(XXXXXXXXXX) */
/* */
/* ARCSRCM command copies a source file member to the archive */
/* library. */
/* */
/* ARCSRCM runs the CL program ARCSRCM1 */
/* */
CMD PROMPT('Archive a source member')
PARM KWD(FILE) TYPE(QUAL1) MIN(1) PROMPT('File +
name')
PARM KWD(SRCMBR) TYPE(*CHAR) LEN(10) MIN(1) +
PROMPT('Member name')
QUAL1: QUAL TYPE(*NAME) LEN(10) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) EXPR(*YES) +
PROMPT('Library name')
Source code: ARCSRCM1
/* ARCSRCN1 - Archive a source member */
/* PARMS - FILE(XXXXXXXXXX/XXXXXXXXXX) SRCMBR(XXXXXXXXXX) */
/* */
/* ARCSRCM command archives a source member to a source file */
/* within the archive library */
/* ARCSRCM1 program runs behind the command ARCSRCM */
/* ARCSRCM1 program calls program ARCSRCM2 */
/* */
PGM PARM(&FILE &SRCMBR)
DCL VAR(&FILE) TYPE(*CHAR) LEN(20)
DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&SRCFIL) TYPE(*CHAR) LEN(10)
DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&RTNLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSG) TYPE(*CHAR) LEN(512)
CHGVAR VAR(&SRCFIL) VALUE(%SST(&FILE 1 10))
CHGVAR VAR(&SRCLIB) VALUE(%SST(&FILE 11 10))
CHKOBJ OBJ(&SRCLIB/&SRCFIL) OBJTYPE(*FILE) +
MBR(&SRCMBR)
MONMSG MSGID(CPF9801 CPF9815) EXEC(DO)
GOTO CMDLBL(DONE)
ENDDO
IF COND(&SRCLIB *EQ '*LIBL') THEN(DO)
RTVMBRD FILE(&SRCLIB/&SRCFIL) MBR(&SRCMBR) +
RTNLIB(&RTNLIB)
MONMSG MSGID(CPF9812 CPF9815) EXEC(DO)
GOTO CMDLBL(DONE)
ENDDO
CHGVAR VAR(&SRCLIB) VALUE(&RTNLIB)
ENDDO
CALL PGM(ARCSRCM2) PARM(&SRCLIB &SRCFIL &SRCMBR)
GOTO CMDLBL(ENDPGM)
DONE: CHGVAR VAR(&MSG) VALUE(&SRCLIB *TCAT '/' *TCAT +
&SRCFIL *TCAT '/' *TCAT &SRCMBR *BCAT +
'does not exist. Command cancelled.')
SNDUSRMSG MSG(&MSG) MSGTYPE(*INFO)
ENDPGM: ENDPGM
Source code: ARCSRCM2
/* ARCSRCM2 - Back up source member to ARCHIVE library */
/* PARMS - &SRCLIB - Library where the source file exists */
/* - &SRCFIL - Source file where the source member exists*/
/* - &SRCMBR - Source member */
/* */
/* ARCSRCM command archives a source member to a source file */
/* within the archive library */
/* ARCSRCM1 program runs behind the command ARCSRCM */
/* ARCSRCM1 program calls program ARCSRCM2 */
/* */
PGM PARM(&SRCLIB &SRCFIL &SRCMBR)
DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SRCFIL) TYPE(*CHAR) LEN(10)
DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&ARCLIB) TYPE(*CHAR) LEN(10) +
VALUE('SRCARCHIVE')
DCL VAR(&ARCFIL) TYPE(*CHAR) LEN(10)
DCL VAR(&ARCMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&ARCNAM) TYPE(*CHAR) LEN(03) VALUE('VER')
DCL VAR(&ARCNUM) TYPE(*CHAR) LEN(07)
DCL VAR(&WRKDEC) TYPE(*DEC) LEN(07 0) VALUE(0)
DCL VAR(&DATE) TYPE(*CHAR) LEN(06)
DCL VAR(&TIME) TYPE(*CHAR) LEN(06)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&MSG) TYPE(*CHAR) LEN(512)
DCL VAR(&SRCTXT) TYPE(*CHAR) LEN(50)
DCL VAR(&ARCTXT) TYPE(*CHAR) LEN(50)
CHKOBJ OBJ(&ARCLIB/&SRCMBR) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(DO)
RTVMBRD FILE(&SRCLIB/&SRCFIL) MBR(&SRCMBR) +
TEXT(&SRCTXT)
CRTSRCPF FILE(&ARCLIB/&SRCMBR) TEXT(&SRCTXT) AUT(*ALL)
ENDDO
CHGVAR VAR(&ARCFIL) VALUE(&SRCMBR)
INCREMENT: CHGVAR VAR(&WRKDEC) VALUE(&WRKDEC + 1)
CHGVAR VAR(&ARCNUM) VALUE(&WRKDEC)
CHGVAR VAR(&ARCMBR) VALUE(&ARCNAM *CAT &ARCNUM)
CHKOBJ OBJ(&ARCLIB/&SRCMBR) OBJTYPE(*FILE) +
MBR(&ARCMBR)
MONMSG MSGID(CPF9801 CPF9815) EXEC(DO)
CPYF FROMFILE(&SRCLIB/&SRCFIL) +
TOFILE(&ARCLIB/&ARCFIL) FROMMBR(&SRCMBR) +
TOMBR(&ARCMBR) MBROPT(*REPLACE)
GOTO CMDLBL(RTVSYSVAL)
ENDDO
GOTO CMDLBL(INCREMENT)
RTVSYSVAL: RTVSYSVAL SYSVAL(QDATE) RTNVAR(&DATE)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&TIME)
RTVJOBA USER(&USER)
CHGVAR VAR(&ARCTXT) VALUE(&DATE *BCAT &TIME *BCAT +
&SRCLIB *TCAT '/' *CAT &SRCFIL *BCAT &USER)
CHGPFM FILE(&ARCLIB/&ARCFIL) MBR(&ARCMBR) +
TEXT(&ARCTXT)
CHGVAR VAR(&MSG) VALUE('Archive' *BCAT &SRCLIB +
*TCAT '/' *CAT &SRCFIL *TCAT '/' *CAT +
&SRCMBR *TCAT ' to' *BCAT &ARCLIB *TCAT +
'/' *CAT &ARCFIL *TCAT '/' *CAT &ARCMBR +
*TCAT ' complete')
SNDUSRMSG MSG(&MSG) MSGTYPE(*INFO)
ENDPGM: ENDPGM
==================================
MORE INFORMATION ON THIS TOPIC
==================================
The Best Web Links: tips, tutorials and more.
Ask your programming questions--or help out your peers by answering them--in our live discussion forums.
Ask the Experts yourself: Our application development gurus are waiting to answer your programming questions.
Start the conversation
0 comments