SEU Exit Program in ILE RPG

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;                                                                   
  **********************************************************************    

Leave a Reply

Your email address will not be published. Required fields are marked *