|
midrange.com
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
As an Amazon Associate we earn from qualifying purchases.
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.
