From: Richard [maher_rjNOmaSPAM@hotmail.com.invalid] Sent: Sunday, August 13, 2000 12:23 PM To: Info-VAX@Mvb.Saic.Com Subject: DECdtm txn propagation to other process/node(s) (Hi I originally posted this in the Rdb list server two weeks ago but I've only just received confirmation that everything works 100% on Alpha and VAX so here it is. If anyone would like a DCL command file that will do everything for you with just one "@" then mail me or at least tell me the address to e-mail things to so that I can attach a file) Hi, I've just realised that everyone is probably heading off on August Hols tomorrow so here's that riveting read you'll be needing for the beach. If you don't get your jollies out of this functionality then you are simply sick of life itself! The code is yours *as is*. I don't offer any support, but I will answer any questions (here or via direct e-mail) when/if I can. Enjoy! To all the DBAs out there who won't spend a lot of time looking at this, please pass it on to your developers. It's no use just mothering the data if you don't do anything with it. NB: This is USER mode, UNpriviledged code! You do *NOT* have to install anything. Turn all priviledges *OFF* except (netmbx,tmpmbx) Can someone please test this on a VAX. If there are any problems I'll try and fix them ASAP. I am expecting a ss$_accvio from the $abort_transw on Alpha but if it's not reproducable on a VAX then, I'm sorry, but that's a Compaq problem. The alternative (removal of $abort_trans from child.cob is to do what, I think, Rdb is doing with Server Binding and rdb$remote. That is, the server process is a just a brainless reactive no-hoper (sudden rush of empathy :-) that regardless of any eventuality will sit there at $end_branch after informing the main/co-ordinator process of what went on. I do not believe that is what you should be doing and it severely reduces the scope for *parallelism*. I've attached the source files as well as included them in- line for people who aren't keen on attachments. I've kept the example programs as short as I can while still trying to make them half useful. You need to create two Rdb databases. Put the first mf_personnel.rdb in the default directory. $@sql$sample:personnel SQL M NOCDD Then create a sub-directory [.test] and put a copy of personnel.rdb there. $@sql$sample:personnel SQL S NOCDD Then run the following sql:- $sql sql> attach 'file [.test]personnel'; sql> alter table departments alter column department_name constraint no_space check (department_name <> ' '); sql> commit; sql> exit By just hitting RETURN in response to the department name prompt in Parent.cob you will cause the failure, or $abort_trans, case. That is, the above constraint will fail. The cobol programs are straight $COBOL/LIS (NB: Before compiling both COBOL programs, be sure to change "MYNODE" to the SCSNODE/DECnet nodename of the machine your running on. See $add_branch, $start_branch) On second thoughts Parent.cob should be compiled with /GRANULARITY= BYTE (or add "03 granularity_sentinal pic 9(18) comp." between the child_status and user_exit fields. I originally thought that the alignment compiler directives would handle it, but I believe that they give us performance and natural alignment and not granularity protection from ASTs. *DC SET GRANULARITY please? The SQLMOD is compiled as follows:- $ sqlmod dist_sql.sqlmod/context= (set_trans_rw,update_dept)/constr=immed You need to do a $MACRO/LIS on the following (call it DIST_DEF.MAR) .title External Symbol Definitions $cmbdef GLOBAL $agndef GLOBAL $ddtmdef GLOBAL $ddtmmsgdef GLOBAL $iodef io__writenow == io__readcheck == io__writecheck == ; io__writeofcheck == io__writeofcheck == .end You'll see from above that I've removed the io$m_now from the eof write. This EOF write is being used as the main synchronization point between Parent and Child. IMHO the child process should be able to use io$m_now, thus facilitating greater parallelism, in the successful $end_branchw case. NB: You'll hear otherwise from Rdb engineering, but I believe an $abort_trans in the child before the parent has finished it's Rdb work will yield "undefined" results. So just don't do it! "We're in EXEC mode; your DECdtm calls are in USER; You can't scare us!" I've never believed this and when I asked if Rdb engineering had come up with a CMUSER the answer was no we just drop back to USER mode. So unless they do a $setast 0 before going into EXEC "Please say it ain't so!" an abort transaction event ast could screw things up big time. During a verb, between two verbs etc etc. . . Speaking of Rdb engineering, I wouldn't hold my breath waiting for them to say they support this. Nothing wrong with that! To say they support it means that they'd have to have tested it which requires money. Money which will not be forthcoming until at least Compaq says it will publish/support the branch management system services. But I think we can aim for the acquiescence of Rdb engineering as an attainable goal. It's not like their not doing exactly the same thing themselves. Then you link the two images:- $link parent, dist_def, dist_sql, sys$library:sql$user/lib $link child, dist_def, dist_sql, sys$library:sql$user/lib Finally:- $run parent Enter a couple of department_names (you can check the databases if you want) before entering spaces. Enter ^Z if you want to exit. Parent.cob identification division. program-id. parent_rtn with ident "v1.0". author. public domain. data division. working-storage section. * 01 child_exit_ast pointer value external child_exit_ast. 01 cmb$m_writeonly pic 9(9) comp value external cmb$m_writeonly. 01 cmb$m_readonly pic 9(9) comp value external cmb$m_readonly. 01 cli$m_nowait pic 9(9) comp value external cli$m_nowait. 01 io__writenow pic 9(9) comp value external io__writenow. 01 io$_readvblk pic 9(9) comp value external io$_readvblk. 01 io$_writevblk pic 9(9) comp value external io$_writevblk. 01 io$_writeof pic 9(9) comp value external io$_writeof. 01 ss$_endoffile pic 9(9) comp value external ss$_endoffile. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 sys_status pic 9(9) comp. * 01 db_spec pic x(50) value "alias pers filename mf_personnel". *+ *dc set alignment *- 01 child_params. 03 child_status pic 9(9) comp. 03 user_exit pic x value "N". *+ *dc end-set alignment *- 01 commit_flag pic x. 01 msg_buf pic x(256). 01 msg_len pic 9(4) comp. 01 write_chan pic 9(4) comp. 01 read_chan pic 9(4) comp. 01 letter_sent. 03 ls_tid pic x(16). 03 ls_bid pic x(16). 03 new_name pic x(30). 03 pic x(450). * 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 tid pic x(16) value low- values. 03 pic 9(9) comp value zero. 01 bid pic x(16). * 01 sqlcode pic 9(9) comp. 01 dtm_iosb. 03 dtm_iosb_status pic 9(4) comp. 03 pic xx. 03 reason_code 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 iosb. 03 cond_val pic 9(4) comp. 03 byte_count pic 9(4) comp. 03 chan_info pic 9(9) comp. * procedure division. kick_off section. 00. perform parent_init. display "Enter new department name : " no advancing erase screen. accept new_name protected reversed at end move "Y" to user_exit. perform dist_trans until user_exit = "Y". call "sys$qiow" using by value 0, write_chan, io$_writeof 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. * fini. stop run. * parent_init section. 00. *+ * Need a conduit. *- call "sys$crembx" using by value 0 by reference write_chan by value 512, 512, 0, 0 by descriptor "P2C_MBX" by value cmb$m_writeonly, 0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. call "sys$crembx" using by value 0 by reference read_chan by value 512, 2048, 0, 0 by descriptor "C2P_MBX" by value cmb$m_readonly, 0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. *+ * Create the party of the 2nd part. Spawn flags say NOWAIT. Get it? parallelism! * Sorry that's *PARALLELISM*. This is goodness. This is desirable, especially for * networks. This is unachievable with rdb$remote, SQL/Services, ACMS, DEC RPC, COM+. . . *- call "lib$spawn" using by descriptor "$run child" by value 0 by descriptor "child.log" by reference cli$m_nowait by value 0, 0 by reference child_status by value 0, child_exit_ast by reference child_params by value 0, 0, 0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. *+ * Attach to the database. I've done it this way because I didn't want to have * to worry about changing logical names, but also to show how you could attach * to any number of run-time defined databases and include them in the 2PC. *- call "declare_connection_name" using sqlcode, db_spec. if rdb$lu_status not = ss$_normal call "sys$putmsg" using rdb$message_vector call "lib$stop" using by value ss$_abort. * fini. * dist_trans section. 00. move function upper-case (new_name) to new_name. *+ * Start the transaction. *- call "sys$start_transw" using by value 0, 0 by reference dtm_iosb by value 0, 0 by reference tid 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. *+ * Authorize a branch (participant) for the sub-process. *- call "sys$add_branchw" using by value 0, 0 by reference dtm_iosb by value 0, 0 by reference tid by descriptor "MYNODE" by reference 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. *+ * Give the sub-process what it needs to join in. *PARALLELISM* * This could just as easily be a TIP URL. YOU could make it happen! *- move tid to ls_tid. move bid to ls_bid. call "sys$qiow" using by value 0, write_chan, io__writenow by reference iosb by value 0,0 by reference letter_sent 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. *+ * Enlist Rdb. *- 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 "update_dept" using sqlcode, new_name, sql_ctx. if rdb$lu_status = ss$_normal move "Y" to commit_flag else call "sys$putmsg" using rdb$message_vector move "N" to commit_flag. *+ * Synchronize with the child process as we can't commit until his * database work is finished. For this example we don't bother asking * the child how its update went. Let the DECdtm 2PC sort it out. *- perform get_reply. perform until sys_status not = ss$_normal display "Child> ", letter_sent (1:byte_count) perform get_reply end-perform. if sys_status not = ss$_endoffile call "lib$stop" using by value sys_status. if commit_flag = "Y" perform commit_trans else perform abort_trans. * fini. * display "Enter new department name : " no advancing. accept new_name protected reversed at end move "Y" to user_exit. * get_reply section. 00. call "sys$qiow" using by value 0, read_chan, io$_readvblk by reference iosb by value 0,0 by reference letter_sent by value 512,0,0,0,0 giving sys_status. if sys_status = ss$_normal move cond_val to sys_status. * commit_trans section. 00. display "Committing transaction. . .". call "sys$end_transw" using by value 0, 0 by reference dtm_iosb by value 0, 0 by reference tid giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * if dtm_iosb_status = ss$_abort call "sys$getmsg" using by value reason_code by reference msg_len by descriptor msg_buf by value 0,0 giving sys_status if sys_status not = ss$_normal call "lib$stop" using by value sys_status end-if display "Couldn't commit - " msg_buf (1:msg_len) else if dtm_iosb_status not = ss$_normal call "lib$stop" using by value dtm_iosb_status. * abort_trans section. 00. display "Aborting transaction. . .". call "sys$abort_transw" using by value 0, 0 by reference dtm_iosb by value 0, 0 by reference tid by value 0 giving sys_status. if sys_status = ss$_normal or ss$_abort move dtm_iosb_status to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * end program parent_rtn. identification division. program-id. child_exit_ast. * data division. linkage section. *+ *dc set alignment *- 01 child_params. 03 child_status pic 9(9) comp. 03 user_exit pic x. *+ *dc end-set alignment *- procedure division using child_params. 00. if user_exit = "N" display "Unexpected child exit" call "lib$stop" using by value child_status. * fini. exit program. * end program child_exit_ast. Child.cob identification division. program-id. child_rtn with ident "v1.0". author. public domain. data division. working-storage section. * 01 out_msg pointer value external out_msg. 01 io__readcheck pic 9(9) comp value external io__readcheck. 01 io__writeofcheck pic 9(9) comp value external io__writeofcheck. 01 agn$m_writeonly pic 9(9) comp value external agn$m_writeonly. 01 agn$m_readonly pic 9(9) comp value external agn$m_readonly. 01 ddtm$m_nowait pic 9(9) comp value external ddtm$m_nowait. 01 ddtm$_aborted pic 9(9) comp value external ddtm$_aborted. 01 ss$_endoffile pic 9(9) comp value external ss$_endoffile. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 sys_status pic 9(9) comp. * 01 db_spec pic x(50) value "alias pers filename [.test]personnel". 01 sqlcode pic 9(9) comp. 01 dtm_iosb. 03 dtm_iosb_status pic 9(4) comp. 03 pic xx. 03 reason_code 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 iosb. 03 cond_val pic 9(4) comp. 03 byte_count pic 9(4) comp. 03 chan_info pic 9(9) comp. * 01 msg_buf pic x(256). 01 msg_len pic 9(4) 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 tid pic x(16) value low- values. 03 pic 9(9) comp value zero. * 01 read_chan pic 9(4) comp. 01 write_chan pic 9(4) comp. 01 cmd_eof pic x value "N". 01 commit_flag pic x. 01 letter_sent. 03 ls_tid pic x(16). 03 ls_bid pic x(16). 03 new_name pic x(30). 03 pic x(450). * procedure division. kick_off section. 00. perform child_init. perform get_cmd. perform dist_trans until cmd_eof = "Y". call "disconnect_db" using sqlcode if rdb$lu_status not = ss$_normal call "sys$putmsg" using rdb$message_vector call "lib$stop" using by value ss$_abort. * fini. stop run. * child_init section. 00. *+ * Need a conduit. *- call "sys$assign" using by descriptor "P2C_MBX" by reference read_chan by value 0, 0, agn$m_readonly giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. call "sys$assign" using by descriptor "C2P_MBX" by reference write_chan by value 0, 0, agn$m_writeonly giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. *+ * Attach to the database. *- call "declare_connection_name" using sqlcode, db_spec. if rdb$lu_status not = ss$_normal call "sys$putmsg" using rdb$message_vector call "lib$stop" using by value ss$_abort. * dist_trans section. 00. move ls_tid to tid. call "sys$start_branchw" using by value 0, 0 by reference dtm_iosb by value 0, 0 by reference ls_tid by descriptor "MYNODE" by reference ls_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. * perform the_update. * call "sys$qiow" using by value 0, write_chan, io__writeofcheck 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. if commit_flag = "Y" perform commit_trans else perform abort_trans. * fini. perform get_cmd. * get_cmd section. 00. call "sys$qiow" using by value 0, read_chan, io__readcheck by reference iosb by value 0,0 by reference letter_sent by value 512,0,0,0,0 giving sys_status. if sys_status = ss$_normal move cond_val to sys_status. if sys_status = ss$_endoffile move "Y" to cmd_eof else if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * the_update 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 "update_dept" using sqlcode, new_name, 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 write_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. display "Ending branch". call "sys$end_branchw" using by value 0, 0 by reference dtm_iosb by value 0, 0 by reference ls_tid, ls_bid giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * if dtm_iosb_status = ss$_abort call "sys$getmsg" using by value reason_code by reference msg_len by descriptor msg_buf by value 0,0 giving sys_status if sys_status not = ss$_normal call "lib$stop" using by value sys_status end-if display "Couldn't commit - " msg_buf (1:msg_len) else if dtm_iosb_status not = ss$_normal call "lib$stop" using by value dtm_iosb_status. * abort_trans section. 00. display "Aborting transaction". call "sys$abort_transw" using by value 0, ddtm$m_nowait by reference dtm_iosb by value 0, 0 by reference ls_tid by value ddtm$_aborted by reference ls_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 child_rtn. identification division. program-id. out_msg. data division. working-storage section. * 01 io__writecheck pic 9(9) comp value external io__writecheck. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 sys_status pic 9(9) comp. * 01 iosb. 03 cond_val pic 9(4) comp. 03 byte_count pic 9(4) comp. 03 chan_info pic 9(9) comp. * linkage section. 01 msg_desc. 03 msg_len pic 9(4) comp. 03 msg_class pic 9(4) comp. 03 msg_addr pointer. 01 write_chan pic 9(4) comp. * procedure division using msg_desc, write_chan giving ss$_abort. 00. *+ * This $qiow call could just as easily be a call to T3$SEND that would * transfer all of those lovely descriptive Rdb error messages back to * your VB message window. *- call "sys$qiow" using by value 0, write_chan, io__writecheck by reference iosb by value 0,0,msg_addr,msg_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. exit program. end program out_msg. Dist_sql.sqlmod module dist_sql language cobol parameter colons declare pers alias filename mf_personnel procedure declare_connection_name sqlcode, :db_spec char(50); attach :db_spec; procedure set_trans_rw sqlcode; set transaction read write reserving pers.departments for shared write; procedure update_dept sqlcode :dept_name char(30); update pers.departments set department_name = :dept_name where department_code= 'PHRN'; procedure disconnect_db sqlcode; disconnect default; * Sent from AltaVista http://www.altavista.com Where you can also find related Web Pages, Images, Audios, Videos, News, and Shopping. Smart is Beautiful