Function SET206B Conversation Manager
* =======================================================
* Process ........: SET_206
* Function .......: SET206B
* Created on .....: 11th September 2001
* Description ....: Conversation Manager
* Version.........: 1
*
* Full Description: This function is the controller for
* all of the chat sessions. It creates and allocates the
* data queues for each user, takes information from the
* general queue and then broadcasts it to all of the
* users. It is started by the remote procedure when the
* first chat session is opened.
*
* Disclaimer: The following material is supplied as
* example material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* *******************************************************
* Input/Output Parameters
*
* This function is intended to be a generic communication
* controller. Messages are received from the S_206TALKQ
* and sent to the user queues in a standard form.
*
* Each entry received from data queue is 256 characters
* in length. The entries are subdivided as follows:
*
* Length Field Description
* 2 Alpha S_206CMD This field holds a command
* to the controller
* 1 Alpha S_206TYPE This field indicates whether
* the message is to be
* broadcast or sent to an
* individual queue (B or I)
* 20 Alpha S_206FRM This field holds the alisa of
* the user who has sent the
* message
* 20 Alpha S_206TO This field holds the alias
* of the user to whom the
* message is being sent
* 243 Alpha S_206MESS The message itself
*
* Commands to the controller currently are:
* 'AQ' - Assign Queue
* Creates a new data queue for the user, sends the new
* user to all of the current users and sends a list of
* all users to the new user
* 'MG' - Message
* Sends a message to all users if message is to be
* broadcast (B) or to a specific user if individual (I)
* is selected
* 'CL' - Closing
* Indicates that the user has exited the program. The
* controller sends a message to all remaining users to
* delete the user. If there are no more users the
* controller closes itself down
* 'ED' - End
* Message from the closing subroutine telling the
* controller to end itself. This routine can be initiated
* directly by sending a message with the command 'ED'
*
* Commands to the client program currently are:
* 'AU' - Add user
* Tells the client program to add the user to its user
* list
* 'DU' - Delete User
* Tells the client to delete a user from its user list
* 'MG' - Message
* A simple message to the client program
* *******************************************************
Function Options(*DIRECT)
*
* Field definitions
*
Define Field(#S_206QNAM) Type(*CHAR) Length(010)
Define Field(#S_206STR) Type(*CHAR) Length(200)
Define Field(#S_206NUM) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206NUM2) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206CNT1) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206CNT2) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206CNT3) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206QNUM) Type(*CHAR) Length(004) To_Overlay(#S_206QNAM 007)
*
* List definitions
*
* List of created data queues and the user alias
* associated with them
Def_List Name(#S_WRKQUEL) Fields(#S_206FRM #S_206QUE) Counter(#S_206CNT1) Type(*WORKING) Entrys(0001000)
* List of messages and the name of the user
Def_List Name(#S_WRKMESS) Fields(#S_206CMD #S_206TYPE #S_206FRM #S_206TO #S_206MESS) Counter(#S_206CNT2) Type(*WORKING)
* List used to send messages
Def_List Name(#S_WRKSND) Fields(#S_206CMD #S_206TYPE #S_206FRM #S_206TO #S_206MESS) Counter(#S_206CNT3) Type(*WORKING)
*
* Program mainline
*
Execute Subroutine(STARTING)
Execute Subroutine(RCVMESSAGE)
Begin_Loop
Selectlist Named(#S_WRKMESS)
Case Of_Field(#S_206CMD)
When Value_Is('= ''MG''')
Execute Subroutine(SNDMESSAGE)
When Value_Is('= ''AQ''')
Execute Subroutine(NEWUSER)
When Value_Is('= ''CL''')
Execute Subroutine(DLTUSER)
If Cond('#S_206CMD *EQ ED')
Execute Subroutine(ENDING)
Leave
Endif
When Value_Is('= ''ED''')
Execute Subroutine(ENDING)
Leave
Endcase
Execute Subroutine(INITIALIZE)
Endselect
Clr_List Named(#S_WRKMESS)
Clr_List Named(#S_WRKSND)
Execute Subroutine(RCVMESSAGE)
End_Loop
*
* Subroutine Starting
*
Subroutine Name(STARTING)
* This subroutine runs each time the program is started
* It creates the necessary data queues and data areas
* This command adds QGPL to the library list
* These commands create the data queues
Exec_Os400 Command('CRTDTAARA DTAARA(QGPL/S_206DTA) TYPE(*CHAR)') If_Error(R1)
Exec_Os400 Command('ALCOBJ OBJ((QGPL/S_206DTA *DTAARA *EXCL))') If_Error(R1)
If Cond('1 = 2')
R1: Abort Msgtxt('Controller Ended because another controller is already running')
Endif
* If any data queues have not been deleted from the last
* run, this command will delete them
Exec_Os400 Command('DLTDTAQ S_206Q*') If_Error(*NEXT)
* Sets the prefix to the data queue names
Change Field(#S_206QNAM) To(S_206Q)
Endroutine
*
* Subroutine RcvMessage
*
Subroutine Name(RCVMESSAGE)
* Subroutine to continually look at the message queues
* to see if a message has been sent. It will loop until
* it receives a message
Begin_Loop
Clr_List Named(#S_WRKMESS)
Clr_List Named(#S_WRKSND)
Use Builtin(RCV_FROM_DATA_QUEUE) With_Args('S_206TLKQ' 256 2) To_Get(#S_WRKMESS)
If Cond('#S_206CNT2 *GT *ZERO')
Get_Entry Number(1) From_List(#S_WRKMESS)
Leave
Endif
End_Loop
Endroutine
*
* Subroutine SndMessage
*
Subroutine Name(SNDMESSAGE)
* If there are entries in the message list, the function
* sends the whole list to every queue it has created
If Cond('#S_206CMD *EQ MG')
Clr_List Named(#S_WRKSND)
Add_Entry To_List(#S_WRKSND)
Endif
Case Of_Field(#S_206TYPE)
When Value_Is('= ''I''')
Loc_Entry In_List(#S_WRKQUEL) Where('#S_206FRM *EQ #S_206TO')
Use Builtin(SND_TO_DATA_QUEUE) With_Args(#S_206QUE 256 #S_WRKSND)
When Value_Is('= ''B''')
Selectlist Named(#S_WRKQUEL)
Use Builtin(SND_TO_DATA_QUEUE) With_Args(#S_206QUE 256 #S_WRKSND)
Endselect
Endcase
Clr_List Named(#S_WRKSND)
Endroutine
*
* Subroutine NewUser
*
Subroutine Name(NEWUSER)
* A user has logged on
*
Change Field(#S_206CMD) To(AU)
* Create a new data queue
Change Field(#S_206NUM) To('#S_206NUM + 1')
Use Builtin(NUMERIC_STRING) With_Args(#S_206NUM) To_Get(#S_206QNUM)
Use Builtin(TCONCAT) With_Args('CRTDTAQ DTAQ(QGPL/' #S_206QNAM ') MAXLEN(25600)') To_Get(#S_206STR)
Exec_Os400 Command(#S_206STR)
* Send the user a data queue
Change Field(#S_206QUE) To(#S_206QNAM)
Change Field(#S_206MESS) To(#S_206QNAM)
Change Field(#S_206ALS) To(#S_206FRM)
Clr_List Named(#S_WRKSND)
Add_Entry To_List(#S_WRKSND)
Use Builtin(SND_TO_DATA_QUEUE) With_Args('S_206ALOT' 256 #S_WRKSND)
* Send name of new queue to all current users
If Cond('#S_206CNT1 *GT *ZERO')
Clr_List Named(#S_WRKSND)
Change Field(#S_206CMD) To(AU)
Change Field(#S_206TYPE) To(B)
Change Field(#S_206MESS) To(*DEFAULT)
Add_Entry To_List(#S_WRKSND)
Execute Subroutine(SNDMESSAGE)
Endif
Change Field(#S_206QUE) To(#S_206QNAM)
Change Field(#S_206FRM) To(#S_206ALS)
Add_Entry To_List(#S_WRKQUEL)
* Send all users to current user
Clr_List Named(#S_WRKSND)
Change Field(#S_206CMD) To(AU)
Change Field(#S_206TYPE) To(I)
Selectlist Named(#S_WRKQUEL)
Change Field(#S_206MESS) To(#S_206QUE)
Add_Entry To_List(#S_WRKSND)
Endselect
Change Field(#S_206TO) To(#S_206ALS)
Execute Subroutine(SNDMESSAGE)
Endroutine
*
* Subroutine DltUser
*
Subroutine Name(DLTUSER)
* When a user logs off, this subroutine deletes the user
* from the user list and then sends a message to all
* remaining users to delete the user from their user list
Change Field(#S_206CMD) To(DU)
Change Field(#S_206TYPE) To(B)
Add_Entry To_List(#S_WRKSND)
Change Field(#S_206ALS) To(#S_206FRM)
Loc_Entry In_List(#S_WRKQUEL) Where('#S_206FRM *EQ #S_206ALS') Ret_Number(#S_206NUM2)
If_Status Is(*OKAY)
Dlt_Entry Number(#S_206NUM2) From_List(#S_WRKQUEL)
Endif
If Cond('#S_206CNT1 *EQ *ZERO')
Change Field(#S_206CMD) To(ED)
Return
Endif
Execute Subroutine(SNDMESSAGE)
Endroutine
*
* Subroutine Initialize
*
Subroutine Name(INITIALIZE)
Change Field(#S_206CMD #S_206QUE #S_206FRM #S_206TO #S_206TYPE #S_206MESS #S_206ALS) To(*DEFAULT)
Endroutine
*
* Subroutine Ending
*
Subroutine Name(ENDING)
* Subroutine to handle when the function is ended. It
* deletes all of the data queues and the data area
Exec_Os400 Command('DLTDTAQ DTAQ(QGPL/S_206ALOT)')
Exec_Os400 Command('DLTDTAQ DTAQ(QGPL/S_206TLKQ)')
Exec_Os400 Command('DLTDTAQ S_206Q*') If_Error(*NEXT)
Exec_Os400 Command('DLCOBJ OBJ((QGPL/S_206DTA *DTAARA *EXCL))')
Exec_Os400 Command('DLTDTAARA DTAARA(QGPL/S_206DTA)')
Endroutine
* =======================================================
* Process ........: SET_206
* Function .......: SET206B
* Created on .....: 11th September 2001
* Description ....: Conversation Manager
* Version.........: 1
*
* Full Description: This function is the controller for
* all of the chat sessions. It creates and allocates the
* data queues for each user, takes information from the
* general queue and then broadcasts it to all of the
* users. It is started by the remote procedure when the
* first chat session is opened.
*
* Disclaimer: The following material is supplied as
* example material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* *******************************************************
* Input/Output Parameters
*
* This function is intended to be a generic communication
* controller. Messages are received from the S_206TALKQ
* and sent to the user queues in a standard form.
*
* Each entry received from data queue is 256 characters
* in length. The entries are subdivided as follows:
*
* Length Field Description
* 2 Alpha S_206CMD This field holds a command
* to the controller
* 1 Alpha S_206TYPE This field indicates whether
* the message is to be
* broadcast or sent to an
* individual queue (B or I)
* 20 Alpha S_206FRM This field holds the alisa of
* the user who has sent the
* message
* 20 Alpha S_206TO This field holds the alias
* of the user to whom the
* message is being sent
* 243 Alpha S_206MESS The message itself
*
* Commands to the controller currently are:
* 'AQ' - Assign Queue
* Creates a new data queue for the user, sends the new
* user to all of the current users and sends a list of
* all users to the new user
* 'MG' - Message
* Sends a message to all users if message is to be
* broadcast (B) or to a specific user if individual (I)
* is selected
* 'CL' - Closing
* Indicates that the user has exited the program. The
* controller sends a message to all remaining users to
* delete the user. If there are no more users the
* controller closes itself down
* 'ED' - End
* Message from the closing subroutine telling the
* controller to end itself. This routine can be initiated
* directly by sending a message with the command 'ED'
*
* Commands to the client program currently are:
* 'AU' - Add user
* Tells the client program to add the user to its user
* list
* 'DU' - Delete User
* Tells the client to delete a user from its user list
* 'MG' - Message
* A simple message to the client program
* *******************************************************
Function Options(*DIRECT)
*
* Field definitions
*
Define Field(#S_206QNAM) Type(*CHAR) Length(010)
Define Field(#S_206STR) Type(*CHAR) Length(200)
Define Field(#S_206NUM) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206NUM2) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206CNT1) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206CNT2) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206CNT3) Type(*DEC) Length(004) Decimals(0)
Define Field(#S_206QNUM) Type(*CHAR) Length(004) To_Overlay(#S_206QNAM 007)
*
* List definitions
*
* List of created data queues and the user alias
* associated with them
Def_List Name(#S_WRKQUEL) Fields(#S_206FRM #S_206QUE) Counter(#S_206CNT1) Type(*WORKING) Entrys(0001000)
* List of messages and the name of the user
Def_List Name(#S_WRKMESS) Fields(#S_206CMD #S_206TYPE #S_206FRM #S_206TO #S_206MESS) Counter(#S_206CNT2) Type(*WORKING)
* List used to send messages
Def_List Name(#S_WRKSND) Fields(#S_206CMD #S_206TYPE #S_206FRM #S_206TO #S_206MESS) Counter(#S_206CNT3) Type(*WORKING)
*
* Program mainline
*
Execute Subroutine(STARTING)
Execute Subroutine(RCVMESSAGE)
Begin_Loop
Selectlist Named(#S_WRKMESS)
Case Of_Field(#S_206CMD)
When Value_Is('= ''MG''')
Execute Subroutine(SNDMESSAGE)
When Value_Is('= ''AQ''')
Execute Subroutine(NEWUSER)
When Value_Is('= ''CL''')
Execute Subroutine(DLTUSER)
If Cond('#S_206CMD *EQ ED')
Execute Subroutine(ENDING)
Leave
Endif
When Value_Is('= ''ED''')
Execute Subroutine(ENDING)
Leave
Endcase
Execute Subroutine(INITIALIZE)
Endselect
Clr_List Named(#S_WRKMESS)
Clr_List Named(#S_WRKSND)
Execute Subroutine(RCVMESSAGE)
End_Loop
*
* Subroutine Starting
*
Subroutine Name(STARTING)
* This subroutine runs each time the program is started
* It creates the necessary data queues and data areas
* This command adds QGPL to the library list
* These commands create the data queues
Exec_Os400 Command('CRTDTAARA DTAARA(QGPL/S_206DTA) TYPE(*CHAR)') If_Error(R1)
Exec_Os400 Command('ALCOBJ OBJ((QGPL/S_206DTA *DTAARA *EXCL))') If_Error(R1)
If Cond('1 = 2')
R1: Abort Msgtxt('Controller Ended because another controller is already running')
Endif
* If any data queues have not been deleted from the last
* run, this command will delete them
Exec_Os400 Command('DLTDTAQ S_206Q*') If_Error(*NEXT)
* Sets the prefix to the data queue names
Change Field(#S_206QNAM) To(S_206Q)
Endroutine
*
* Subroutine RcvMessage
*
Subroutine Name(RCVMESSAGE)
* Subroutine to continually look at the message queues
* to see if a message has been sent. It will loop until
* it receives a message
Begin_Loop
Clr_List Named(#S_WRKMESS)
Clr_List Named(#S_WRKSND)
Use Builtin(RCV_FROM_DATA_QUEUE) With_Args('S_206TLKQ' 256 2) To_Get(#S_WRKMESS)
If Cond('#S_206CNT2 *GT *ZERO')
Get_Entry Number(1) From_List(#S_WRKMESS)
Leave
Endif
End_Loop
Endroutine
*
* Subroutine SndMessage
*
Subroutine Name(SNDMESSAGE)
* If there are entries in the message list, the function
* sends the whole list to every queue it has created
If Cond('#S_206CMD *EQ MG')
Clr_List Named(#S_WRKSND)
Add_Entry To_List(#S_WRKSND)
Endif
Case Of_Field(#S_206TYPE)
When Value_Is('= ''I''')
Loc_Entry In_List(#S_WRKQUEL) Where('#S_206FRM *EQ #S_206TO')
Use Builtin(SND_TO_DATA_QUEUE) With_Args(#S_206QUE 256 #S_WRKSND)
When Value_Is('= ''B''')
Selectlist Named(#S_WRKQUEL)
Use Builtin(SND_TO_DATA_QUEUE) With_Args(#S_206QUE 256 #S_WRKSND)
Endselect
Endcase
Clr_List Named(#S_WRKSND)
Endroutine
*
* Subroutine NewUser
*
Subroutine Name(NEWUSER)
* A user has logged on
*
Change Field(#S_206CMD) To(AU)
* Create a new data queue
Change Field(#S_206NUM) To('#S_206NUM + 1')
Use Builtin(NUMERIC_STRING) With_Args(#S_206NUM) To_Get(#S_206QNUM)
Use Builtin(TCONCAT) With_Args('CRTDTAQ DTAQ(QGPL/' #S_206QNAM ') MAXLEN(25600)') To_Get(#S_206STR)
Exec_Os400 Command(#S_206STR)
* Send the user a data queue
Change Field(#S_206QUE) To(#S_206QNAM)
Change Field(#S_206MESS) To(#S_206QNAM)
Change Field(#S_206ALS) To(#S_206FRM)
Clr_List Named(#S_WRKSND)
Add_Entry To_List(#S_WRKSND)
Use Builtin(SND_TO_DATA_QUEUE) With_Args('S_206ALOT' 256 #S_WRKSND)
* Send name of new queue to all current users
If Cond('#S_206CNT1 *GT *ZERO')
Clr_List Named(#S_WRKSND)
Change Field(#S_206CMD) To(AU)
Change Field(#S_206TYPE) To(B)
Change Field(#S_206MESS) To(*DEFAULT)
Add_Entry To_List(#S_WRKSND)
Execute Subroutine(SNDMESSAGE)
Endif
Change Field(#S_206QUE) To(#S_206QNAM)
Change Field(#S_206FRM) To(#S_206ALS)
Add_Entry To_List(#S_WRKQUEL)
* Send all users to current user
Clr_List Named(#S_WRKSND)
Change Field(#S_206CMD) To(AU)
Change Field(#S_206TYPE) To(I)
Selectlist Named(#S_WRKQUEL)
Change Field(#S_206MESS) To(#S_206QUE)
Add_Entry To_List(#S_WRKSND)
Endselect
Change Field(#S_206TO) To(#S_206ALS)
Execute Subroutine(SNDMESSAGE)
Endroutine
*
* Subroutine DltUser
*
Subroutine Name(DLTUSER)
* When a user logs off, this subroutine deletes the user
* from the user list and then sends a message to all
* remaining users to delete the user from their user list
Change Field(#S_206CMD) To(DU)
Change Field(#S_206TYPE) To(B)
Add_Entry To_List(#S_WRKSND)
Change Field(#S_206ALS) To(#S_206FRM)
Loc_Entry In_List(#S_WRKQUEL) Where('#S_206FRM *EQ #S_206ALS') Ret_Number(#S_206NUM2)
If_Status Is(*OKAY)
Dlt_Entry Number(#S_206NUM2) From_List(#S_WRKQUEL)
Endif
If Cond('#S_206CNT1 *EQ *ZERO')
Change Field(#S_206CMD) To(ED)
Return
Endif
Execute Subroutine(SNDMESSAGE)
Endroutine
*
* Subroutine Initialize
*
Subroutine Name(INITIALIZE)
Change Field(#S_206CMD #S_206QUE #S_206FRM #S_206TO #S_206TYPE #S_206MESS #S_206ALS) To(*DEFAULT)
Endroutine
*
* Subroutine Ending
*
Subroutine Name(ENDING)
* Subroutine to handle when the function is ended. It
* deletes all of the data queues and the data area
Exec_Os400 Command('DLTDTAQ DTAQ(QGPL/S_206ALOT)')
Exec_Os400 Command('DLTDTAQ DTAQ(QGPL/S_206TLKQ)')
Exec_Os400 Command('DLTDTAQ S_206Q*') If_Error(*NEXT)
Exec_Os400 Command('DLCOBJ OBJ((QGPL/S_206DTA *DTAARA *EXCL))')
Exec_Os400 Command('DLTDTAARA DTAARA(QGPL/S_206DTA)')
Endroutine