QUSCRTUQ & QLICVTTP & QUILNGTX
|
QUSCRTUQ: Create user queue
QLICVTTP : Convert object type
QUILNGTX : Display long text
** Program . . : CBX1150
** Description : Test user queues - client function
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : February 19, 2004
**
**
** Program summary
** ---------------
**
** This program offers some simple templates for a number of the
** MI builtins and C library function used to address user queues
** - here's a list of all available functions:
**
** C library functions:
** 'enq' Enqueue
** 'deq' Dequeue
** 'deqi' Dequeue with indicator
** 'matqmsg' Materialize queue messages
** 'matqat' Materialize queue attributes
**
** MI builtins:
** '_ENQ' Enqueue
** '_DEQ' Dequeue
** '_DEQWAIT' Dequeue with wait
** '_MATQMSG' Materialize queue messages
** '_MATQAT' Materialize queue attributes
**
**
** Programmer's notes:
** Functionally user queues are very much the same as data queues: They
** provide asynchronous communication between programs, and the stored
** messages can be retrieved by arrival sequence or key.
**
** The major advantage of user queues over data queues is speed; they are
** faster than data queues. On the other hand user queues are a bit more
** complicated to put into action; you need to resolve a system pointer
** to the user queue to be able to call the various user queue functions
** and for example get acqainted with such constructs as bit-fields that
** enables you to reference single bits at field level.
**
** This program offers a number of examples of some - but not all - of
** the user queue functions, for you to use as a starting point in the
** event that you should want to include user queues in your tool box.
** You can find more information in the MI Functional Reference and the
** ILE C/C++ for iSeries Run-Time Library Functions manuals.
**
** To run this sample program compile it as described below, start a
** debug session, call it, and then step throug the program in the
** debugger:
**
** StrDbg Pgm( CBX1150 ) - Press F10
**
** Call Pgm( CBX1150 ) - Press F10 repeatedly
**
**
** Compile options:
** First, create the CBX115S service program. (Instructions can be
** found in the CBX115S source member.)
**
** CrtRpgMod Module( CBX1150 ) DbgView( *LIST )
**
** CrtPgm Pgm( CBX1150 )
** Module( CBX1150 )
** ActGrp( QILE )
** BndSrvPgm( CBX115S )
**
**
**-- Header specifications: --------------------------------------------**
H Option( *SrcStmt ) BndDir( 'QC2LE' )
**-- API Error Data Structure: -----------------------------------------**
D ApiError Ds
D AeBytPro 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0 Inz
D 1a
D AeExcpId 7a
D AeExcpDta 256a
**-- Global variables: -------------------------------------------------**
D UsrQuePtrF s * ProcPtr
D UsrQuePtrK s * ProcPtr
D MsgDeq s 10i 0
**
D EnqMsg s 1024a
D DeqMsg s 1024a
**-- Global constants: -------------------------------------------------**
D DeqGt c x'02'
D DeqLt c x'04'
D DeqNe c x'06'
D DeqEq c x'08'
D DeqGe c x'0A'
D DeqLe c x'0C'
**
D TimeDeqGt c x'02'
D TimeDeqLt c x'04'
D TimeDeqNe c x'06'
D TimeDeqEq c x'08'
D TimeDeqGe c x'0A'
D TimeDeqLe c x'0C'
**
D WaitDeq c x'10'
D WaitDeqGt c x'12'
D WaitDeqLt c x'14'
D WaitDeqNe c x'16'
D WaitDeqEq c x'18'
D WaitDeqGe c x'1A'
D WaitDeqLe c x'1C'
**-- Enqueue message prefix: -------------------------------------------**
D EnqMsgPfx Ds
D EpMsgLen 10i 0
D EpEnqKey 3a
**-- Dequeue message prefix: -------------------------------------------**
D DeqMsgPfx Ds
D DpTimStp 8a
D DqWaitTim 8a
D DqMsgLen 10i 0 Inz
D DqOption 1a
** DqAccSt1: 1; Bit weight 8
** DqAccSt2: 1; - - 4
** DqMPL : 1; - - 2
** DqWait4e: 1; - - 1
** DqKeyRel: 4; - - 8-1
D DqKey 3a
D DqKeyRtn Like( DqKey )
**-- Queue attributes: -------------------------------------------------**
D QueAtr Ds
1 D QaBytPrv 10i 0 Inz( %Size( QueAtr ))
D QaBytAvl 10i 0
9 D QaObjId 32a
D QaObjTyp 1a Overlay( QaObjId: 1 )
D QaObjSub 1a Overlay( QaObjId: *Next )
D QaObjNam 30a Overlay( QaObjId: *Next )
41 D QaCrtOptBf 4a
45 D 4a
49 D QaSpcSiz 10i 0
53 D QaSpcInzVal 1a
54 D QaPfrClsBf 4a
58 D 7a
65 D QaCtx * ProcPtr
81 D QaAccGrp * ProcPtr
97 D QaQueAtrBf 1a
98 D QaCurMaxMsg 10i 0
102 D QaCurMsgEnq 10i 0
106 D QaExtVal 10i 0
110 D QaKeyLen 5i 0
112 D QaMaxSizMsg 10i 0
116 D 1a
117 D QaMaxNbrExt 10i 0
121 D QaCurNbrExt 10i 0
125 D QaInzNbrMsg 10i 0
**-- Enqueue message: --------------------------------------------------**
D enqMI Pr ExtProc( '_ENQ' )
D QuePtr * ProcPtr
D MsgPfx 256a Options( *VarSize )
D MsgTxt 32767a Options( *VarSize )
**-- Dequeue message with wait: ----------------------------------------**
D deqwait Pr ExtProc( '_DEQWAIT' )
D MsgPfx 256a Options( *VarSize )
D MsgTxt 32767a Options( *VarSize )
D QuePtr * ProcPtr
129 **-- Enqueue message: --------------------------------------------------**
D enq Pr ExtProc( 'enq' )
D QuePtr * ProcPtr Value
D MsgPfx 256a Const Options( *VarSize )
D MsgTxt 32767a Const Options( *VarSize )
**-- Dequeue message: --------------------------------------------------**
D deq Pr ExtProc( 'deq' )
D MsgPfx 256a Options( *VarSize )
D MsgTxt 32767a Options( *VarSize )
D QuePtr * ProcPtr Value
**-- Dequeue message with indicator: -----------------------------------**
D deqi Pr 10i 0 ExtProc( 'deqi' )
D MsgPfx 296a Options( *VarSize )
D MsgTxt 32767a Options( *VarSize )
D QuePtr * ProcPtr Value
**-- Materialize queue attributes: -------------------------------------**
D matqat Pr ExtProc( 'matqat' )
D RcvAtr 128a
D QuePtr * ProcPtr Value
**-- Wait seconds: -----------------------------------------------------**
D sleep Pr 10i 0 ExtProc( 'sleep' )
D seconds 10u 0 Value
**-- Wait microseconds: ------------------------------------------------**
D usleep Pr 10i 0 ExtProc( 'usleep' )
D useconds 10u 0 Value
**-- Create user queue: ------------------------------------------------**
D CrtUsrQ Pr ExtPgm( 'QUSCRTUQ' )
D CuUsrQqual 20a Const
D CuExtAtr 10a Const
D CuQueTyp 1a Const
D CuKeyLen 10i 0 Const
D CuMaxMsgSiz 10i 0 Const
D CuInzNbrMsg 10i 0 Const
D CuAddNbrMsg 10i 0 Const
D CuPubAut 10a Const
D CuTxtDsc 50a Const
**
D CuRplQue 10a Const Options( *NoPass )
D CuError 32767a Options( *NoPass: *VarSize )
**
D CuQueDmn 10a Const Options( *NoPass )
D CuAlwPtr 10a Const Options( *NoPass )
**
D CuNbqExt 10i 0 Const Options( *NoPass )
D CuRclStg 1a Const Options( *NoPass )
**-- Get current number of queue entries: ------------------------------**
D GetCurNbrE Pr 10i 0
D PxQuePtr * ProcPtr
**-- Get system pointer: -----------------------------------------------**
D GetSysPtr Pr * ProcPtr
D PxObjNam 10a Const
D PxObjLib 10a Const
D PxObjTyp 10a Const
**-- Get MI time value: ------------------------------------------------**
D GetTimVal Pr 8a
D PxSeconds 10u 0 Const
**
**-- Mainline: ---------------------------------------------------------**
**
C CallP CrtUsrQ( 'USRQ QTEMP'
C : 'TESTUSRQ'
C : 'F'
C : *Zero
C : 1024
C : 256
C : 128
C : '*ALL'
C : 'Test user queue'
C : '*YES'
C : ApiError
C : '*USER'
C : '*NO'
C )
**
C CallP CrtUsrQ( 'USRQKEY QTEMP'
C : 'TESTUSRQ'
C : 'K'
C : 3
C : 1024
C : 256
C : 128
C : '*ALL'
C : 'Test user queue - key'
C : '*YES'
C : ApiError
C : '*USER'
C : '*NO'
C )
**
C Eval UsrQuePtrF = GetSysPtr( 'USRQ'
C : 'QTEMP'
C : '*USRQ'
C )
**
C If UsrQuePtrF <> *Null
**
C Eval UsrQuePtrK = GetSysPtr( 'USRQKEY'
C : 'QTEMP'
C : '*USRQ'
C )
**
C If UsrQuePtrK <> *Null
**
C ExSr TstEnqNoKey
C ExSr TstDeqNoKey
**
C ExSr TstEnqKey
C ExSr TstDeqKey
**
C ExSr TstEnqMiKey
C ExSr TstDeqKey
**
C ExSr TstEnqMiKey
C ExSr TstDeqiKey
**
C ExSr TstEnqKey
C ExSr TstDeqwKey
**
C EndIf
C EndIf
**
C Eval *InLr = *On
C Return
**
**-- Test enq no key: --------------------------------------------------**
C TstEnqNoKey BegSr
**
C Eval EnqMsg = 'Test FIFO message 1'
C Eval EpMsgLen = %Len( %TrimR( EnqMsg ))
**
C CallP enq( UsrQuePtrF: EnqMsgPfx: EnqMsg )
**
C EndSr
**-- Test enq key: -----------------------------------------------------**
C TstEnqKey BegSr
**
C Eval EnqMsg = 'Test key message 1'
C Eval EpEnqKey = 'KEY'
C Eval EpMsgLen = %Len( %TrimR( EnqMsg ))
**
C CallP enq( UsrQuePtrK: EnqMsgPfx: EnqMsg )
**
C EndSr
**-- Test enqMI key: ---------------------------------------------------**
C TstEnqMiKey BegSr
**
C Eval EnqMsg = 'Test key message 2'
C Eval EpEnqKey = 'KEY'
C Eval EpMsgLen = %Len( %TrimR( EnqMsg ))
**
C CallP enqMI( UsrQuePtrK: EnqMsgPfx: EnqMsg )
**
C EndSr
**-- Test deq no key: --------------------------------------------------**
C TstDeqNoKey BegSr
**
C Eval DqKey = *Blanks
C Eval DqOption = WaitDeq
**
C DoW GetCurNbrE( UsrQuePtrF ) > *Zero
**
C CallP(e) deq( DeqMsgPfx: DeqMsg: UsrQuePtrF )
**
C If Not %Error
C ExSr PrcUsrQe
C EndIf
**
C EndDo
**
C EndSr
**-- Test deq key: -----------------------------------------------------**
C TstDeqKey BegSr
**
C Eval DqKey = 'KEY'
C Eval DqOption = TimeDeqEq
C Eval DqWaitTim = GetTimVal( 5 )
**
C Do 3
**
C CallP(e) deq( DeqMsgPfx: DeqMsg: UsrQuePtrK )
**
C If Not %Error
C ExSr PrcUsrQe
**
C Else
C CallP usleep( 500000 )
C EndIf
**
C EndDo
**
C EndSr
**-- Test deqi key: ----------------------------------------------------**
C TstDeqiKey BegSr
**
C Eval DqOption = TimeDeqEq
C Eval DqKey = 'KEY'
**
C DoW GetCurNbrE( UsrQuePtrK ) > *Zero
**
C Eval MsgDeq = deqi( DeqMsgPfx
C : DeqMsg
C : UsrQuePtrK
C )
**
C If MsgDeq = 1
C ExSr PrcUsrQe
C EndIf
**
C CallP sleep( 1 )
C EndDo
**
C EndSr
**-- Test deqwait key: -------------------------------------------------**
C TstDeqwKey BegSr
**
C Eval DqKey = 'KEY'
C Eval DqOption = TimeDeqEq
C Eval DqWaitTim = GetTimVal( 7 )
**
C DoW GetCurNbrE( UsrQuePtrK ) > *Zero
**
C CallP(e) deqwait( DeqMsgPfx: DeqMsg: UsrQuePtrK )
**
C If Not %Error
C ExSr PrcUsrQe
C EndIf
**
C EndDo
**
C EndSr
**-- Process user queue entry: -----------------------------------------**
C PrcUsrQe BegSr
**
C Eval DeqMsg = %Subst( DeqMsg: 1: DqMsgLen )
**
C EndSr
**-- Get current number of queue entries: ------------------------------**
P GetCurNbrE B
D Pi 10i 0
D PxQuePtr * ProcPtr
**
C If PxQuePtr = *Null
C Return -1
C Else
**
C CallP(e) matqat( QueAtr: PxQuePtr )
**
C If %Error
C Return -1
**
C Else
C Return QaCurMsgEnq
C EndIf
C EndIf
**
P GetCurNbrE E
** Program . . : CBX1151
** Description : Test user queues - server function
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : February 19, 2004
**
**
** Program summary
** ---------------
**
** MI builtins:
** _ENQ Enqueue message Puts a message to the user queue
** specified. An optional key used
** at message retrieval time can be
** specified.
**
** The actual user queue is defined
** by a system pointer.
**
** _DEQWAIT Dequeue message Gets a message from the specified
** with wait user queue. The retrieval order
** is defined at queue creation time
** and includes first-in-first-out,
** last-in-first-out and by-key.
**
** The wait time is specified in the
** dequeue message prefix parameter.
** If a time-out occurs the builtin
** returns an exception to the
** calling program.
**
** The actual user queue is defined
** by a system pointer.
**
** C library function:
** cvthc Convert hex to Converts a character string to
** character its hexadecimal representation
** in the form of 4-bit sequences
** also known as nibbles.
**
**
** Sequence of events:
** 1. The put and get user queue names as well as the library they are
** located in are received as input paramters and a system pointer
** to each is resolved.
**
** 2. Being a server function the program then waits indefinetely for
** client requests to be received from the get user queue. To ensure
** that the right client receives the reply, a unique key is included
** in the request message structure. Also included is a request type
** defining the type of action to be performed by the server.
**
** 3. Once a request is received it is processed based on the request
** type. Two request types are supported.
**
** *CVTHEX will convert the received message string to its
** hexadecimal representation and put the converted string
** to the reply user queue and the retreived key from the
** request message structure is supplied as retrieval key.
**
** *STOP will end the server job immediately.
**
** 4. When a reply has been returned, the server will continue waiting
** indefinetely for the next request to arrive.
**
** 5. If the server job has been requested to stop processing, the
** wait loop is exited and the job is ended normally.
**
**
** Compile options:
** First, create the CBX115S service program. (Instructions can be
** found in the CBX115S source member.)
**
** CrtRpgMod Module( CBX1151 ) DbgView( *LIST )
**
** CrtPgm Pgm( CBX1151 )
** Module( CBX1151 )
** ActGrp( QILE )
** BndSrvPgm( CBX115S )
**
**
**-- Header specifications: --------------------------------------------**
H Option( *SrcStmt ) BndDir( 'QC2LE' )
**-- Global variables: -------------------------------------------------**
D RqsQuePtr s * ProcPtr
D RpyQuePtr s * ProcPtr
D RqsHdrSiz s 10i 0
**
D EnqMsg s 1024a
**
D DeqMsg Ds
D DmRpyKey 16a
D DmRqsTyp 8a
D DmRqsMsg 1000a
**-- Global constants: -------------------------------------------------**
D WaitDeq c x'10'
**-- Enqueue message prefix: -------------------------------------------**
D EnqMsgPfx Ds
D EqMsgLen 10i 0
D EqEnqKey 16a
**-- Dequeue message prefix: -------------------------------------------**
D DeqMsgPfx Ds
D DqTimStp 8a
D DqWaitTim 8a
D DqMsgLen 10i 0 Inz
D DqOption 1a
** DqAccSt1: 1; Bit weight 8
** DqAccSt2: 1; - - 4
** DqMPL : 1; - - 2
** DqWait4e: 1; - - 1
** DqKeyRel: 4; - - 8-1
D DqKey 16a
**-- Enqueue message: --------------------------------------------------**
D enq Pr ExtProc( '_ENQ' )
D QuePtr * ProcPtr
D MsgPfx 256a Options( *VarSize )
D MsgTxt 32767a Options( *VarSize )
**-- Dequeue message with wait: ----------------------------------------**
D deqwait Pr ExtProc( '_DEQWAIT' )
D MsgPfx 256a Options( *VarSize )
D MsgTxt 32767a Options( *VarSize )
D QuePtr * ProcPtr
**-- Convert hex to character: -----------------------------------------**
D cvthc Pr * ExtProc( 'cvthc' )
D * Value
D * Value
D 10I 0 Value
**-- Get system pointer: -----------------------------------------------**
D GetSysPtr Pr * ProcPtr
D PxObjNam 10a Const
D PxObjLib 10a Const
D PxObjTyp 10a Const
**-- Parameters: -------------------------------------------------------**
D PxRqsQueNam s 10a
D PxRpyQueNam s 10a
D PxQueLib s 10a
**
C *Entry Plist
C Parm PxRqsQueNam
C Parm PxRpyQueNam
C Parm PxQueLib
**
**-- Mainline: ---------------------------------------------------------**
**
C Eval RqsQuePtr = GetSysPtr( PxRqsQueNam
C : PxQueLib
C : '*USRQ'
C )
**
C If RqsQuePtr <> *Null
**
C Eval RpyQuePtr = GetSysPtr( PxRpyQueNam
C : PxQueLib
C : '*USRQ'
C )
**
C If RpyQuePtr <> *Null
**
C DoU *InLr = *On
**
C ExSr DeqRqsMsg
**
C If *InLr = *Off
C ExSr PrcRqsMsg
C ExSr EnqRpyMsg
C EndIf
**
C EndDo
**
C EndIf
C EndIf
**
C Return
**
**-- Dequeue request message: ------------------------------------------**
C DeqRqsMsg BegSr
**
C Eval DqKey = *Blanks
C Eval DqOption = WaitDeq
**
C CallP(e) deqwait( DeqMsgPfx: DeqMsg: RqsQuePtr )
**
C If Not %Error
C Eval DeqMsg = %Subst( DeqMsg: 1: DqMsgLen )
C Eval EnqMsg = *Blanks
**
C If DmRqsTyp = '*STOP '
C Eval *InLr = *On
C EndIf
C EndIf
**
C EndSr
**-- Enqueue reply message: --------------------------------------------**
C EnqRpyMsg BegSr
**
C Eval EqEnqKey = DmRpyKey
C Eval EqMsgLen = %Len( %TrimR( EnqMsg ))
**
C CallP enq( RpyQuePtr: EnqMsgPfx: EnqMsg )
**
C EndSr
**-- Process request message: ------------------------------------------**
C PrcRqsMsg BegSr
**
C If DmRqsTyp = '*CVTHEX'
**
C CallP cvthc( %Addr( EnqMsg )
C : %Addr( DmRqsMsg )
C : 2 * ( DqMsgLen - RqsHdrSiz )
C )
**
C EndIf
**
C EndSr
**-- Initial processing: -----------------------------------------------**
C *InzSr BegSr
**
C Eval RqsHdrSiz = %Size( DmRpyKey ) +
C %Size( DmRqsTyp )
**
C EndSr
** Program . . : CBX1152
** Description : Test user queues - client function
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : February 19, 2004
**
**
** Program summary
** ---------------
**
** MI builtins:
** _ENQ Enqueue message Puts a message to the user queue
** specified. An optional key used
** at message retrieval time can be
** specified.
**
** The actual user queue is defined
** by a system pointer.
**
** _DEQWAIT Dequeue message Gets a message from the specified
** with wait user queue. The retrieval order
** is defined at queue creation time
** and includes first-in-first-out,
** last-in-first-out and by-key.
**
** The wait time is specified in the
** dequeue message prefix parameter.
** If a time-out occurs the builtin
** returns an exception to the
** calling program.
**
** The actual user queue is defined
** by a system pointer.
**
** _GENUUID Generate universal Returns a 16 byte token that is
** unique identifier guaranteed to be unique across
** all time and space - or as its
** name says, universally unique.
**
** User interface manager APIs:
** QUILNGTX Display long text Displays the text string passed
** to the API in a pop-up window.
** Optionally a panel title can be
** retrieved from a message file.
**
** Maximum string length is 15360k.
**
** Message handling API:
** QMHSNDPM Send program message Sends a message to a program stack
** entry (current, previous, etc.) or
** an external message queue.
**
** Both messages defined in a message
** file and immediate messages can be
** used. For specific message types
** only one or the other is allowed.
**
** QMHRCVPM Receive program Returns information describing
** message the selected message in a call
** message queue or, as in this
** case, an external message queue.
**
**
** Sequence of events:
** 1. The put and get user queue names as well as the library they are
** located in are received as input paramters and a system pointer
** to each is resolved.
**
** 2. An inquiry message is sent to the external message queue, waiting
** for an input string to process. Upon receiving an actual reply,
** a unique key is generated to be included with the request message
** to ensure correct retrieval of the corresponding reply, and the
** request message is put to the request user queue.
**
** 3. Next the dequeue parameters are set, a time-out value of 5 seconds
** and the retrieval key that the reply was associated with in step 2.
** If a time-out occurs an informational message is displayed in a
** window, otherwise the result of the hexadecimal conversion of the
** input string is displayed.
**
** 4. If an empty reply is received in step 2 a 'terminate processing'
** message is sent to the server job and this program returns control
** to its caller, to delete the user queues involved and end the test
** application.
**
**
** Programmer's notes:
** User reports have surfaced, indicating that the GENUUID function
** - under certain circumstances - might have a problem generating a
** truly unique identifier on multi-processor iSeries machines.
**
** But apparently this has not yet lead to the opening of an APAR so
** there is currently no conclusive information available on this
** matter.
**
** The message dialogue developed for the purpose of this user queue
** test application is by no means adequate for a genuine production
** environment.
**
** In real life it is crucial to invest the time necessary to develop
** a robust and flexible data protocol up front, covering some of the
** following aspects:
**
** - Request and reply message indentification
** - Message version identification
** - Error code and message reporting
** - Message definition design (proprietary or standard)
** - Expanding list support (to avoid message length constraints)
** - National language support
** - Normalization level of message record formats
**
** And when dealing with some of the above questions it is in many
** cases worth considering to what extent XML would offer a useful
** solution.
**
**
** Compile options:
** First, create the CBX115S service program. (Instructions can be
** found in the CBX115S source member.)
**
** CrtRpgMod Module( CBX1152 ) DbgView( *LIST )
**
** CrtPgm Pgm( CBX1152 )
** Module( CBX1152 )
** ActGrp( QILE )
** BndSrvPgm( CBX115S )
**
**
**-- Header specifications: --------------------------------------------**
H Option( *SrcStmt ) BndDir( 'QC2LE' )
**-- API error data structure: -----------------------------------------**
D ApiError Ds
D AeBytPrv 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0
D AeExcpId 7a
D 1a
D AeExcpDta 128a
**-- Global variables: -------------------------------------------------**
D RqsQuePtr s * ProcPtr
D RpyQuePtr s * ProcPtr
D MsgKey s 4a
D MsgDta s 1024a Varying
**
D DeqMsg s 1024a
**
D EnqMsg Ds
D EmRpyKey 16a
D EmRqsTyp 8a
D EmRqsMsg 1000a
**-- Global constants: -------------------------------------------------**
D TimeDeqEq c x'08'
**-- Enqueue message prefix: -------------------------------------------**
D EnqMsgPfx Ds
D EqMsgLen 10i 0
D EqEnqKey 16a
**-- Dequeue message prefix: -------------------------------------------**
D DeqMsgPfx Ds
D DqTimStp 8a
D DqWaitTim 8a
D DqMsgLen 10i 0 Inz
D DqOption 1a
** DqAccSt1: 1; Bit weight 8
** DqAccSt2: 1; - - 4
** DqMPL : 1; - - 2
** DqWait4e: 1; - - 1
** DqKeyRel: 4; - - 8-1
D DqKey 16a
**-- UUID template: ----------------------------------------------------**
D UUID_template Ds
D UtBytPrv 10u 0 Inz( %Size( UUID_template ))
D UtBytAvl 10u 0
D 8a Inz( *Allx'00' )
D UUID 16a
**-- Message information structure: ------------------------------------**
D RCVM0100 Ds
D R1BytPrv 10i 0
D R1BytAvl 10i 0
D R1MsgSev 10i 0
D R1MsgId 7a
D R1MsgTyp 2a
D R1MsgKey 4a
D 7a
D R1CcsIdCnvSts 10i 0
D R1CcsIdDta 10i 0
D R1MsgLen 10i 0
D R1MsgLenAvl 10i 0
D R1MsgRpy 1024a
**-- Enqueue: ----------------------------------------------------------**
D enq Pr ExtProc( '_ENQ' )
D QuePtr * ProcPtr
D MsgPfx 256a Options( *VarSize )
D MsgTxt 32767a Options( *VarSize )
**-- Dequeue with wait: ------------------------------------------------**
D deqwait Pr ExtProc( '_DEQWAIT' )
D MsgPfx 256a Options( *VarSize )
D MsgTxt 32767a Options( *VarSize )
D QuePtr * ProcPtr
**-- Generate universal unique identifier: -------------------------- --**
D GenUuid Pr ExtProc( '_GENUUID' )
D UUID_template * Value
**-- Send program message: ---------------------------------------------**
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D SpMsgId 7a Const
D SpMsgFq 20a Const
D SpMsgDta 512a Const Options( *VarSize )
D SpMsgDtaLen 10i 0 Const
D SpMsgTyp 10a Const
D SpCalStkE 10a Const Options( *VarSize )
D SpCalStkCtr 10i 0 Const
D SpMsgKey 4a
D SpError 512a Options( *VarSize )
**
D SpCalStkElen 10i 0 Const Options( *NoPass )
D SpCalStkEq 20a Const Options( *NoPass )
D SpDspWait 10i 0 Const Options( *NoPass )
**
D SpCalStkEtyp 20a Const Options( *NoPass )
D SpCcsId 10i 0 Const Options( *NoPass )
**-- Receive program message: ------------------------------------------**
D RcvPgmMsg Pr ExtPgm( 'QMHRCVPM' )
D RpRcvVar 32767a Options( *VarSize )
D RpRcvVarLen 10i 0 Const
D RpFmtNam 10a Const
D RpCalStkE 256a Const Options( *VarSize )
D RpCalStkCtr 10i 0 Const
D RpMsgTyp 10a Const
D RpMsgKey 4a Const
D RpWait 10i 0 Const
D RpMsgAct 10a Const
D RpError 32767a Options( *VarSize )
**
D RpCalStkElen 10i 0 Const Options( *NoPass )
D RpCalStkEq 20a Const Options( *NoPass )
**
D RpCalStkEtyp 20a Const Options( *NoPass )
D RpCcsId 10i 0 Const Options( *NoPass )
**-- Display long text: ------------------------------------------------**
D DspLngTxt Pr ExtPgm( 'QUILNGTX' )
D DtLngTxt 1024a Const Options( *VarSize )
D DtLngTxtLen 10i 0 Const
D DtMsgId 7a Const
D DtMsgF 20a Const
D DtError 10i 0 Const
**-- Get system pointer: -----------------------------------------------**
D GetSysPtr Pr * ProcPtr
D PxObjNam 10a Const
D PxObjLib 10a Const
D PxObjTyp 10a Const
**-- Get MI time value: ------------------------------------------------**
D GetTimVal Pr 8a
D PxSec 10u 0 Const
**-- Parameters: -------------------------------------------------------**
D PxRqsQueNam s 10a
D PxRpyQueNam s 10a
D PxQueLib s 10a
**
C *Entry Plist
C Parm PxRqsQueNam
C Parm PxRpyQueNam
C Parm PxQueLib
**
**-- Mainline: ---------------------------------------------------------**
**
C Eval RqsQuePtr = GetSysPtr( PxRqsQueNam
C : PxQueLib
C : '*USRQ'
C )
**
C If RqsQuePtr <> *Null
**
C Eval RpyQuePtr = GetSysPtr( PxRpyQueNam
C : PxQueLib
C : '*USRQ'
C )
**
C If RpyQuePtr <> *Null
**
C DoU *InLr = *On
**
C ExSr GetRqsMsg
C ExSr EnqRqsMsg
**
C If *InLr = *Off
C ExSr DeqRpyMsg
C EndIf
**
C EndDo
**
C EndIf
C EndIf
**
C Return
**
**-- Enqueue request message: ------------------------------------------**
C EnqRqsMsg BegSr
**
C Callp GenUuid( %Addr( UUID_template ))
**
C Eval EqEnqKey = *Blanks
C Eval EmRpyKey = UUID
C Eval EqMsgLen = %Len( %TrimR( EnqMsg ))
**
C CallP enq( RqsQuePtr: EnqMsgPfx: EnqMsg )
**
C EndSr
**-- Dequeue reply message: --------------------------------------------**
C DeqRpyMsg BegSr
**
C Eval DqKey = UUID
C Eval DqOption = TimeDeqEq
C Eval DqWaitTim = GetTimVal( 5 )
**
C CallP(e) deqwait( DeqMsgPfx: DeqMsg: RpyQuePtr )
**
C If %Error
C Exsr HdlRpyTmo
**
C Else
C Exsr DspRpyMsg
C EndIf
**
C EndSr
**-- Handle reply timeout: ---------------------------------------------**
C HdlRpyTmo BegSr
**
C Eval MsgKey = *Blanks
**
C CallP RcvPgmMsg( RCVM0100
C : %Size( RCVM0100 )
C : 'RCVM0100'
C : '*'
C : *Zero
C : '*LAST'
C : MsgKey
C : -1
C : '*REMOVE'
C : ApiError
C )
**
C Eval MsgDta = 'The get user queue ' +
C 'message timed out. ' +
C 'Please check that the ' +
C 'server job is active.'
**
C CallP(e) DspLngTxt( MsgDta
C : %Len( MsgDta )
C : *Blanks
C : *Blanks
C : *Zero
C )
**
C EndSr
**-- Display reply message: --------------------------------------------**
C DspRpyMsg BegSr
**
C Eval MsgDta = %TrimR( EmRqsMsg ) + ' -> ' +
C %SubSt( DeqMsg: 1: DqMsgLen )
**
C CallP(e) DspLngTxt( MsgDta
C : %Len( MsgDta )
C : *Blanks
C : *Blanks
C : *Zero
C )
**
C EndSr
**-- Get request message: ----------------------------------------------**
C GetRqsMsg BegSr
**
C Eval MsgDta = 'Please enter string ' +
C 'to be converted to ' +
C 'hex. To stop test just ' +
C 'press enter.'
**
C CallP SndPgmMsg( *Blanks
C : *Blanks
C : MsgDta
C : %Len( MsgDta )
C : '*INQ'
C : '*EXT'
C : *Zero
C : MsgKey
C : ApiError
C )
**
C CallP RcvPgmMsg( RCVM0100
C : %Size( RCVM0100 )
C : 'RCVM0100'
C : '*'
C : *Zero
C : '*RPY'
C : MsgKey
C : -1
C : '*OLD'
C : ApiError
C )
**
C Eval R1MsgRpy = %Subst( R1MsgRpy: 1: R1MsgLen )
**
C If R1MsgRpy = '*N'
C Eval EmRqsTyp = '*STOP'
C Eval *InLr = *On
**
C Else
C Eval EmRqsTyp = '*CVTHEX'
C Eval EmRqsMsg = R1MsgRpy
C EndIf
**
C EndSr
** Program . . : CBX115S
** Description : Test user queues - service functions
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : February 19, 2004
**
**
** Program summary
** ---------------
**
** Object-related API:
** QLICVTTP Convert object type Convert an iSeries object type to
** or from hexadecimal format.
**
** C library function:
** rslvsp Resolve system Creates a system pointer to the
** pointer object specified by the input
** parameters. Only a system state
** program is allowed to generate
** an authorized system pointer.
**
** mitime Create an _MI_Time Creates an _MI_Time value from
** value the individual time durations
** specified.
**
** Service program procedures:
** GetSysPtr Get system pointer Based on object name, library and
** object type a system pointer to
** the object is generated and
** returned to the caller.
**
** GetTimVal Get MI time value Generates an MI time value from
** the specified number of seconds.
**
** Programmer's notes:
** RPG/IV has no explicit support of system pointers - but defining an
** uninitialized procedure pointer will make the RPG compiler create
** an open pointer, capable of storing any type of iSeries pointer.
**
** Though not very likely - due to the many production programs already
** exploiting this feature - it is possible that a future introduction
** of true system pointer support to RPG/IV might disable this "hidden"
** system pointer support.
**
** If used in production programs, you should therefore document the
** use of this feature very carefully to ensure that you can take the
** appropriate evasive actions if necessary.
**
**
** Compile options required:
** CrtRpgMod CBX115S
**
** CrtSrvPgm CBX115S +
** Module( CBX115S ) +
** Export( *ALL ) +
** ActGrp( *CALLER )
**
**
**-- Header specifications: --------------------------------------------**
H NoMain BndDir( 'QC2LE' )
**-- API Error Data Structure: -----------------------------------------**
D ApiError Ds
D AeBytPro 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0 Inz
D 1a
D AeExcpId 7a
D AeExcpDta 256a
**-- Convert object type to hex: ---------------------------------------**
D CvtObjTyp Pr ExtPgm( 'QLICVTTP' )
D CtCnvOpt 10a Const
D CtObjSym 10a Const
D CtObjHex 2a
D CtError 32767a Options( *VarSize )
**-- Get system pointer: -----------------------------------------------**
D GetSysPtr Pr * ProcPtr
D PxObjNam 10a Const
D PxObjLib 10a Const
D PxObjTyp 10a Const
**-- Get MI time value: ------------------------------------------------**
D GetTimVal Pr 8a
D PxSec 10u 0 Const
**-- Check object existence: -------------------------------------------**
D ObjExist Pr n
D PxObjNam 10a Const
D PxObjLib 10a Const
D PxObjTyp 10a Const
**-- Resolve system pointer: -------------------------------------------**
D rslvsp Pr * ProcPtr ExtProc( 'rslvsp' )
D PxObjTyp 2a Value
D PxObjNam * Value Options( *String )
D PxObjLib * Value Options( *String )
D PxAutReq 2a Value
**-- mitime - create an _MI_Time value from components: ----------------**
D mitime Pr ExtProc( 'mitime' )
D PxDelay 8a
D PxHours 10u 0 Value
D PxMin 10u 0 Value
D PxSec 10u 0 Value
D PxMs 10u 0 Value
**-- Get system pointer: -----------------------------------------------**
P GetSysPtr B Export
D Pi * ProcPtr
D PxObjNam 10a Const
D PxObjLib 10a Const
D PxObjTyp 10a Const
**-- Local variables:
D SysPtr s * ProcPtr
D ObjTypHex s 2a
**
C If ObjExist( PxObjNam: PxObjLib: PxObjTyp )
**
C Callp CvtObjTyp( '*SYMTOHEX'
C : PxObjTyp
C : ObjTypHex
C : ApiError
C )
**
C If AeBytAvl = *Zero
**
C Eval SysPtr = rslvsp( ObjTypHex
C : PxObjNam
C : PxObjLib
C : x'0000'
C )
**
C EndIf
C EndIf
**
C Return SysPtr
**
P GetSysPtr E
**-- Get MI time value: ------------------------------------------------**
P GetTimVal B Export
D Pi 8a
D PxSec 10u 0 Const
**-- time parameter:
D PxDelay s 8a
**
C CallP mitime( PxDelay
C : 0
C : 0
C : PxSec
C : 0
C )
**
C Return PxDelay
**
P GetTimVal E
**-- Check object existence: -------------------------------------------**
P ObjExist B Export
D Pi n
D PxObjNam 10a Const
D PxObjLib 10a Const
D PxObjTyp 10a Const
**-- Retrieve object description:
D RoData Ds
D RoBytRtn 10i 0
D RoBytAvl 10i 0
D RoDtaLgt s 10i 0 Inz( %Size( RoData ))
D RoFmtNam s 8a Inz( 'OBJD0100' )
D RoObjQ s 20a
D RoObjTyp s 10a
**
C Eval RoObjQ = PxObjNam + PxObjLib
**
C Call 'QUSROBJD'
C Parm RoData
C Parm RoDtaLgt
C Parm RoFmtNam
C Parm RoObjQ
C Parm PxObjTyp RoObjTyp
C Parm ApiError
**
C Return ( AeBytAvl = *Zero )
**
P ObjExist E
/* Program . . : CBX115 */
/* Description : User queue example */
/* Author . . : Carsten Flensburg */
/* Published . : Club Tech iSeries Programming Tips Newsletter */
/* Date . . . : February 19, 2004 */
/* */
/* Program function: Initialize, run and clean up user queue */
/* example. */
/* */
/* Programmer's notes: */
/* Submit of the server job should occur through a job queue */
/* ensuring immediate activation of the server job, otherwise */
/* the user queue driven dialogue between the server and client */
/* jobs will not be possible. */
/* */
/* To run the user queue test application simply compile the */
/* involved objects as described in each source header and */
/* eventually call this program. */
/* */
/* Compile options: */
/* First, create the CRTUSRQ command from the January 29, 2004 */
/* issue of Club Tech iSeries Programming Tips Newsletter. */
/* CrtClPgm Pgm( CBX115 ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
Pgm
/*-- Global variables: ---------------------------------------------*/
Dcl &JobNbr *Char 10
Dcl &UsrQueNamF *Char 10 'USQF'
Dcl &UsrQueNamK *Char 10 'USQK'
Dcl &UsrQueLib *Char 10
/*-- Global error monitoring: --------------------------------------*/
MonMsg CPF0000 *N GoTo Error
/*-- Mainline -------------------------------------------------------*/
RtvJobA Nbr( &JobNbr ) CurLib( &UsrQueLib )
ChgVar &UsrQueNamF ( &UsrQueNamF *Tcat &JobNbr )
ChgVar &UsrQueNamK ( &UsrQueNamK *Tcat &JobNbr )
If ( &UsrQueLib = '*NONE' ) ChgVar &UsrQueLib 'QGPL'
DltUsrQ UsrQ( &UsrQueLib/&UsrQueNamF )
MonMsg CPF2105 *N RcvMsg MsgType( *EXCP ) Rmv( *YES )
DltUsrQ UsrQ( &UsrQueLib/&UsrQueNamK )
MonMsg CPF2105 *N RcvMsg MsgType( *EXCP ) Rmv( *YES )
CrtUsrQ UsrQ( &UsrQueLib/&UsrQueNamF ) +
ExtAtr( USRQFIFO ) +
MaxLen( 1024 ) +
Size( 256 ) +
IncrSize( 128 ) +
Text( 'User queue FIFO test' )
CrtUsrQ UsrQ( &UsrQueLib/&UsrQueNamK ) +
ExtAtr( USRQKEYED ) +
Seq( *KEYED ) +
KeyLen( 16 ) +
MaxLen( 1024 ) +
Size( 256 ) +
IncrSize( 128 ) +
Text( 'User queue keyed test' )
/*-- Submit server function: --*/
SbmJob Cmd( Call Pgm( CBX1151 ) +
Parm( &UsrQueNamF +
&UsrQueNamK +
&UsrQueLib +
)) +
Job( USRQSVR ) +
JobD( *USRPRF ) +
JobQ( *JOBD )
/*-- Run client function: --*/
Call CBX1152 Parm( &UsrQueNamF +
&UsrQueNamK +
&UsrQueLib +
)
SndPgmMsg MsgId( CPF9897 ) +
MsgF( QCPFMSG ) +
MsgDta( 'Terminating server job.' ) +
ToPgmQ( *EXT ) +
MsgType( *STATUS )
DlyJob 1
DltUsrQ UsrQ( &UsrQueLib/&UsrQueNamF )
DltUsrQ UsrQ( &UsrQueLib/&UsrQueNamK )
SndPgmMsg Msg( 'User queue test completed normally.' ) +
MsgType( *COMP )
Return:
Return
/*-- Error processor ------------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
Thanks to Carsten Flensburg and
Club Tech iSeries Programming Tips Newsletter
|