SEU Exit Program in ILE RPG
I know, I know. No one uses SEU anymore.
Well I do.
This SEU exit program handles my @@ and @@@ line commands. It fixes the allocation for specific varying character fields. So something like this:
dcl-s someText varchar(50) inz('ABC123');
gets converted to this:
dcl-s someText char(6) inz('ABC123');
To invoke it put @@ on a line and press enter. To update a block of code use @@@. Unfortunately using the block command updates the source change date on the line even if the code on that line isn’t changed. I don’t see a way around it.
Here’s the exit program. Start PDM, open an RPGLE member, press F13 and scroll a screen and enter the program name and library where it says “User exit program””:
h dftactgrp(*no)
h option(*srcstmt: *nodebugio: *noshowcpy)
d pHeadP s *
d pOutP s *
d pLineP s *
d i# s 10i 0
d j# s 10i 0
d line# s 10i 0
d @line s 999a
d alloc# s 10i 0
d blockCmd s 3a
d lastRec s n
dcl-ds dsHead qualified based(dsHeadP);
rcdLen int(10); // length of srcpf record
csrRrn int(10); // cursor RRN
csrPos int(10); // cursor column position
ccsid int(10); // CCSID
numRecs int(10); // # of records in input ( +1 )
mbr char(10);
file char(10);
lib char(10);
type char(10); // member type
fnKey char(1); // function key (F7/F8/Other)
mode char(1); // (U)pdate/(B)rowse/(M)rgSrc
split char(1); // 0=No, 1=Yes (split session)
rsv1 char(1);
end-ds dsHead;
dcl-ds dsOut qualified based(dsOutP);
rtnCode char(1); // 0=Processed Upd,1=ProcessedNoUpd,2=error,3=none
rsv1 char(3);
numRecsO int(10); // number of records out
insSeq char(7); // Seq# to perform insert
rsv2 char(22);
end-ds dsOut;
dcl-ds dsLine qualified based(dsLineP);
key;
cmd char(7) overlay(key: 1); // if not *blank will highlight o
rtnCode char(1) overlay(key: *next); // 0=no error, 1=error.
seq char(6) overlay(key: *next); // source sequence#
chgDt char(6) overlay(key: *next); // source line change date
txt char(100); // source text
end-ds dsLine;
c *entry plist
c parm pHeadP
c parm pOutP
c parm pLineP
*inlr = *on;
dsHeadP = pHeadP;
dsOutP = pOutP;
// skip F7/F8;
if dsHead.fnKey in %list('7': '8');
return;
endif;
for line# = 1 to dsHead.numRecs;
dsLineP = pLineP + ((dsHead.rcdLen + %size(dsLine.key)) * (line# - 1));
// handle block command:
if blockCmd = *blanks;
select;
when dsLine.cmd = '@@@';
blockCmd = '@@@';
endsl;
else;
if blockCmd = dsLine.cmd; // closing block tag
lastRec = *on;
endif;
endif;
select;
when dsLine.cmd = '@@' or blockCmd = '@@@';
exsr x@@;
other;
dsLine.rtnCode = '1';
endsl;
if lastRec;
clear blockCmd;
endif;
endfor;
dsOut.rtnCode = '2';
dsOut.numRecsO = dsHead.numRecs - 1; // SEU sends #lines + 1
return;
**********************************************************************
begsr x@@;
@line = %subst(dsLine.txt: 1: dsHead.rcdLen);
if %scan('@_': @line ) = 0 and dsLine.cmd = '@@@'; // use @@ on non @_ l
dsLine.rtnCode = '0'; // 0=No errors, 1=Error
dsLine.cmd = *blanks;
leavesr;
endif;
i# = %scan('char(': @line );
if i# = 0;
dsLine.rtnCode = '0';
dsLine.cmd = *blanks;
leavesr;
endif;
i# += 5;
j# = %scan(')': @line : i#);
alloc# = %dec(%subst(@line : i#: j#-i#): 7: 0);
i# = %scan('inz(''': @line );
if i# = 0;
dsLine.rtnCode = '0';
dsLine.cmd = *blanks;
leavesr;
endif;
i# += 5;
j# = %scan(''')': @line : i#);
@line = %scanrpl('char(' + %trim(%char(alloc#)) + ')':
'char(' + %trim(%char(j#-i#)) + ')':
@line);
@line = %scanrpl('varchar(': 'char(': @line);
%subst(dsLine.txt: 1: dsHead.rcdLen) = %subst(@line : 1: dsHead.rcdLen);
dsLine.rtnCode = '0';
dsLine.cmd = *blanks;
endsr;
**********************************************************************