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
  



© 2007 Workware, Inc. All rights reserved.