>>SOURCE FORMAT IS FIXED ****************************************************************** * Author: Brian Tiffin * Date: August 2008 * Purpose: Demonstration of OpenCOBOL message queues * Tectonics: gcc -c ocmq.c * cobc -Wall -x -lrt mqsample.cob ocmq.o ****************************************************************** identification division. program-id. mqsample. data division. working-storage section. * Constants for the Open Flags 01 MQO-RDONLY constant as 0. 01 MQO-WRONLY constant as 1. 01 MQO-RDWR constant as 2. 01 MQO-CREAT constant as 64. 01 MQO-EXCL constant as 128. 01 MQO-NONBLOCK constant as 2048. * Constants for the protection/permission bits 01 MQS-IREAD constant as 256. 01 MQS-IWRITE constant as 128. * Need a better way of displaying newlines 01 newline pic x value x'0a'. * Message Queues return an ID, maps to int 01 mqid usage binary-long. 01 mqres usage binary-long. * Queue names end up in an mqueue virtual filesystem on GNU/Linux 01 mqname. 02 name-display pic x(5) value "/ocmq". 02 filler pic x value x'00'. 01 mqopenflags usage binary-long. 01 mqpermissions usage binary-long. 01 default-message pic x(20) value 'OpenCOBOL is awesome'. 01 user-message pic x(80). 01 send-length usage binary-long. 01 urgent-message pic x(20) value 'Urgent OpenCOBOL msg'. * Data members for access to C global errno and error strings 01 errnumber usage binary-long. 01 errstr pic x(256). * legend to use with the error reporting 01 operation pic x(7). 01 loopy pic 9. * Debian GNU/Linux defaults to Message Queue entry limit of 8K 01 msgbuf pic x(8192). 01 msglen usage binary-long value 8192. * Priorities range from 0 to 31 on many systems, can be more 01 msgprio usage binary-long. * MQ attributes. See /usr/include/bits/mqueue.h 01 mqattr. 03 mqflags usage binary-long. 03 mqmaxmsg usage binary-long. 03 mqmsgsize usage binary-long. 03 mqcurmsqs usage binary-long. 03 filler usage binary-long occurs 4 times. 01 oldattr. 03 mqflags usage binary-long. 03 mqmaxmsg usage binary-long. 03 mqmsgsize usage binary-long. 03 mqcurmsqs usage binary-long. 03 filler usage binary-long occurs 4 times. procedure division. * The ocmq API support MQCREATE and MQOPEN. * This example uses non blocking, non exclusive create * read/write by owner and default attributes compute mqopenflags = MQO-RDWR + MQO-CREAT + MQO-NONBLOCK end-compute. compute mqpermissions = MQS-IREAD + MQS-IWRITE end-compute. * Sample shows the two types of open, but only evaluates create if zero = zero call "MQCREATE" using mqname by value mqopenflags by value mqpermissions by value 0 returning mqid end-call else call "MQOPEN" using mqname by value mqopenflags returning mqid end-call end-if. move "create" to operation. perform show-error. * Show the attributes after initial create perform show-attributes. * Register notification call "MQNOTIFY" using by value mqid mqname returning mqres end-call. move "notify" to operation. perform show-error. * Create a temporary queue, will be removed on close *call "MQUNLINK" using mqname * returning mqres *end-call. *move "unlink" to operation. *perform show-error. * Use the command line arguments or a default message accept user-message from command-line end-accept. if user-message equal spaces move default-message to user-message end-if. move function length (function trim(user-message trailing)) to send-length. * Queue up an urgent message (priority 31) call "MQSEND" using by value mqid by reference urgent-message by value 20 by value 31 end-call. move "send-31" to operation. perform show-error. * Queue up a low priority message (1) call "MQSEND" using by value mqid by reference user-message by value send-length by value 1 returning mqres end-call. move "send-1" to operation. perform show-error. * Queue up a middle priority message (16) inspect urgent-message replacing leading "Urgent" by "Middle". call "MQSEND" using by value mqid by reference urgent-message by value 20 by value 16 returning mqres end-call. move "send-16" to operation. perform show-error. * Redisplay the queue attributes perform show-attributes. * Pull highest priority message off queue call "MQRECEIVE" using by value mqid by reference msgbuf by value msglen by reference msgprio returning mqres end-call. display newline "recieve len: " mqres " prio: " msgprio end-display. if mqres > 0 display "priority 31 message: " msgbuf(1:mqres) end-display end-if. move "receive" to operation. perform show-error. * Pull the middling priority message off queue call "MQRECEIVE" using by value mqid by reference msgbuf by value msglen by reference msgprio returning mqres end-call. display newline "recieve len: " mqres " prio: " msgprio end-display. if mqres > 0 display "priority 16 message: " msgbuf(1:mqres) end-display end-if. move "receive" to operation. perform show-error. * ** INTENTIONAL ERROR msglen param too small ** * Pull message off queue call "MQRECEIVE" using by value mqid by reference msgbuf by value 1024 by reference msgprio returning mqres end-call. display newline "recieve len: " mqres " prio: " msgprio end-display. if mqres > 0 display "no message: " msgbuf(1:mqres) end-display end-if. move "receive" to operation. perform show-error. * Pull the low priority message off queue, in blocking mode move MQO-NONBLOCK to mqflags of mqattr. call "MQSETATTR" using by value mqid by reference mqattr by reference oldattr returning mqres end-call move "setattr" to operation. perform show-error. perform show-attributes. call "MQRECEIVE" using by value mqid by reference msgbuf by value msglen by reference msgprio returning mqres end-call. display newline "recieve len: " mqres " prio: " msgprio end-display. if mqres > 0 display "priority 1 message: " msgbuf(1:mqres) end-display end-if. move "receive" to operation. perform show-error. perform varying loopy from 1 by 1 until loopy > 5 display "Sleeper call " loopy end-display call "CBL_OC_NANOSLEEP" using 50000000000 returning mqres end-call end-perform. * Close the queue. As it is set unlinked, it will be removed call "MQCLOSE" using by value mqid returning mqres end-call. move "close" to operation. perform show-error. * Create a temporary queue, will be removed on close call "MQUNLINK" using mqname returning mqres end-call. move "unlink" to operation. perform show-error. goback. ****************************************************************** * Information display of the Message Queue attributes. show-attributes. call "MQGETATTR" using by value mqid by reference mqattr returning mqres end-call move "getattr" to operation. perform show-error. * Display the message queue attributes display name-display " attributes:" newline "flags: " mqflags of mqattr newline "max msg: " mqmaxmsg of mqattr newline "mqs size: " mqmsgsize of mqattr newline "cur msgs: " mqcurmsqs of mqattr end-display . * The C global errno error display paragraph show-error. call "ERRORNUMBER" returning mqres end-call if mqres > 0 display operation " errno: " mqres end-display call "ERRORSTRING" using errstr by value length errstr returning mqres end-call if mqres > 0 display " strerror: " errstr(1:mqres) end-display end-if end-if . end program mqsample. ****************************************************************** * Author: Brian Tiffin * Date: August 2008 * Purpose: Demonstration of OpenCOBOL message queue notification * Tectonics: gcc -c ocmq.c * cobc -Wall -x -lrt mqsample.cob ocmq.o ****************************************************************** identification division. program-id. MQSIGNAL. data division. working-storage section. 01 msgbuf pic x(8192). 01 msglen usage binary-long value 8192. 01 msgprio usage binary-long. 01 mqres usage binary-long. linkage section. 01 mqid usage binary-long. procedure division using mqid. display "in MQSIGNAL". display "In the COBOL procedure with " mqid end-display. perform with test after until mqres <= 0 * Pull highest priority message off queue call "MQRECEIVE" using by value mqid by reference msgbuf by value msglen by reference msgprio returning mqres end-call display "recieve len: " mqres " prio: " msgprio end-display if mqres > 0 display "priority 31 message: " msgbuf(1:mqres) end-display end-if * move "receive" to operation * perform show-error end-perform. goback. end program MQSIGNAL.