× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Buck,

That is a great example!  I figured it would be best to use the RPG for the 
front end processing due to the parameter limitations in the CLP.  So far, 
everything is working out really nice and as anticipated.  I AM using the 
offsets to get the old/new values as suggested, and have developed a really 
nice template to date.  Thanks again for everyone's input!


-Tracy 
 Ext. 3107


-----Original Message-----
From: Buck Calabro [mailto:Buck.Calabro@xxxxxxxxxxxx]
Sent: Tuesday, March 25, 2003 11:18 AM
To: RPG programming on the AS400 / iSeries
Subject: RE: Programming a trigger audit in ILE


Tracy asked:

>Is anyone using a CLP as the trigger program?  

Sort of.  You can use a CLP as an initial handler (as in checking a data
area to see if you want the trigger to run or not.  You might not, if you're
doing maintenance on the trigger program!)  You can also use the CLP as a
front-end for ADDLIBLE et.al.  If you decide to go this route, have the CLP
do the ADDLIBLE and then pass the buffer on to an RPG program for the "real"
processing.  Remember that CL variables can't hold a large buffer.

In any event, I advise using RPG for the front end handler.  You can use
QCMDEXC, QCAPCMD or system() to do the ADDLIBLE.  Here's some more code -
check it carefully, as my recent track record isn't envious... :-)

TRIGGER
d trgBuf        e ds                  EXTNAME(Trigger)      
d trgBufLen       s             10u 0                       
d trgRtnCode      s             10u 0                       
d trgStatus       s              1a                         
                                                            
dsndMsg           pr                                        
d errMsgId                                  like(trgRtnCode)
                                                            
 * Input/output parameters                                  
c     *entry        plist                                   
c                   parm                    trgBuf          
c                   parm                    trgBufLen       
                                                            
c     *dtaara       define    TRIGGER       trgStatus       
c                   in        trgStatus                     

c                   if        trgStatus = 'Y'                      
c                   call      'TRIGGERRUN'                         
c                   parm                    trgBuf                 
c                   parm                    trgBufLen              
c                   parm                    trgRtnCode             
                                                                   
c                   if        trgRtnCode <> 0                      
c                   callp     sndMsg(trgRtnCode)                   
c                   endif                                          
                                                                   
c                   endif                                          
                                                                   
c                   eval      *INLR=*On                            
                                                                   
psndMsg           b                                                
dsndMsg           pi                                               
d errMsgId                                  like(trgRtnCode)       
                                                                   
 * Send message API parameters                                     
 *   stack count reflects the fact that we need to send the message
 *   up the stack; i.e. not this pgm, but it's caller.  Rememb
 *   down another level because of the subprocedure...        
D msgId           s              7    inz('CPF9898')          
D msgFil          s             20    inz('QCPFMSG   *LIBL    
D msgData         s             80                            
D msgDataLen      s             10i 0 inz(%len(msgData))      
D msgType         s             10    inz('*ESCAPE')          
D msgStackEnt     s             10    inz('*')                
D msgStackCnt     s             10i 0 inz(3)                  
D msgKey          s              4                            
D msgErrStruc     s                   like(errStruc)          
                                                              
 * API error structure                                        
D errStruc        DS                  inz                     
D  errSSize                     10i 0 inz(%len(errStruc))     
D  errSUse                      10i 0                         
D  errSMsgID                     7                            
D  errSResrv                     1                            
D  errSData                     80                            
                                                              
C                   eval      msgData  = 'Trigger failed: ' + 
C                                           %trim(%editc(errMsgId: 'Z')
C                   eval      msgErrStruc = errStruc                   
                                                                       
C                   call      'QMHSNDPM'                               
C                   parm                    msgId                      
C                   parm                    msgFil                     
C                   parm                    msgData                    
C                   parm                    msgDataLen                 
C                   parm                    msgType                    
C                   parm                    msgStackEnt                
C                   parm                    msgStackCnt                
C                   parm                    msgKey                     
C                   parm                    msgErrStruc                
                                                                       
C                   Eval      errStruc = msgErrStruc                   
p                 e                                                    



TRIGGERRUN
 * =========================================================== 
 * Specific to this DBF                                        
 * =========================================================== 
                                                               
 * Map the file I/O buffers from the external definitions      
D OldRcdImg     E DS                  EXTNAME(DATESAMPLE)      
D                                     based(pOldRcd)           
D                                     prefix(O_)               
D NewRcdImg     E DS                  EXTNAME(DATESAMPLE)      
D                                     based(pNewRcd)           
D                                     prefix(N_)               
                                                               
 * =========================================================== 
 * Generic to all triggers:                                    
 * =========================================================== 
                                                               
 * The DS definition has a field that pushes the               
 * DS length to 32766.  This field is only there for           
 * debugging purposes, and can be ommitted if desired.         
 * Never use that field to access the buffers; always          
 * use the data structures defined above with the EXTNAME      
 * of the physical file being triggered.                       
D TrgBuf        E DS                  EXTNAME(Trigger)         
                                                               
 * We can't tell how many fields are in the file;              
 * to avoid hard-coding the number, set up an arbitrarily large
 * array to hold the null map.  Remember that you can only     
 * trust the array up to the null map length!!!                
D OldNulImg       ds         32766    Based(POldNul)           
D  OldNulMap                     1a   dim(%size(OldNulImg))    
D NewNulImg       ds         32766    Based(PNewNul)           
D  NewNulMap                     1a   dim(%size(NewNulImg))    
                                                               
 * Local work variables                                        
D TrgBufLen       S             10u 0                          
D TrgRtnCde       S             10u 0                          
D OldNulCount     S             10i 0                          
D NewNulCount     S             10i 0                          
D OldNulFlds      S             10i 0                          
D NewNulFlds      S             10i 0                          
                                                               
 * Named constants                                             
 *      Commit level *NONE                         
D CLNone          S              1A   INZ('0')     
 *      Commit level *CHG                          
D CLChg           S              1A   INZ('1')     
 *      Commit level *CS                           
D CLCs            S              1A   INZ('2')     
 *      Commit level *ALL                          
D CLAll           S              1A   INZ('3')     
                                                   
 *      Trigger event = Insert                     
D TrgIns          S              1A   INZ('1')     
 *      Trigger event = Delete                     
D TrgDel          S              1A   INZ('2')     
 *      Trigger event = Update                     
D TrgUpd          S              1A   INZ('3')     
                                                   
 *      Trigger time = Before                      
D TrgBef          S              1A   INZ('1')     
 *      Trigger time = After                       
D TrgAft          S              1A   INZ('2')     
                                                   
 *      Null = No                                                 
D NullNo          S              1A   INZ('0')                    
 *      Null = Yes                                                
D NullYes         S              1A   INZ('1')                    
                                                                  
 * Input/output parameters                                        
C     *Entry        Plist                                         
C                   Parm                    TrgBuf                
C                   Parm                    TrgBufLen             
C                   Parm                    TrgRtnCde             
                                                                  
 * Load the working record buffers and null maps                  
 * Reiterate the warning about obeying the limits of the buffer   
 * as set by the "length" variables.  Because we're using pointers
 * we can wander off into "memory unknown" if we fail to observe  
 * these limits!!!                                                
                                                                  
 * To manipulate the null indicator for a field,                  
 * set the null map value.  Don't try to fiddle with %nullind     
 * because you can't have a null capable data structure subfield. 

C                   EVAL      pOldRcd = %ADDR(TrgBuf)+ Z1OROFF  
C                   EVAL      pOldNul = %ADDR(TrgBuf)+ Z1ORNBO  
C                   EVAL      pNewRcd = %ADDR(TrgBuf)+ Z1NROFF  
C                   EVAL      pNewNul = %ADDR(TrgBuf)+ Z1NRNBO  
                                                                
 * ===========================================================  
 * Specific to this DBF                                         
 * ===========================================================  
                                                                
 * Test conditions                                              
C                   Select                                      
 * Here, if the name is left blank, we'll populate it           
 * with an eye-catcher so we know the trigger works.            
C                   When      N_Char=*Blanks                    
C                   Eval      N_Char='Trigger'                  
C                   When      N_Char='NULL'                     
C                   Eval      NewNulMap(1) = NullYes            
C                   Eval      N_Char = 'Now null'               
 * Here, if the name is '01', we'll fail the update             
 * This is to test trigger failure                              
C                   when      N_Char='01'                       
C                   eval      trgRtnCde = 1                   
C                   EndSL                                     
                                                              
 * "Do nothing" code to look at null maps in debug            
C                   Eval      OldNulCount = 1                 
C                   Eval      OldNulFlds  = 0                 
C                   DoW       OldNulCount <= Z1ORNBL          
C                   If        OldNulMap(OldNulCount) <> NullNo
C                   Eval      OldNulFlds = OldNulFlds + 1     
C                   EndIf                                     
C                   Eval      OldNulCount = OldNulCount + 1   
C                   EndDo                                     
                                                              
C                   Eval      NewNulCount = 1                 
C                   Eval      NewNulFlds  = 0                 
C                   DoW       NewNulCount <= Z1NRNBL          
C                   If        NewNulMap(NewNulCount) <> NullNo
C                   Eval      NewNulFlds = NewNulFlds + 1     
C                   EndIf                                     
C                   Eval      NewNulCount = NewNulCount + 1   
C                   EndDo                                     
                                          
C                   Eval      *INLR=*On   

  --buck
_______________________________________________
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.



As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.