$! $ server_user = f$getjpi(0,"username") $ home_dir = f$trnlnm("sys$login","lnm$job") $ set default 'home_dir $! $ create demo_tip_auxs.cob ************************************************************************************ * * * COPYRIGHT (c) TIER3 SOFTWARE LTD. ALL RIGHTS RESERVED. * * * * THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ONLY * * IN ACCORDANCE WITH THE TERMS AND CONDITIONS OF SUCH LICENSE AND WITH THE * * THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * * COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * * OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * * TRANSFERRED. * * * * THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE AND * * SHOULD NOT BE CONSTRUED AS A COMMITMENT BY TIER3 SOFTWARE LTD. * * * ************************************************************************************ identification division. program-id. demo_tip_auxs. data division. working-storage section. 01 out_msg pointer value external out_msg. 01 io$_setmode pic s9(9) comp value external io$_setmode. 01 io$_writevblk pic s9(9) comp value external io$_writevblk. 01 io$_readvblk pic s9(9) comp value external io$_readvblk. 01 io$_deaccess pic s9(9) comp value external io$_deaccess. 01 ddtm$m_nowait pic s9(9) comp value external ddtm$m_nowait. 01 ddtm$_aborted pic s9(9) comp value external ddtm$_aborted. 01 ss$_abort pic s9(9) comp value external ss$_abort. 01 ss$_normal pic s9(9) comp value external ss$_normal. 01 sys_status pic s9(9) comp. * 01 reply_addr pointer. 01 reply_len pic 9(4) comp. 01 out_len pic 9(4) comp. 01 abort_msg pic x(256). 01 bintim pic s9(11)v9(7) comp. * 01 msg_buff. 03 msg_type pic x(2). 03 pic x(510). * 01 insert_employee_msg redefines msg_buff. 03 employee_msg. 05 pic x(2). 05 employee_detais. 07 EmployeeId pic 9(10). 07 LastName pic x(20). 07 FirstName pic x(10). 07 BirthDate pic x(23). 07 Address. 09 line1 pic x(30). 09 line2 pic x(30). 07 City pic x(15). 07 Region pic x(15). 07 PostalCode pic x(10). 03 tip_txn_url pic x(256). * 01 comp_status. 03 pic x(2) value "22". 03 commit_flag pic x(1). * 01 inet_chan pic 9(4) comp. 01 iosb. 03 cond_val pic 9(4) comp. 03 msg_size pic 9(4) comp. 03 pic x(4). * 01 create_socket. 03 pic s9(4) comp value external ucx$c_tcp. 03 pic s9(4) comp value external auxs_def. * 01 sqlcode pic 9(9) comp. 01 rdb$message_vector external. 03 rdb$lu_num_arguments pic 9(9) comp. 03 rdb$lu_status pic 9(9) comp. 03 rdb$alu_arguments occurs 18 times. 05 rdb$lu_arguments pic 9(9) comp. * 01 sql_ctx. 03 pic 9(9) comp value 1. 03 pic 9(9) comp value 1. 03 pic 9(9) comp value 16. 03 db_tid pic x(16). 03 pic 9(9) comp. * 01 tip_tid pic x(16). 01 tip_bid pic x(16). * 01 dtm_iosb. 03 dtm_iosb_status pic 9(4) comp. 03 pic x(2). 03 reason_code pic 9(9) comp. * 01 syi_item_list. 03 item_nodename. 05 pic s9(4) comp value 6. 05 pic s9(4) comp value external syi$_nodename. 05 pointer value reference local_node. 05 pointer value reference local_node_len. 03 pic s9(9) comp. * 01 local_node pic x(6). 01 local_node_len pic 9(4) comp. * 01 syi_iosb. 03 syi_cond pic s9(9) comp. 03 pic x(4). * procedure division. kick_off section. 00. call "sys$getsyiw" using by value 0, 0, 0 by reference syi_item_list, syi_iosb by value 0, 0 giving sys_status. if sys_status = ss$_normal move syi_cond to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. perform open_socket. perform read_socket. perform until msg_type = "99" evaluate msg_type when "20" perform insert_employee_push when other display "Unknow message type: ", msg_type call "lib$stop" using by value ss$_abort end-evaluate perform read_socket end-perform. perform close_socket. stop run. * open_socket section. 00. call "sys$assign" using by descriptor "sys$net:" by reference inet_chan by value 0, 0, 0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. call "sys$qiow" using by value 0, inet_chan, io$_setmode by reference iosb by value 0, 0 by reference create_socket by value 0, 0, 0, 0, 0 giving sys_status. if sys_status = ss$_normal move cond_val to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * read_socket section. 00. call "sys$qiow" using by value 0, inet_chan, io$_readvblk by reference iosb by value 0, 0 by reference msg_buff by value 512, 0, 0, 0, 0 giving sys_status. if sys_status = ss$_normal move cond_val to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. display "Rec = *", insert_employee_msg(1:msg_size), "*". * write_socket section. 00. call "sys$qiow" using by value 0, inet_chan, io$_writevblk by reference iosb by value 0, 0, reply_addr, reply_len, 0, 0, 0, 0 giving sys_status. if sys_status = ss$_normal move cond_val to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * close_socket section. 00. call "sys$qiow" using by value 0, inet_chan, io$_deaccess by reference iosb by value 0, 0, 0, 0, 0, 0, 0, 0 giving sys_status. if sys_status = ss$_normal move cond_val to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. call "sys$dassgn" using by value inet_chan giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * insert_employee_push section. 00. move function upper-case (BirthDate) to BirthDate. call "sys$bintim" using by descriptor BirthDate by reference bintim giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. call "t3$tip_url_to_tid" using by descriptor tip_txn_url of insert_employee_msg (1:(msg_size - function length(employee_msg))) by reference tip_tid, tip_bid giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. call "sys$start_branchw" using by value 0, 0 by reference dtm_iosb by value 0, 0 by reference tip_tid by descriptor local_node(1:local_node_len) by reference tip_bid giving sys_status. if sys_status = ss$_normal move dtm_iosb_status to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * move tip_tid to db_tid. perform the_insert. * set reply_addr to reference comp_status. move 3 to reply_len. perform write_socket. if commit_flag = "Y" perform commit_trans else perform abort_trans. * fini. * the_insert section. 00. call "set_trans_rw" using sqlcode, sql_ctx. if rdb$lu_status not = ss$_normal call "sys$putmsg" using rdb$message_vector call "lib$stop" using by value ss$_abort. call "insert_employee" using sqlcode, EmployeeId(6:5), LastName, FirstName, Bintim, line1, line2, City, Region, PostalCode, sql_ctx. if rdb$lu_status not = ss$_normal move "N" to commit_flag call "sys$putmsg" using by reference rdb$message_vector by value out_msg, 0 by reference inet_chan giving sys_status if sys_status not = ss$_normal call "lib$stop" using by value sys_status end-if else move "Y" to commit_flag. * fini. * commit_trans section. 00. call "sys$end_branchw" using by value 0, 0 by reference dtm_iosb by value 0, 0 by reference tip_tid, tip_bid giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * if dtm_iosb_status = ss$_abort display "Couldn't commit - " no advancing if reason_code not = zeros call "sys$getmsg" using by value reason_code by reference out_len by descriptor abort_msg by value 0,0 giving sys_status if sys_status not = ss$_normal call "lib$stop" using by value sys_status end-if display abort_msg (1:out_len) else display "and don't know why" else if dtm_iosb_status not = ss$_normal call "lib$stop" using by value dtm_iosb_status. * abort_trans section. 00. call "sys$abort_transw" using by value 0, ddtm$m_nowait by reference dtm_iosb by value 0, 0 by reference tip_tid by value ddtm$_aborted by reference tip_bid giving sys_status. if sys_status = ss$_normal move dtm_iosb_status to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * end program demo_tip_auxs. identification division. program-id. out_msg. data division. working-storage section. 01 io$_writevblk pic 9(9) comp value external io$_writevblk. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * 01 iosb. 03 cond_val pic s9(4) comp. 03 pic x(6). * 01 reply_addr pointer. 01 reply_len pic 9(4) comp. * 01 reply_hdr. 03 error_id pic xx value "88". 03 error_len pic 9(3). * linkage section. * 01 msg_desc. 03 msg_len pic 9(4) comp. 03 msg_class pic 9(4) comp. 03 msg_addr pointer. * 01 inet_chan pic 9(4) comp. * procedure division using msg_desc, inet_chan giving ss$_normal. 00. move function length(reply_hdr) to reply_len. move msg_len to error_len. set reply_addr to reference reply_hdr. perform write_socket. move msg_len to reply_len. move msg_addr to reply_addr. perform write_socket. * fini. exit program. * write_socket. * call "sys$qiow" using by value 0, inet_chan, io$_writevblk by reference iosb by value 0, 0, reply_addr, reply_len, 0, 0, 0, 0 giving sys_status. if sys_status = ss$_normal move cond_val to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * end program out_msg. $! $ cobol/lis demo_tip_auxs.cob $! $ create demo_tip_auxs_def.mar .title DEMO_TIP_AUXS_DEF Demo example TIP external data ;+ ; The following command can be used to create a macro library INET in your default ; area if one does not already exist:- ; ; $library/create/macro inet.mlb sys$library:ucx$inetdef ; ; .library "sys$login:inet" ; ; $inetsymdef GLOBAL ; $siocdef GLOBAL ; $inetacpfsymdef GLOBAL ; $inetacpsymdef GLOBAL ; $ineterrdef GLOBAL ;- $ddtmdef GLOBAL $ddtmmsgdef GLOBAL ucx$c_auxs == 127 ucx$c_af_inet == 2 ucx$c_tcp == 6 auxs_def == .end $ macro/lis demo_tip_auxs_def.mar $! $ create demo_tip_auxs_sql.sqlmod module dist_sql language cobol parameter colons declare pers alias filename mf_personnel procedure set_trans_rw sqlcode; set transaction read write reserving pers.employees for shared write; procedure insert_employee sqlcode, :employee_id char(5), :last_name char(20), :first_name char(10), :birthday date vms, :address_data_1 char(30), :address_data_2 char(30), :city char(15), :state char(15), :postal_code char(10) ; insert into pers.employees ( employee_id, last_name, first_name, birthday, address_data_1, address_data_2, city, state, postal_code, middle_initial, sex, status_code ) values ( :employee_id, :last_name, :first_name, :birthday, :address_data_1, :address_data_2, :city, :state, :postal_code, ' ', '?', 'N' ) ; $! $ sqlmod:==$sql$mod $ sqlmod/lis/context=(set_trans_rw,insert_employee)/const=immed demo_tip_auxs_sql.sqlmod/nowarning $! $ define/nolog lnk$library sys$library:t3$user $ link demo_tip_auxs,demo_tip_auxs_def,demo_tip_auxs_sql,sql$user/lib $! $ create demo_tip_auxs_input.com $ deck $! define mf_personnel to_where_it_lives $ run sys$login:demo_tip_auxs $ exit $ eod $! $ ucx set service tip_inetd - /port = 303 - /protocol = tcp - /process = tip_auxs - /user_name = 'server_user' - /file = 'home_dir'demo_tip_auxs_input $! $ ucx enable service tip_inetd $! $ exit