Refactoring RPG - Part 1
By Stephen West
Figure 2. CSC8801.clle - Command Processing Program for REFACTOR Command
/********************************************************************/
/* Description: CPP for the REFACTOR command. */
/********************************************************************/
Pgm (&cpFromQual &cpFromMbr &cpToQual &cpToMbr +
&cpZapFst5 &cpZapType &cpSetDate &cpSetOpCds +
&cpLoBltin &cpLoFigCon &cpCvt2BlkL +
&cpUpdConds &cpRmvHiLit)
Dcl &cpFromQual *char 20
Dcl &pmFromFile *char 10
Dcl &pmFromLib *char 10
Dcl &cpToQual *char 20
Dcl &pmToFile *char 10
Dcl &pmToLib *char 10
Dcl &cpFromMbr *char 10
Dcl &pmFromMbr *char 10
Dcl &cpToMbr *char 10
Dcl &pmToMbr *char 10
Dcl &cpZapFst5 *char 4
Dcl &cpZapType *char 4
Dcl &cpSetDate *char 7
Dcl &cpSetOpCds *char 4
Dcl &cpLoBltin *char 4
Dcl &cpLoFigCon *char 4
Dcl &cpCvt2BlkL *char 4
Dcl &cpUpdConds *char 4
Dcl &cpRmvHiLit *char 4
Dcl &pvSrcType *char 10
Dcl &pvMbrText *char 50
/* Variables for error handling subroutine. */
Dcl &ERRORSW *Lgl
Dcl &MSGID *Char 7
Dcl &MSG *Char 512
Dcl &MSGDTA *Char 512
Dcl &MSGF *Char 10
Dcl &MSGFLIB *Char 10
Dcl &KEYVAR *Char 4
Dcl &KEYVAR2 *Char 4
Dcl &RTNTYPE *Char 2
/* Global error message handler */
MonMsg CPF0000 Exec(GOTO ErrHandler)
/* Extract the needed library and file names from the */
/* qualified names passed in on the command. */
ChgVar &pmFromLib %SST(&cpFromQual 11 10)
ChgVar &pmFromFile %SST(&cpFromQual 1 10)
ChgVar &pmToLib %SST(&cpToQual 11 10)
ChgVar &pmToFile %SST(&cpToQual 1 10)
ChgVar &pmFromMbr &cpFromMbr
ChgVar &pmToMbr &cpToMbr
/* Create field work file in QTEMP. */
RmvLible QTEMP
MonMsg CPF0000
AddLible QTEMP
MonMsg CPF0000
DltF QTEMP/CSPFIELDS
MonMsg CPF0000
CrtDupObj CSPFIELDS *libl *file QTEMP Data(*NO)
/* Add the new source physical member to be written to. */
RtvMbrD &pmFromLib/&pmFromFile +
Mbr(&pmFromMbr *SAME) SrcType(&pvSrcType) Text(&pvMbrText)
AddPFM &pmToLib/&pmToFile &pmToMbr SrcType(&pvSrcType) Text(&pvMbrText)
/* Remind user to first convert from RPG to RPGLE using CVTRPGSRC. */
If (&pvSrcType *EQ 'RPG ') Then( +
Do)
SndPgmMsg MsgID(CSM0001) MsgF(CSMSGF) +
ToPgmQ(*PRV) MsgType(*COMP) +
MsgDta('First convert from RPG to RPGLE using CVTRPGSRC command.')
GoTo ExitPgm /* Normal termination */
EndDo
/* Do overrides so that the correct files are pointed to */
OvrDbf InputSrc &pmFromLib/&pmFromFile &pmFromMbr
OvrDbf OutputSrc &pmToLib/&pmToFile &pmToMbr
OvrDbf CSPFIELDS QTEMP/CSPFIELDS
Call CS8801 (&cpZapFst5 &cpZapType &cpSetDate &cpSetOpCds +
&cpLoBltin &cpLoFigCon &cpCvt2BlkL +
&cpUpdConds &cpRmvHiLit)
DltOvr InputSrc
DltOvr OutputSrc
DltOvr CSPFIELDS
/* Notify user that the structure has been successfully created. */
SndPgmMsg MsgID(CSM0001) MsgF(CSMSGF) +
ToPgmQ(*PRV) MsgType(*COMP) +
MsgDta('Filter of RPGLE source completed successfully.')
GoTo ExitPgm /* Normal termination */
/*= Error Handler ===================================================*/
ErrHandler:
ErrMsg: /* Standard error handling subroutine. */
If &ERRORSW SndPgmMsg MsgId(CPF9999) MsgF(QCPFMSG) MsgType(*ESCAPE)
ChgVar &ERRORSW '1' /* Set to fail on error */
RcvMsg MsgType(*EXCP) Rmv(*NO) KeyVar(&KEYVAR)
ErrMsg2:
RcvMsg MsgType(*PRV) MsgKey(&KEYVAR) Rmv(*NO) KeyVar(&KEYVAR2) +
Msg(&MSG) MsgDta(&MSGDTA) MsgId(&MSGID) RtnType(&RTNTYPE) +
MsgF(&MSGF) SndMsgFLib(&MSGFLIB)
If (&RTNTYPE *NE '02') GoTo ErrMsg3 /* '02'=>Diagnostic */
If (&MSGID *NE ' ') Then( +
Do)
SndPgmMsg MsgId(&MSGID) MsgF(&MSGFLIB/&MSGF) +
MsgDta(&MSGDTA) MsgType(*DIAG)
EndDo
If (&MSGID *EQ ' ') SndPgmMsg Msg(&MSG) MsgType(*DIAG)
RcvMsg MsgKey(&KEYVAR2)
ErrMsg3:
RcvMsg MsgKey(&KEYVAR) MsgDta(&MSGDTA) MsgId(&MSGID) MsgF(&MSGF) +
SndMsgFLib(&MSGFLIB)
SndPgmMsg MsgId(&MSGID) MsgF(&MSGFLIB/&MSGF) +
MsgDta(&MSGDTA) MsgType(*ESCAPE)
/*==================================================================*/
ExitPgm:
Return
EndPgm
|