This tip is in response to a search400 member who wanted to save only source files.
While this program saves only source files, there are several interesting features of this program that also apply to other applications. The first is the use of the system file QADBXREF. This is an OS/400 file that contains all of the physical and logical files on the system. I use this file to quickly build the list of source files on the system. This file can be helpful in a lot of other ways, too. I've used this system file to locate files when I knew only a partial name of a file, to locate duplicate programmer copies of files, etc.
The second thing to point out is the use of the FROMRCD parameter on the CPYF command. The QADBXREF is a keyed physical file, and by using the FROMRCD parameter on the copy, the copy file ignores the keys and proceeds much faster.
This program is capable of running in an automated mode. As you can from the program, all this program requires is that a tape is in the tape drive before it starts.
This file uses a temporary file called QADBXTMP that would reside in the user's library list. I use a temporary file for a couple reasons, but the overriding reason is that you can't declare the QADBXREF file in your CL program. Since QADBXREF is a system file, you will have to make sure that the user profile running the backup has authority to use it or change this program to adopt authority of a profile that has sufficient authority. The SAVOBJ command has a limit of 300 objects that it can save per library. If you have more source files than that in a single library, you'll want to change this program to add a counter to limit the number of files saved in the SAVOBJ command.
A quick summary of what it does:
- Initializes a tape
- Builds list of source files
- Reads the list and builds a QCMDEXC command string so that all source files in a library are saved in a single SAVOBJ command
- Leaves the tape where it left off so that the next save won't have to waste time repositioning the tape head
- Repeats the save process for each library and informs QSYSOPR of any errors encountered
- At end of file, rewinds and unloads the tape.
Program:
QADBXTMP Command CL SOURCE
A R QADBXFM
A DBXLIB 10
A DBXFIL 10
A K DBXLIB
A K DBXFIL
SAVSRC Command CL SOURCE
PGM
DCLF FILE(QADBXTMP)
DCL VAR(&SENDMSG) TYPE(*CHAR) LEN(512)
DCL VAR(&BLANKS) TYPE(*CHAR) LEN(3700)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
DCL VAR(&CURDATE) TYPE(*CHAR) LEN(6)
DCL VAR(&OWNID) TYPE(*CHAR) LEN(7)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&ERRFLG) TYPE(*CHAR) LEN(1)
DCL VAR(&CMD) TYPE(*CHAR) LEN(3700)
DCL VAR(&FILES) TYPE(*CHAR) LEN(3300)
DCL VAR(&HLDLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&ENDFLG) TYPE(*CHAR) LEN(1)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(FATALERR))
SNDPGMMSG MSG('BACKUP PGM STARTED') TOUSR(QSYSOPR)
/* MAKE SURE WE GET A JOB LOG */
CHGJOB LOG(*SAME *SAME *SECLVL)
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&CURDATE)
CHGVAR VAR(&OWNID) VALUE('D' *CAT &CURDATE)
RTVJOBA USER(&USER)
INITIALIZE:
/* INITIALIZE TAPE */
INZTAP DEV(TAP02) NEWVOL(BACKUP) NEWOWNID(&OWNID) +
CHECK(*NO) DENSITY(*CTGTYPE)
MONMSG MSGID(CPF0000) EXEC(DO) /* tape not ready */
SNDMSG MSG('Tape was not ready. Backup was not +
done.') TOMSGQ(QSYSOPR) MSGTYPE(*INFO)
GOTO CMDLBL(ENDPGM)
ENDDO
/* JUST IN CASE */
DLTF FILE(QTEMP/QADBXTMP)
MONMSG MSGID(CPF0000)
/* CREATE WORK FILE IN QTEMP */
CPYF FROMFILE(*LIBL/QADBXTMP) +
TOFILE(QTEMP/QADBXTMP) CRTFILE(*YES) +
NBRRCDS(1)
CLRPFM FILE(QADBXTMP)
/* GET A LIST OF ALL SOURCE FILES ON THE SYSTEM */
CPYF FROMFILE(QSYS/QADBXREF) +
TOFILE(QTEMP/QADBXTMP) MBROPT(*REPLACE) +
CRTFILE(*YES) FROMRCD(1) INCREL((*IF +
DBXTYP *EQ 'S')) FMTOPT(*MAP *DROP)
OVRDBF FILE(QADBXTMP) TOFILE(QTEMP/QADBXTMP)
/* READ FILES & DECIDE WHICH ONES TO SAVE */
RCVF:
RCVF
MONMSG MSGID(CPF0864) EXEC(DO) /* At End */
CHGVAR VAR(&ENDFLG) VALUE('Y')
GOTO CMDLBL(SAVE)
ENDDO
IF COND(&HLDLIB *EQ ' ') THEN(CHGVAR +
VAR(&HLDLIB) VALUE(&DBXLIB))
IF COND(&DBXLIB *NE &HLDLIB) THEN(GOTO +
CMDLBL(SAVE))
RCVF2:
/* BUILD QCMDEXC STRING */
CHGVAR VAR(&FILES) VALUE(&FILES *BCAT &DBXFIL)
GOTO RCVF
SAVE:
/* LEAVE TAPE AT END SO THAT NEXT SAVE GOES FASTER */
CHGVAR VAR(&CMD) VALUE('SAVOBJ OBJ(' *TCAT &FILES +
*TCAT ') LIB(' *TCAT &HLDLIB *TCAT ') +
DEV(TAP02) ENDOPT(*LEAVE) SAVACT(*SYSDFN) +
DTACPR(*YES)')
CALL PGM(QCMDEXC) PARM(&CMD 3700)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(SAVERR))
/* CLEAR & SET VARIABLES */
CHGVAR VAR(&FILES) VALUE(&BLANKS)
CHGVAR VAR(&HLDLIB) VALUE(&DBXLIB)
IF COND(&ENDFLG *EQ 'Y') THEN(GOTO CMDLBL(ENDPGM))
GOTO CMDLBL(RCVF2)
SAVERR:
/* PROCESS ALL SAVE ERRORS */
RCVMSG MSGTYPE(*EXCP) MSGID(&MSGID)
CHGVAR VAR(&SENDMSG) VALUE(&BLANKS)
CHGVAR VAR(&SENDMSG) VALUE('Files in library' *BCAT +
&HLDLIB *BCAT 'not saved because of +
error' *BCAT &MSGID *TCAT '.' *BCAT +
'Please investigate.')
SNDPGMMSG MSG(&SENDMSG) TOMSGQ(QSYSOPR)
/* GET THE REST OF THE FILES TO SAVE */
GOTO CMDLBL(RCVF)
FATALERR:
RCVMSG MSGTYPE(*EXCP) MSG(&MSGDTA) MSGID(&MSGID)
MONMSG MSGID(CPF0000)
IF COND(%SST(&MSGDTA 1 10) *EQ ' ') +
THEN(DO)
CHGVAR VAR(&MSGDTA) VALUE('Error Message text not +
available at this time')
ENDDO
/* CHECK ERROR FLAG TO ENSURE THAT WE DON'T GET STUCK IN AN */
/* ENDLESS LOOP */
IF COND(&ERRFLG *EQ 'Y') THEN(GOTO +
CMDLBL(ENDPGM2))
CHGVAR VAR(&ERRFLG) VALUE('Y')
CHGVAR VAR(&SENDMSG) VALUE(&BLANKS)
CHGVAR VAR(&SENDMSG) VALUE('Backup pgm ended +
abnormally because of error' *BCAT &MSGID +
*BCAT '-' *BCAT &MSGDTA *TCAT '.' *BCAT +
'Please investigate.')
SNDPGMMSG MSG(&SENDMSG) TOMSGQ(QSYSOPR)
ENDPGM:
SNDPGMMSG MSG('BACKUP PGM ENDED') TOUSR(QSYSOPR)
/* REWIND AND UNLOAD THE TAPE AFTER WE ARE DONE */
OVRPRTF FILE(QPTAPDMP) HOLD(*YES)
DMPTAP DEV(TAP02) DTABLK(*FIRST *ONLY) VOLLBL(*NO) +
ENDOPT(*UNLOAD)
DLTSPLF FILE(QPTAPDMP) SPLNBR(*LAST)
ENDPGM2: ENDPGM
---------------------------
About the author: Tim is vice president of Technical Services at Interlink Technologies in Maumee, Ohio, where he serves as chief architect for their warehouse management system. He has worked in the banking, insurance, healthcare and distribution industries in various positions, including programmer/analyst, systems analyst and DP manager. Tim has worked on IBM midrange platforms since 1983.
==================================
MORE INFORMATION
==================================
