/*------------------------------------------------------------------*/
/* Programmers Group & Management Resource Copyright 1998 */
/* */
/* \\\\\\\ */
/* ( o o ) */
/*------------------------oOO----(_)----OOo-------------------------*/
/* */
/* System name . . . : Programmer Tool */
/* Program name . . . : RTVDB1 */
/* Text . . . . . . . : Retrieve Database Source */
/* */
/* Author . . . . . . : Alexander Nubla */
/* Creation date. . . : 06/24/98 */
/* */
/* Description. . . . : This is the CPP for command RTVDBSRC */
/* */
/* ooooO Ooooo */
/* ( ) ( ) */
/*----------------------( )-------------( )---------------------*/
/* (_) (_) */
/* */
/* Modification Log: */
/* */
/* Date Task Programmer/Description */
/* -------- ----- ------------------------------------------------ */
/* 06/24/98 Alex Nubla */
/* Created */
/* */
/********************************************************************/
pgm (&QFile /* File name & library */ +
&QSrc /* To source file & lib */ +
&Tombr /* To member name */ +
&Mbropt ) /* *REPLACE or *ADD */
/*--------------------------------------------------------*/
/* declaration */
/*--------------------------------------------------------*/
dcl &QFile *char 20
dcl &QSrc *char 20
dcl &Tombr *char 10
dcl &Mbropt *char 8
dcl &File *char 10
dcl &FileL *char 10
dcl &Src *char 10
dcl &SrcL *char 10
dcl &ObjAtr *char 10
dcl &Text *char 50
dcl &FileTyp *char 5
dcl &Rtncde *char 2
dcl &error *lgl /* std err */
dcl &msgid *char 7 /* std err */
dcl &msgkey *char 4 /* std err */
dcl &msgdta *char 100 /* std err */
dcl &msgf *char 10 /* std err */
dcl &msgflib *char 10 /* std err */
dcl &msgtyp *char 10 '*DIAG' /* std err */
dcl &msgtypctr *char 4 X'00000001' /* std err */
dcl &pgmmsgq *char 10 '*' /* std err */
dcl &stkctr *char 4 X'00000001' /* std err */
dcl &errbytes *char 4 X'00000000' /* std err */
monmsg msgid(cpf0000) exec(goto error)
chgjob logclpgm(*no)
/*--------------------------------------------------------*/
/* break up the names and libraries */
/*--------------------------------------------------------*/
chgvar &File %sst(&QFile 1 10)
chgvar &FileL %sst(&QFile 11 10)
chgvar &Src %sst(&QSrc 1 10)
chgvar &SrcL %sst(&QSrc 11 10)
/*----------------------------------------------*/
/* validate the file */
/*----------------------------------------------*/
valfile:
chkobj obj(&FileL/&File) +
objtype(*file) +
aut(*use)
monmsg (cpf9801 cpf9802) exec(do)
rcvmsg msgtype(*last) +
msgdta(&msgdta) +
msgid(&msgid) +
msgf(&msgf) +
msgflib(&msgflib)
sndpgmmsg msgid(&msgid) +
msgf(&msgflib/&msgf) +
msgdta(&msgdta)
sndpgmmsg msgid(cpf9898) +
msgf(qcpfmsg) +
msgdta('RTVDBSRC command aborted')
return
enddo
rtvobjd Obj(&FileL/&File) +
ObjType(*File) +
RtnLib(&FileL) +
ObjAtr(&ObjAtr) +
Text(&Text)
if (%sst(&FileL 1 1) = '*') then(do)
chgvar %sst(&QFile 11 10) &FileL
enddo
if (&ObjAtr = 'PF') then(goto valsrc)
if (&ObjAtr = 'LF') then(goto valsrc)
sndpgmmsg msgid(cpf9898) +
msgf(qcpfmsg) +
msgtype(*escape) +
msgdta('RTVDBSRC command valid only +
for existing Physical or Logical file')
/*----------------------------------------------*/
/* validate the source file */
/*----------------------------------------------*/
valsrc:
if (%sst(&SrcL 1 1) = '*') then(do)
rtvobjd Obj(&Src) +
ObjType(*File) +
RtnLib(&SrcL)
chgvar %sst(&QSrc 11 10) &SrcL
enddo
if (&Tombr = '*FILE') then(chgvar &Tombr &File)
chkobj obj(&SrcL/&Src) +
objtype(*file) +
mbr(&Tombr) +
aut(*change)
monmsg cpf9815 exec(do)
chgvar &MbrOpt '*ADD'
goto filetyp
enddo
if (&MbrOpt = '*ADD') do
sndpgmmsg msgid(cpf9898) +
msgf(qcpfmsg) +
msgtype(*escape) +
msgdta('Member' |> &Tombr |> +
'already exist in the source +
file' |> &Src |> +
'in library' |>&SrcL |> +
'. *ADD for member option is +
not allowed')
enddo
filetyp:
if (&MbrOpt = '*ADD') do
rtvmbrd file(&SrcL/&Src) +
mbr(*first) +
filetype(&FileTyp)
monmsg cpf3019
enddo
else do
rtvmbrd file(&SrcL/&Src) +
mbr(&Tombr) +
filetype(&FileTyp)
monmsg cpf3019 exec(do)
chgvar &MbrOpt '*ADD'
enddo
enddo
if (&FileTyp *ne '*SRC') do
sndpgmmsg msgid(cpf9898) +
msgf(qcpfmsg) +
msgtype(*escape) +
msgdta('RTVDBSRC valid only for +
source physical file. RTVDBSRC +
request to file' |> &Src |> +
'in library' |>&SrcL |> +
'aborted.')
enddo
/*--------------------------------------------------------*/
/* Build the temporary source member. This protects */
/* the original member from being changed until all */
/* RTVDBSRC finished building the member. */
/*--------------------------------------------------------*/
tempsrc:
dltf file(qtemp/qddssrc)
monmsg cpf2105
cpyf fromfile(*libl/qddssrc) +
tofile(qtemp/qddssrc) +
mbropt(*add) +
crtfile(*yes)
monmsg cpf2802 exec(do)
cpyf fromfile(qgpl/qddssrc) +
tofile(qtemp/qddssrc) +
mbropt(*add) +
crtfile(*yes)
enddo
rmvm file(qtemp/qddssrc) +
mbr(*all)
addpfm file(qtemp/qddssrc) +
mbr(&Tombr) +
srctype(&ObjAtr) +
text(&Text)
ovrdbf file(qddssrc) +
tofile(qtemp/qddssrc) +
mbr(&Tombr) +
secure(*yes)
/*--------------------------------------------------------*/
/* Build the outfile file for file access key */
/*--------------------------------------------------------*/
tempfd:
sndpgmmsg msgid(cpf9898) +
msgf(qcpfmsg) +
msgdta('Building DDS member +
for file' |> &File |> +
'in library' |> &FileL) +
topgmq(*ext) +
msgtype(*status)
dspfd file(&FileL/&File) +
type(*accpth) +
output(*outfile) +
outfile(qtemp/QAFDACCP)
ovrdbf file(qafdaccp) +
tofile(qtemp/qafdaccp) +
secure(*yes)
if (&ObjAtr = 'LF') do
dspfd file(&FileL/&File) +
type(*select) +
output(*outfile) +
outfile(qtemp/QAFDSELO)
ovrdbf file(qafdselo) +
tofile(qtemp/qafdselo) +
secure(*yes)
dspfd file(&FileL/&File) +
type(*join) +
output(*outfile) +
outfile(qtemp/QAFDJOIN)
ovrdbf file(qafdjoin) +
tofile(qtemp/qafdjoin) +
secure(*yes)
enddo
/*--------------------------------------------------------*/
/* Call RTVDBSRC2 - build new DDS member */
/*--------------------------------------------------------*/
callprc 'RTVDB2' parm(&File +
&FileL +
&ObjAtr +
&Tombr +
&Text +
&rtncde )
dltovr *all
/*----------------------------------------------*/
/* Error in RTVDB2 (return code 99) */
/*----------------------------------------------*/
If (&rtncde = '99') do
sndpgmmsg msgid(cpf9898) +
msgf(qcpfsg) +
msgtype(*escape) +
msgdta('Error occured in RTVDBSRC')
enddo
/*----------------------------------------------*/
/* Move new member to the original member */
/*----------------------------------------------*/
cpyf fromfile(qtemp/qddssrc) +
tofile(&SrcL/&Src) +
frommbr(&ToMbr) +
tombr(*frommbr) +
mbropt(&mbropt)
monmsg msgid(cpf2817) +
cmpdta(cpf2869)
dltf file(qtemp/qddssrc)
sndpgmmsg msgid(cpf9898) +
msgf(QCPFMSG) +
msgtype(*comp) +
msgdta('RTVDBSRC completed. +
Member' |> &ToMbr |> +
'added in' |> &SrcL |< +
'/' |< &Src)
rmvmsg clear(*all)
goto end
/*--------------------------------------------------------*/
/* error routine: */
/*--------------------------------------------------------*/
error:
if &error (goto errordone)
else chgvar &error '1'
/*----------------------------------------------*/
/* move all *DIAG message to *PRV program queue*/
/*----------------------------------------------*/
call QMHMOVPM (&msgkey +
&msgtyp +
&msgtypctr +
&pgmmsgq +
&stkctr +
&errbytes)
/*----------------------------------------------*/
/* resend the last *ESCAPE message */
/*----------------------------------------------*/
errordone:
call QMHRSNEM (&msgkey +
&errbytes)
monmsg cpf0000 exec(do)
sndpgmmsg msgid(cpf3cf2) msgf(QCFPMSG) +
msgdta('QMHRSNEM') msgtype(*escape)
monmsg cpf0000
enddo
end: endpgm