Iseries AS400 . Convertir expresiones RPGIV formato fijo en formato libre

/*==================================================================*/ /* To compile: */ /* */ /* CRTCMD CMD(XXX/CVTRPGEXP) PGM(XXX/RPGEXPCL) + */ /* SRCFILE(XXX/QCMDSRC) */ /* */ /*==================================================================*/ CMD PROMPT('Convert RPG Expressions') PARM KWD(FROMFILE) TYPE(FROMFILE) MIN(1) + PROMPT('From file') FROMFILE: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('Library') PARM KWD(FROMMBR) TYPE(*NAME) SPCVAL((*FIRST)) + MIN(1) PROMPT('From member') PARM KWD(TOFILE) TYPE(TOFILE) PROMPT('To file') TOFILE: QUAL TYPE(*NAME) DFT(QRPGLESRC) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('Library') PARM KWD(TOMBR) TYPE(*NAME) DFT(*FROMMBR) + SPCVAL((*FROMMBR)) PROMPT('To member') /*==================================================================*/ /*==================================================================*/ /* To compile: */ /* */ /* CRTCLPGM PGM(XXX/RPGEXPCL) SRCFILE(XXX/QCLSRC) */ /* */ /*==================================================================*/ PGM PARM(&FROMFILE &FROMMBR &TOFILE &TOMBR) DCL VAR(&FROMFILE) TYPE(*CHAR) LEN(20) DCL VAR(&FROMMBR) TYPE(*CHAR) LEN(10) DCL VAR(&TOFILE) TYPE(*CHAR) LEN(20) DCL VAR(&TOMBR) TYPE(*CHAR) LEN(10) DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(10) DCL VAR(&RTNLIB) TYPE(*CHAR) LEN(10) DCL VAR(&RTNMBR) TYPE(*CHAR) LEN(10) DCL VAR(&TEXT) TYPE(*CHAR) LEN(50) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* Send all errors to error handling routine */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR)) /* Validate "from" file and member */ RTVMBRD FILE(%SST(&FROMFILE 11 10)/%SST(&FROMFILE 1 + 10)) MBR(&FROMMBR) RTNLIB(&RTNLIB) + RTNMBR(&RTNMBR) FILETYPE(&FILETYPE) + SRCTYPE(&SRCTYPE) TEXT(&TEXT) IF COND(&FILETYPE *NE '*SRC') THEN(SNDPGMMSG + MSGID(CPF0781) MSGF(QCPFMSG) + MSGDTA(%SST(&FROMFILE 1 10) *CAT + %SST(&FROMFILE 11 10)) MSGTYPE(*ESCAPE)) IF COND(&SRCTYPE *NE 'RPGLE' *AND &SRCTYPE *NE + 'SQLRPGLE') THEN(SNDPGMMSG MSGID(EDT1511) + MSGF(QPDA/QEDTMSG) MSGTYPE(*ESCAPE)) CHGVAR VAR(%SST(&FROMFILE 11 10)) VALUE(&RTNLIB) CHGVAR VAR(&FROMMBR) VALUE(&RTNMBR) /* Validate "to" file and member */ RTVOBJD OBJ(%SST(&TOFILE 11 10)/%SST(&TOFILE 1 10)) + OBJTYPE(*FILE) RTNLIB(&RTNLIB) CHGVAR VAR(&RTNLIB) VALUE(%SST(&TOFILE 11 10)) IF COND(&TOMBR *EQ '*FROMMBR') THEN(CHGVAR + VAR(&TOMBR) VALUE(&FROMMBR)) CHKOBJ OBJ(%SST(&TOFILE 11 10)/%SST(&TOFILE 1 10)) + OBJTYPE(*FILE) MBR(&TOMBR) MONMSG MSGID(CPF9815) EXEC(GOTO CMDLBL(SKIP)) /* Don't allow conversion into same member */ IF COND(&FROMFILE *EQ &TOFILE *AND &FROMMBR *EQ + &TOMBR) THEN(SNDPGMMSG MSGID(CPF2874) + MSGF(QCPFMSG) MSGDTA(&TOFILE *CAT &TOMBR) + MSGTYPE(*ESCAPE)) /* Don't allow conversions if "to" member exists */ SNDPGMMSG MSGID(CPD3211) MSGF(QCPFMSG) + MSGDTA(%SST(&TOFILE 1 10) *CAT + %SST(&TOFILE 11 10) *CAT ' ' + *CAT &TOMBR) MSGTYPE(*ESCAPE) /* Send "Converting... " status message */ SKIP: SNDPGMMSG MSGID(RNS9351) MSGF(QRPGLE/QRPGLEMSG) + MSGDTA(%SST(&FROMFILE 11 10) *CAT + %SST(&FROMFILE 1 10) *CAT &FROMMBR) + TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Add a new member to the file */ ADDPFM FILE(%SST(&TOFILE 11 10)/%SST(&TOFILE 1 10)) + MBR(&TOMBR) TEXT(&TEXT) /* Change the member type to RPGLE */ CHGPFM FILE(%SST(&TOFILE 11 10)/%SST(&TOFILE 1 10)) + MBR(&TOMBR) SRCTYPE(&SRCTYPE) /* Perform file overrides */ OVRDBF FILE(INPUT) TOFILE(%SST(&FROMFILE 11 + 10)/%SST(&FROMFILE 1 10)) MBR(&FROMMBR) + OVRSCOPE(*CALLLVL) OVRDBF FILE(OUTPUT) TOFILE(%SST(&TOFILE 11 + 10)/%SST(&TOFILE 1 10)) MBR(&TOMBR) + OVRSCOPE(*CALLLVL) /* Call program to convert expressions */ CALL PGM(RPGEXPRG) /* Send completion message */ SNDPGMMSG MSGID(CPC7305) MSGF(QCPFMSG) MSGDTA(&TOMBR + *CAT %SST(&TOFILE 11 10) *CAT + %SST(&TOFILE 1 10)) MSGTYPE(*COMP) RETURN /* Error handling routine */ ERROR: RCVMSG MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + MSGFLIB(&MSGFLIB) MONMSG MSGID(CPF0000) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000) ENDPGM: ENDPGM /*==================================================================*/ *=============================================================== * To compile: * * CRTBNDRPG PGM(XXX/RPGEXPRG) SRCFILE(XXX/QRPGLESRC) * *=============================================================== FInput IF F 112 Disk FOutput O F 112 Disk D Relation S 2 D Operator S 3 D OpCode S 4 D Continue S 1 Inz(*Off) D Data S 1 Inz(*Off) D X S 1 0 D DS D Rel1Data 12 Inz('EQNEGTLTGELE') D Rel1 2 Overlay(Rel1Data) Dim(6) D Rel2Data 12 Inz('= <>> < >=<=') D Rel2 2 Overlay(Rel2Data) Dim(6) D OutLin DS D OutSeq 1 6 2 D OutDat 7 12 0 D OutDta 13 112 IInput NS I 1 6 2InpSeq I 7 12 0InpDat I 13 112 InpDta *=============================================================== * Read through input file and write to output file C Read Input 99 C Dow Not *In99 C Eval OutSeq = InpSeq C Eval OutDat = InpDat C Eval OutDta = InpDta C Exsr ChkSource C Except C Read Input 99 C Enddo C Eval *InLR = *On *=============================================================== C ChkSource Begsr * Translate statements to upper case for comparisons C Call 'QDCXLATE' C Parm 100 Length 5 0 C Parm InpDta Source 100 C Parm 'QSYSTRNTBL' Trntbl 10 * Check for compile time data C If %Subst(Source:1:3) = '** ' Or C %Subst(Source:1:9) = '**CTDATA ' C Eval Data = *On C Endif * Don't convert compile time data C If Data = *Off * Only consider non-commented calcs containing a factor 1 entry C If %Subst(Source:6:1) = 'C' And C %Subst(Source:7:1) <> '*' And C %Subst(Source:7:1) <> '+' And C %Subst(Source:12:1) <> ' ' * Perform record selection C Select * Process "If" statements C When %Subst(Source:26:2) = 'IF' C Eval OpCode = %Subst(InpDta:26:2) C Eval Relation = %Subst(Source:28:2) C Exsr FmtOutput * Process "Do While" and "Do Until" statements C When %Subst(Source:26:3) = 'DOW' Or C %Subst(Source:26:3) = 'DOU' C Eval OpCode = %Subst(InpDta:26:3) C Eval Relation = %Subst(Source:29:2) C Exsr FmtOutput * Process "When" statements C When %Subst(Source:26:4) = 'WHEN' C Eval OpCode= %Subst(InpDta:26:4) C Eval Relation = %Subst(Source:30:2) C Exsr FmtOutput * Process "And" statements C When %Subst(Source:26:3) = 'AND' C Eval Continue = *On C Eval Relation = %Subst(Source:29:2) C Eval Operator= %Subst(InpDta:26:3) C Exsr FmtOutput * Process "Or" statements C When %Subst(Source:26:2) = 'OR' C Eval Continue = *On C Eval Relation = %Subst(Source:28:2) C Eval Operator= %Subst(InpDta:26:2) C Exsr FmtOutput C Endsl C Endif C Endif C Endsr *=============================================================== C FmtOutput Begsr * Clear the output data field C Eval OutDta = *Blanks * Load the original statement to the left of factor 1 C Eval %Subst(OutDta:1:11) = %Subst(InpDta:1:11) * Translate the relational operator to its symbolic equivalent C Eval X = 1 C Relation Lookup Rel1(X) 99 C If *In99 = *On C Eval Relation = Rel2(X) C Endif * Concatenatate the rest of the statement together C IF Continue = *On C Eval %Subst(OutDta:36:45) = C %Trim(Operator) + ' ' + C %Trim(%Subst(InpDta:12:14)) + C ' ' + %Trim(Relation) + ' ' + C %Trim(%Subst(InpDta:36:45)) C Eval Continue = *Off C Else C Eval %Subst(OutDta:26:4) = OpCode C Eval %Subst(OutDta:36:45) = C %Trim(%Subst(InpDta:12:14)) + C ' ' + %Trim(Relation) + ' ' + C %Trim(%Subst(InpDta:36:45)) C Eval OpCode = *Blanks C Endif C Endsr *=============================================================== OOutput E O OutLin 112 *===============================================================