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

Home -> Community -> Usenet -> c.d.o.server -> Re: Seeking Testing Volunteers W2K MTS/DTC to VMS DECdtm Distributed 2PC Transactions

From: Richard Maher <maher_rj_at_hotspamnotmail.com>
Date: Fri, 26 Nov 2004 19:55:12 +0000 (UTC)
Message-ID: <co81mt$8bs$1@hercules.btinternet.com>

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 - 13:55:12 CST