Re: Seeking Testing Volunteers W2K MTS/DTC to VMS DECdtm Distributed 2PC Transactions

Hi Richard,

I'm a very slow learner. Also, I am retired for over 20 years. As a result, I am interested in a definition of VMS code. It looked a lot like Cobol to me. Oh, plus some jcl.

Warren Simmons

P.S. I see the use of pointer. I have heard that this is a tricky thing to use. Will you explain as it was not clear to me why that was true.

Warren Simmons
wsimmons5_at_optonline.net

Richard Maher wrote:

> Here's the DEMO code that I promised for the VMS side. It simply doesn't get
> any easier than this!
>
> Everything except the two T3$ services is *standard* VMS code.
>
> Enjoy!
>
> Cheers Richard Maher.
>
> $!
> $ 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(128).
> *
> 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 == <ucx$c_auxs * 256 + ucx$c_af_inet>
>
> .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,sys$library: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
>
>
>
Received on Fri Nov 26 2004 - 15:00:17 CST