![[目次]](FIGURE/CONTENT.GIF)
分散トランザクション処理機能 OpenTP1 プログラム作成リファレンス COBOL言語編
![[索引]](FIGURE/INDEX.GIF)
![[前へ]](FIGURE/FRONT.GIF)
![[次へ]](FIGURE/AFTER.GIF)
ここで示す例題の処理概要を，次に説明します。
[説明]宿泊施設の空き状況を調べるサービスと，飛行機の空き状況を調べるサービスを，SUPから呼びます。前者は非同期に，後者は同期的に応答を受信します。
例題のUAPの構成を次の図に示します。
図6-4 同期的に応答を受信するリクエスト／レスポンス型サービスの通信形態
![[図データ]](FIGURE/ZU061200.GIF)
通信に使う型付きバッファの構造体を次に示します。
HOTEL.cbl
05 RDATE PIC S9(9) COMP-5.
05 PLACE PIC X(128).
05 HNAME PIC X(128).
05 RSTATUS PIC S9(9) COMP-5.
PLANE.cbl
05 RDATE PIC S9(9) COMP-5.
05 DEST PIC X(128).
05 DEPARTURE PIC S9(9) COMP-5.
05 RSTATUS PIC S9(9) COMP-5.
10 /* SUPのXATMIインタフェース定義の例（rrsupcb.defファイル）*/
20 called_servers = { "rrsppcb.def" };
10 * 20 ********************************************************* 30 * SUPの例(rrsup.cblファイル) 40 ********************************************************* 50 * 60 IDENTIFICATION DIVISION. 70 * 80 PROGRAM-ID. MAIN. 90 * 100 ********************************************************* 110 * データ領域の設定 120 ********************************************************* 130 * 140 DATA DIVISION. 150 WORKING-STORAGE SECTION. 160 ********************************************************* 170 * 変数の宣言 180 ********************************************************* 190 ***** typed record for SVHOTEL ***** 200 01 HOTEL-REQ. 210 COPY HOTEL. 220 ***** type infomation for SVHOTEL ***** 230 01 HOTELTYPE-REC. 240 COPY TPTYPE. 250 ***** typed record for SVPLANE ***** 260 01 PLANE-REQ. 270 COPY PLANE. 280 ***** type infomation for SVPLANE ***** 290 01 PLANETYPE-REC. 300 COPY TPTYPE. 310 ***** WERRMSG ***** 320 01 WERRMSG-REC. 330 COPY ERRMSG. 340 ***** service definition for SVHOTEL ***** 350 01 HOTELDEF-REC. 360 COPY TPSVCDEF. 370 ***** service definition for SVPLANE ***** 380 01 PLANEDEF-REC. 390 COPY TPSVCDEF. 400 ***** return record ***** 410 01 STATUS-REC. 420 COPY TPSTATUS. 430 ***** working area is used for replies ***** 440 01 WK-AREA PIC X(264). 450 ***** redefine working area 1 ***** 460 01 HOTEL-REP REDEFINES WK-AREA. 470 COPY HOTEL. 480 ***** redefine working area 2 ***** 490 01 PLANE-REP REDEFINES WK-AREA. 500 COPY PLANE. 510 ***** redefine working area 3 ***** 520 01 ERRMSG-REP REDEFINES WK-AREA. 530 COPY ERRMSG. 540 ***** typed infomation ***** 550 01 TYPE-REC. 560 COPY TPTYPE. 570 ***** others ***** 580 01 WSTATUS PIC S9(9) COMP-5. 590 ***** dc_rpc_open ***** 600 01 RPC-OP-ARG. 610 02 REQEST PIC X(8) VALUE 'OPEN '. 620 02 STATUS-CODE PIC X(5) VALUE SPACE. 630 02 FILLER PIC X(3). 640 02 FLAGS PIC S9(9) COMP VALUE ZERO. 650 ***** dc_rpc_close ***** 660 01 RPC-CL-ARG. 670 02 REQEST PIC X(8) VALUE 'CLOSE '. 680 02 STATUS-CODE PIC X(5) VALUE SPACE. 690 02 FILLER PIC X(3). 700 02 FLAGS PIC S9(9) COMP VALUE ZERO. 710 * 720 01 ADM-ARG. 730 02 REQUEST PIC X(8) VALUE 'COMPLETE'. 740 02 STATUS-CODE PIC X(5) VALUE SPACE. 750 02 FILLER PIC X(3). 760 02 FLAGS PIC S9(9) COMP VALUE ZERO. 770 02 FILLER PIC X(3). 780 * 790 01 FLAG PIC S9(9) COMP VALUE ZERO. 800 * 810 PROCEDURE DIVISION. 820 * 830 ********************************************************* 840 * RPC-OPEN(UAPの開始) 850 ********************************************************* 860 * 870 CALL 'CBLDCRPC' USING RPC-OP-ARG. 880 IF STATUS-CODE OF RPC-OP-ARG NOT = '00000' THEN 890 DISPLAY 'CLIENT: RPC-OPEN FAILED. CODE = ' 900 STATUS-CODE OF RPC-OP-ARG 910 GO TO PROG-END 920 END-IF. 930 * 940 ********************************************************* 950 * ADM-COMPLETE(ユーザサーバの開始処理完了の報告) 960 ********************************************************* 970 * 980 CALL 'CBLDCADM' USING ADM-ARG. 990 IF STATUS-CODE OF ADM-ARG NOT = '00000' THEN 1000 DISPLAY 'CLIENT: ADM-COMPLETE FAILED. CODE = ' 1010 STATUS-CODE OF ADM-ARG 1020 GO TO PROG-END 1030 END-IF. 1040 * 1050 ********************************************************* 1060 * TPACALL(サービスの要求 (SVHOTEL)) 1070 ********************************************************* 1080 * 1090 ***** set parameters ***** 1100 * 1110 ***** set up HOTELDEF-REC ***** 1120 * 1130 MOVE LOW-VALUES TO HOTELDEF-REC. 1140 MOVE "SVHOTEL" TO SERVICE-NAME OF HOTELDEF-REC. 1150 * 1160 ***** set up HOTELTYPE-REC ***** 1170 * 1180 MOVE "X_COMMON" TO REC-TYPE OF HOTELTYPE-REC. 1190 MOVE "hotel" TO SUB-TYPE OF HOTELTYPE-REC. 1200 COMPUTE LEN OF HOTELTYPE-REC = FUNCTION LENGTH(HOTEL-REQ). 1210 * 1220 ***** set up HOTEL-REQ ***** 1230 * 1240 MOVE 940415 TO RDATE OF HOTEL-REQ. 1250 MOVE "SAPPRO" TO PLACE OF HOTEL-REQ. 1260 MOVE "PRINCE" TO HNAME OF HOTEL-REQ. 1270 MOVE 0 TO RSTATUS OF HOTEL-REQ. 1280 * 1290 ***** CALL TPACALL ***** 1300 CALL "TPACALL" USING 1310 HOTELDEF-REC HOTELTYPE-REC HOTEL-REQ STATUS-REC. 1320 IF NOT TPOK OF STATUS-REC THEN 1330 DISPLAY 'CLIENT: SVHOTEL SERVICE REQ WAS FAIL:ERROR = ' 1340 TP-STATUS OF STATUS-REC 1350 GO TO PROG-END 1360 END-IF. 1370 * 1380 DISPLAY 'CLIENT: SVHOTEL SERVICE REQ WAS SUCCESS '. 1390 * 1400 * 1410 ********************************************************* 1420 * TPCALL(サービスの要求 (SVPLANE)) 1430 ********************************************************* 1440 * 1450 ***** set parameters ***** 1460 * 1470 ***** set up PLANEDEF-REC ***** 1480 * 1490 MOVE LOW-VALUES TO PLANEDEF-REC. 1500 MOVE "SVPLANE" TO SERVICE-NAME OF PLANEDEF-REC. 1510 * 1520 ***** set up PLANETYPE-REC ***** 1530 * 1540 MOVE "X_COMMON" TO REC-TYPE OF PLANETYPE-REC. 1550 MOVE "plane" TO SUB-TYPE OF PLANETYPE-REC. 1560 COMPUTE LEN OF PLANETYPE-REC = FUNCTION LENGTH(PLANE-REQ). 1570 * 1580 ***** set up PLANE-REQ ***** 1590 * 1600 MOVE 940415 TO RDATE OF PLANE-REQ. 1610 MOVE "CHITOSE" TO DEST OF PLANE-REQ. 1620 MOVE 1540 TO DEPARTURE OF PLANE-REQ. 1630 MOVE 0 TO RSTATUS OF PLANE-REQ. 1640 * 1650 * 1660 ***** set up TYPE-REC ***** 1670 * 1680 MOVE "X_COMMON" TO REC-TYPE OF TYPE-REC. 1690 MOVE "plane" TO SUB-TYPE OF TYPE-REC. 1700 COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA). 1710 * 1720 ***** CALL TPCALL ***** 1730 CALL "TPCALL" USING PLANEDEF-REC PLANETYPE-REC PLANE-REQ 1740 TYPE-REC WK-AREA STATUS-REC. 1750 * 1760 * FAILURE CASE 1770 * 1780 IF NOT TPOK OF STATUS-REC THEN 1790 DISPLAY 'CLIENT: SVPLANE SERVICE REQ WAS FAILED' 1800 DISPLAY 'CLIENT: TPCALL WAS FAILED:ERROR=' 1810 TP-STATUS OF STATUS-REC 1820 IF TPESVCFAIL OF STATUS-REC THEN 1830 MOVE ERRMESSAGE IN ERRMSG-REP 1840 TO ERRMESSAGE OF WERRMSG-REC 1850 DISPLAY 'CLIENT: USER CODE = ' 1860 ERRMESSAGE OF WERRMSG-REC 1870 GO TO PROG-END 1880 END-IF 1890 GO TO PROG-END 1900 END-IF. 1910 * 1920 * SUCCESS CASE 1930 * 1940 DISPLAY 'CLIENT: SVPLANE SERVICE REQ WAS SUCCESS '. 1950 MOVE RSTATUS IN PLANE-REP TO WSTATUS. 1960 IF WSTATUS = 1 THEN 1970 DISPLAY 'CLIENT: NO BORDING TICKET' 1980 ELSE 1990 DISPLAY 'CLIENT: A BORDING TICKET WAS FOUND' 2000 END-IF. 2010 * 2020 ********************************************************* 2030 * TPGETRPLY(応答メッセージの受信) 2040 ********************************************************* 2050 * 2060 ***** set parameters ***** 2070 * 2080 ***** set up TYPE-REC ***** 2090 * 2100 MOVE "X_COMMON" TO REC-TYPE OF TYPE-REC. 2110 MOVE "hotel" TO SUB-TYPE OF TYPE-REC. 2120 COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA). 2130 * 2140 ***** CALL TPGETRPLY ***** 2150 CALL "TPGETRPLY" USING HOTELDEF-REC TYPE-REC WK-AREA 2160 STATUS-REC. 2170 * 2180 * FAILURE CASE 2190 * 2200 IF NOT TPOK OF STATUS-REC THEN 2210 DISPLAY 'CLIENT: SVHOTEL SERVICE RSP WAS FAILED ' 2220 DISPLAY 'CLIENT: TPGETRPLY WAS FAILED:ERROR=' 2230 TP-STATUS OF STATUS-REC 2240 IF TPESVCFAIL OF STATUS-REC THEN 2250 MOVE ERRMESSAGE IN ERRMSG-REP 2260 TO ERRMESSAGE OF WERRMSG-REC 2270 DISPLAY 'CLIENT: USER CODE = ' 2280 ERRMESSAGE OF WERRMSG-REC 2290 GO TO PROG-END 2300 END-IF 2310 GO TO PROG-END 2320 END-IF. 2330 * 2340 * SUCCESS CASE 2350 * 2360 DISPLAY 'CLIENT: SVHOTEL SERVICE RSP WAS SUCCESS '. 2370 MOVE RSTATUS IN HOTEL-REP TO WSTATUS. 2380 IF WSTATUS = 1 THEN 2390 DISPLAY 'CLIENT: NO ROOM' 2400 ELSE 2410 DISPLAY 'CLIENT: A ROOM WAS FOUND' 2420 END-IF. 2430 * 2440 ********************************************************* 2450 * 処理の終了 2460 ********************************************************* 2470 * 2480 PROG-END. 2490 * 2500 DISPLAY 'CLIENT: SEE YOU LATER' 2510 * 2520 ********************************************************* 2530 * RPC-CLOSE(UAPの終了) 2540 ********************************************************* 2550 * 2560 CALL 'CBLDCRPC' USING RPC-CL-ARG. 2570 * 2580 STOP RUN.
10 #ユーザサービス定義の例(rrsupファイル) 20 set module = "rrsup" 30 set receive_from = none 40 set trn_expiration_time = 180 50 set trn_expiration_time_suspend = Y
10 /* XATMIインタフェース定義の例（rrsppcb.defファイル）*/
20 X_COMMON hotel {
30 long rdate;
40 char place[128];
50 char hname[128];
60 long rstatus;
70 };
80 X_COMMON plane {
90 long rdate;
100 char dest[128];
110 long departure;
120 long rstatus;
130 };
140 X_COMMON errmsg {
150 char errmessage[128];
160 };
170 service SHOTEL(X_COMMON hotel) ;
180 service SPLANE(X_COMMON plane) ;
10 * 20 ********************************************************* 30 * SPPの例(rrspp.cblファイル) 40 ********************************************************* 50 * 60 IDENTIFICATION DIVISION. 70 * 80 PROGRAM-ID. MAIN. 90 * 100 ********************************************************* 110 * データ領域の設定 120 ********************************************************* 130 * 140 DATA DIVISION. 150 WORKING-STORAGE SECTION. 160 01 RPC-OP-ARG. 170 02 REQEST PIC X(8) VALUE 'OPEN '. 180 02 STATUS-CODE PIC X(5) VALUE SPACE. 190 02 FILLER PIC X(3). 200 02 FLAGS PIC S9(9) COMP VALUE ZERO. 210 * 220 01 RPC-CL-ARG. 230 02 REQEST PIC X(8) VALUE 'CLOSE '. 240 02 STATUS-CODE PIC X(5) VALUE SPACE. 250 02 FILLER PIC X(3). 260 02 FLAGS PIC S9(9) COMP VALUE ZERO. 270 * 280 01 RSV-ARG. 290 02 REQUEST PIC X(8) VALUE 'MAINLOOP'. 300 02 STATUS-CODE PIC X(5) VALUE SPACE. 310 02 FILLER PIC X(3). 320 02 FLAGS PIC S9(9) COMP VALUE ZERO. 330 * 340 PROCEDURE DIVISION. 350 * 360 ********************************************************* 370 * RPC-OPEN(UAPの開始) 380 ********************************************************* 390 * 400 CALL 'CBLDCRPC' USING RPC-OP-ARG. 410 IF STATUS-CODE OF RPC-OP-ARG NOT = '00000' THEN 420 DISPLAY 'SERVER: RPC-OPEN FAILED. CODE = ' 430 STATUS-CODE OF RPC-OP-ARG 440 GO TO PROG-END 450 END-IF. 460 * 470 ********************************************************* 480 * RPC-MAINLOOP(SPPサービスの開始) 490 ********************************************************* 500 * 510 DISPLAY 'SERVER: ENTERING MAINLOOP...' 520 CALL 'CBLDCRSV' USING RSV-ARG. 530 IF STATUS-CODE OF RSV-ARG NOT = '00000' THEN 540 DISPLAY 'SERVER: RPC-MAINLOOP FAILED. CODE = ' 550 STATUS-CODE OF RSV-ARG 560 END-IF. 570 * 580 ********************************************************* 590 * プログラムの終わり 600 ********************************************************* 610 PROG-END. 620 * 630 ********************************************************* 640 * RPC-CLOSE(UAPの終了) 650 ********************************************************* 660 * 670 CALL 'CBLDCRPC' USING RPC-CL-ARG. 680 * 690 ********************************************************* 700 * 処理の終了 710 ********************************************************* 720 * 730 STOP RUN.
リクエスト／レスポンス型サービスの例題で示すSPPのコーディング例（サービスプログラム）を次に示します。
＜SVHOTELサービス用のコーディング例＞
10 * 20 ********************************************************* 30 * SPPのサービス関数例(shotel.cblファイル) 40 ********************************************************* 50 * 60 IDENTIFICATION DIVISION. 70 * 80 PROGRAM-ID. SHOTEL. 90 * 100 ********************************************************* 110 * データ領域の設定 120 ********************************************************* 130 * 140 DATA DIVISION. 150 WORKING-STORAGE SECTION. 160 * 170 ********************************************************* 180 * 変数の宣言 190 ********************************************************* 200 * 210 * TPSVCDEF record 220 * 230 01 SVCDEF-REC. 240 COPY TPSVCDEF. 250 * 260 * TPTYPE record 270 * 280 01 TYPE-REC. 290 COPY TPTYPE. 300 * 310 * TPSTATUS record 320 * 330 01 STATUS-REC. 340 COPY TPSTATUS. 350 * 360 * TPSVCRET record 370 * 380 01 SVCRET-REC. 390 COPY TPSVCRET. 400 * 410 * WK-AREA is where service requests are read into 420 * 430 01 WK-AREA PIC X(264). 440 * 450 01 HOTEL-REC REDEFINES WK-AREA. 460 COPY HOTEL. 470 * 480 ********************************************************* 490 * shotel processing 500 ********************************************************* 510 * 520 PROCEDURE DIVISION. 530 * 540 ***** set length ***** 550 COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA). 560 * 570 ********************************************************* 580 * TPSVCSTART 590 ********************************************************* 600 * 610 CALL "TPSVCSTART" USING 620 SVCDEF-REC TYPE-REC WK-AREA STATUS-REC. 630 * 640 * Shotel return status=0 if the specified hotel can be made 650 * a reservation. Shotel return status=1 if there are no room 660 * in that specified hotel. 670 * In this case, shotel return status=1 because there are no 680 * room. 690 * 700 MOVE 1 TO RSTATUS IN HOTEL-REC. 710 * 720 ********************************************************* 730 * TPRETURN 740 ********************************************************* 750 * 760 SET TPSUCCESS OF SVCRET-REC TO TRUE. 770 MOVE 1 TO APPL-CODE OF SVCRET-REC. 780 * 790 COPY TPRETURN 800 REPLACING TPSVCRET-REC BY SVCRET-REC 810 TPTYPE-REC BY TYPE-REC 820 DATA-REC BY WK-AREA. 830 * 840 ********************************************************* 850 * 処理の終了 860 ********************************************************* 870 * 880 * 890 END PROGRAM SHOTEL.
＜SVPLANEサービス用のコーディング例＞
10 * 20 ********************************************************* 30 * SPPのサービス関数例(splane.cblファイル) 40 ********************************************************* 50 * 60 IDENTIFICATION DIVISION. 70 * 80 PROGRAM-ID. SPLANE. 90 * 100 ********************************************************* 110 * データ領域の設定 120 ********************************************************* 130 * 140 DATA DIVISION. 150 WORKING-STORAGE SECTION. 160 * 170 ********************************************************* 180 * 変数の宣言 190 ********************************************************* 200 * 210 * TPSVCDEF record 220 * 230 01 SVCDEF-REC. 240 COPY TPSVCDEF. 250 * 260 * TPTYPE record 270 * 280 01 TYPE-REC. 290 COPY TPTYPE. 300 * 310 * TPSTATUS record 320 * 330 01 STATUS-REC. 340 COPY TPSTATUS. 350 * 360 * TPSVCRET record 370 * 380 01 SVCRET-REC. 390 COPY TPSVCRET. 400 * 410 * WK-AREA is where service requests are read into 420 * 430 01 WK-AREA PIC X(264). 440 * 450 01 PLANE-REC REDEFINES WK-AREA. 460 COPY PLANE. 470 * 480 ********************************************************* 490 * splane processing 500 ********************************************************* 510 * 520 PROCEDURE DIVISION. 530 * 540 ***** set length ***** 550 COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA). 560 * 570 ********************************************************* 580 * TPSVCSTART 590 ********************************************************* 600 * 610 CALL "TPSVCSTART" USING 620 SVCDEF-REC TYPE-REC WK-AREA STATUS-REC. 630 * 640 * Splane return status=0 if the specified plane can be made 650 * a reservation. Splane return status=1 if there aren't any 660 * ticket in that specified plane. 670 * In this case, splane return status=1 because there are no 680 * room. 690 * 700 MOVE 1 TO RSTATUS IN PLANE-REC. 710 * 720 ********************************************************* 730 * TPRETURN 740 ********************************************************* 750 * 760 SET TPSUCCESS OF SVCRET-REC TO TRUE. 770 MOVE 0 TO APPL-CODE OF SVCRET-REC. 780 * 790 COPY TPRETURN 800 REPLACING TPSVCRET-REC BY SVCRET-REC 810 TPTYPE-REC BY TYPE-REC 820 DATA-REC BY WK-AREA. 830 * 840 ********************************************************* 850 * 処理の終了 860 ********************************************************* 870 * 880 * 890 END PROGRAM SPLANE.
10 #ユーザサービス定義の例(rrsppファイル) 20 set service_group = "rrspp_svg" 30 set module = "rrspp" 40 set service = "SVHOTEL=SHOTEL","SVPLANE=SPLANE" 50 set trn_expiration_time = 180 60 set trn_expiration_time_suspend = Y 70 set server_type = "xatmi_cbl"
ここで示す例題の処理概要を，次に説明します。
[説明] acctreq構造体の構造を持つ型付きバッファサービスでサービスプログラムを起動します。acctreqのメンバは口座番号の上限と下限を示します。サービスプログラムでは，この範囲にある口座データをacctreq構造体の構造を持つ型付きバッファに設定して，会話のオリジネータに送信します。
例題のUAPの構成を次の図に示します。
図6-5 会話型サービスの通信形態
![[図データ]](FIGURE/ZU062100.GIF)
通信に使う型付きバッファの構造体を次に示します。
ACCTREQ.cbl
05 UPPERNO PIC S9(9) COMP-5.
05 LOWERNO PIC S9(9) COMP-5.
05 ACCTNO PIC S9(9) COMP-5.
05 NAME PIC X(128).
05 AMOUNT PIC S9(4) COMP-5.
05 FILLER PIC X(2).
10 /* SUPのXATMIインタフェース定義の例（cvsupcb.defファイル）*/
20 called_servers = { "cvsppcb.def" } ;
10 * 20 ********************************************************* 30 * SUPの例（convsup.cblファイル） 40 ********************************************************* 50 * 60 IDENTIFICATION DIVISION. 70 * 80 PROGRAM-ID. MAIN. 90 * 100 ********************************************************* 110 * データ領域の設定 120 ********************************************************* 130 * 140 DATA DIVISION. 150 WORKING-STORAGE SECTION. 160 ********************************************************* 170 * 定数の宣言 180 ********************************************************* 190 ********************************************************* 200 * 変数の宣言 210 ********************************************************* 220 ***** typed record for INQUARY when inquary service ***** 230 01 ACCTREQ-REC. 240 COPY ACCTREQ. 250 ***** type infomation for INQUARY ***** 260 01 ACCTREQTYPE-REC. 270 COPY TPTYPE. 280 ***** service definition for INQUARY ***** 290 01 ACCTREQDEF-REC. 300 COPY TPSVCDEF. 310 ***** return record ***** 320 01 STATUS-REC. 330 COPY TPSTATUS. 340 ***** received record between INQUARY and CONVSUP 350 01 ACCTDATA-REQ. 360 COPY ACCTDATA. 370 **** type information received record between INQUARY and CONVSUP 380 01 ACCTDATATYPE-REC. 390 COPY TPTYPE. 400 ***** service definition for INQUARY ***** 410 01 ACCTDATADEF-REC. 420 COPY TPSVCDEF. 430 ***** working area is used for replies ***** 440 01 WK-AREA PIC X(136). 450 ***** redefine working area 1 ***** 460 01 ACCTREQ-REP REDEFINES WK-AREA. 470 COPY ACCTREQ. 480 ***** redefine working area 2 ***** 490 01 ACCTDATA-REP REDEFINES WK-AREA. 500 COPY ACCTDATA. 510 ***** typed infomation ***** 520 01 TYPE-REC. 530 COPY TPTYPE. 540 ***** others ***** 550 01 WSTATUS PIC S9(9) COMP-5. 560 ***** dc_rpc_open ***** 570 01 RPC-OP-ARG. 580 02 REQEST PIC X(8) VALUE 'OPEN '. 590 02 STATUS-CODE PIC X(5) VALUE SPACE. 600 02 FILLER PIC X(3). 610 02 FLAGS PIC S9(9) COMP VALUE ZERO. 620 ***** dc_rpc_close ***** 630 01 RPC-CL-ARG. 640 02 REQEST PIC X(8) VALUE 'CLOSE '. 650 02 STATUS-CODE PIC X(5) VALUE SPACE. 660 02 FILLER PIC X(3). 670 02 FLAGS PIC S9(9) COMP VALUE ZERO. 680 ***** dc_adm_complete **** 690 01 ADM-ARG. 700 02 REQUEST PIC X(8) VALUE 'COMPLETE'. 710 02 STATUS-CODE PIC X(5) VALUE SPACE. 720 02 FILLER PIC X(3). 730 02 FLAGS PIC S9(9) COMP VALUE ZERO. 740 02 FILLER PIC X(3). 750 * 760 01 FLAG PIC S9(9) COMP VALUE ZERO. 770 * 780 ****** for TX interface ***** 790 * 800 01 TX-RETURN-STATUS. 810 COPY TXSTATUS. 820 * 830 01 RS REDEFINES TX-RETURN-STATUS. 840 05 RSVAL PIC S9(9) COMP-5. 850 * 860 01 TX-INFO-AREA. 870 COPY TXINFDEF. 880 * 890 PROCEDURE DIVISION. 900 * 910 ********************************************************* 920 * RPC-OPEN(UAPの開始) 930 ********************************************************* 940 * 950 CALL 'CBLDCRPC' USING RPC-OP-ARG. 960 IF STATUS-CODE OF RPC-OP-ARG NOT = '00000' THEN 970 DISPLAY 'CLIENT: RPC-OPEN FAILED. CODE = ' 980 STATUS-CODE OF RPC-OP-ARG 990 GO TO PROG-END 1000 END-IF. 1010 * 1020 ********************************************************* 1030 * TXOPEN(リソースマネジャのオープン) 1040 ********************************************************* 1050 * 1060 CALL "TXOPEN" USING TX-RETURN-STATUS. 1070 IF RSVAL OF RS NOT = 0 THEN 1080 DISPLAY 'CLIENT:TX-OPEN FAILED. CODE = ' 1090 RSVAL OF RS 1100 GO TO PROG-END 1110 END-IF. 1120 * 1130 ********************************************************* 1140 * TX-SET-TRANSACTION-TIMEOUT(トランザクション監視時間の設定) 1150 ********************************************************* 1160 * 1170 MOVE 180 TO TRANSACTION-TIMEOUT OF TX-INFO-AREA. 1180 CALL "TXSETTIMEOUT" USING TX-INFO-AREA TX-RETURN-STATUS. 1190 IF RSVAL OF RS NOT = 0 THEN 1200 DISPLAY 'CLIENT:TX-SET-TRANSACTION-TIMEOUT FAILED. CODE = ' 1210 RSVAL OF RS 1220 GO TO PROG-END 1230 END-IF. 1240 * 1250 ********************************************************* 1260 * ADM-COMPLETE(ユーザサーバの開始処理完了の報告) 1270 ********************************************************* 1280 * 1290 CALL 'CBLDCADM' USING ADM-ARG. 1300 IF STATUS-CODE OF ADM-ARG NOT = '00000' THEN 1310 DISPLAY 'CLIENT: ADM-COMPLETE FAILED. CODE = ' 1320 STATUS-CODE OF ADM-ARG 1330 GO TO PROG-END 1340 END-IF. 1350 * 1360 ********************************************************* 1370 * TX-SET-TRANSACTION-CONTROL(非連鎖モード設定) 1380 ********************************************************* 1390 * 1400 MOVE 0 TO TRANSACTION-CONTROL OF TX-INFO-AREA. 1410 CALL "TXSETTRANCTL" USING TX-INFO-AREA TX-RETURN-STATUS. 1420 IF RSVAL OF RS NOT = 0 THEN 1430 DISPLAY 'CLIENT:TX-SET-TRANSACTION-CONTROL FAILED. CODE =' 1440 RSVAL OF RS 1450 END-IF. 1460 * 1470 ********************************************************* 1480 * TPXBEGIN(トランザクションの始まり) 1490 ********************************************************* 1500 * 1510 CALL "TXBEGIN" USING TX-RETURN-STATUS. 1520 IF RSVAL OF RS NOT = 0 THEN 1530 DISPLAY 'CLIENT:TX-BEGIN FAILED. CODE =' 1540 RSVAL OF RS 1550 GO TO PROG-END 1560 END-IF. 1570 * 1580 ********************************************************* 1590 * TPCONNECT(サービス要求 (INQUARY)) 1600 ********************************************************* 1610 * 1620 ***** set parameters ***** 1630 * 1640 ***** set up ACCTREQDEF-REC ***** 1650 * 1660 MOVE LOW-VALUES TO ACCTREQDEF-REC. 1670 MOVE 1 TO TPSENDRECV-FLAG OF ACCTREQDEF-REC. 1680 MOVE "INQUIRY" TO SERVICE-NAME OF ACCTREQDEF-REC. 1690 * 1700 ***** set up ACCTREQTYPE-REC ***** 1710 * 1720 MOVE "X_COMMON" TO REC-TYPE OF ACCTREQTYPE-REC. 1730 MOVE "acctreq" TO SUB-TYPE OF ACCTREQTYPE-REC. 1740 COMPUTE LEN OF ACCTREQTYPE-REC = FUNCTION LENGTH(ACCTREQ-REC). 1750 * 1760 ***** set up ACCTREQ-REC ***** 1770 * 1780 MOVE "100000000" TO LOWERNO OF ACCTREQ-REC. 1790 MOVE "200000000" TO UPPERNO OF ACCTREQ-REC. 1800 * 1810 ***** CALL TPCONNECT ***** 1820 CALL "TPCONNECT" USING 1830 ACCTREQDEF-REC ACCTREQTYPE-REC ACCTREQ-REC STATUS-REC. 1840 IF NOT TPOK OF STATUS-REC THEN 1850 DISPLAY 'CLIENT: INQUARY SERVICE REQ WAS FAIL. CODE = ' 1860 TP-STATUS OF STATUS-REC 1870 DISPLAY 'CLIENT:TX-ROLLBACK STARTED' 1880 CALL "TXROLLBACK" USING TX-RETURN-STATUS 1890 DISPLAY 'CLIENT:TX-ROLLBACK ENDED' 1900 IF RSVAL OF RS NOT = 0 THEN 1910 DISPLAY 'CLIENT:TX-ROLLBACK FAILED. CODE =' 1920 RSVAL OF RS 1930 END-IF 1940 GO TO PROG-END 1950 END-IF. 1960 * 1970 DISPLAY 'CLIENT: INQUARY SERVICE REQ WAS SUCCESS '. 1980 * 1990 ***** set up ACCTDATA-REC ***** 2000 * 2010 MOVE 0 TO TP-STATUS OF STATUS-REC. 2020 MOVE LOW-VALUES TO ACCTDATADEF-REC. 2030 MOVE COMM-HANDLE OF ACCTREQDEF-REC TO 2040 COMM-HANDLE OF ACCTDATADEF-REC. 2050 MOVE "X_COMMON" TO REC-TYPE OF ACCTDATATYPE-REC. 2060 MOVE "acctdata" TO SUB-TYPE OF ACCTDATATYPE-REC. 2070 COMPUTE LEN OF ACCTDATATYPE-REC = FUNCTION LENGTH(ACCTDATA-REQ). 2080 * 2090 PERFORM WITH TEST AFTER UNTIL NOT TPOK OF STATUS-REC 2100 * 2110 ********************************************************* 2120 * TPRECV(データの受信) 2130 ********************************************************* 2140 MOVE 0 TO TP-STATUS OF STATUS-REC 2150 CALL "TPRECV" USING 2160 ACCTDATADEF-REC ACCTDATATYPE-REC WK-AREA STATUS-REC 2170 IF TPOK OF STATUS-REC THEN 2180 DISPLAY 'CLIENT: RECEIVED ACOUNT INFORMATION ' 2190 DISPLAY 'CLIENT: ACCOUNT NUMBER =' 2200 ACCTNO IN ACCTDATA-REP 2210 DISPLAY 'CLIENT: NAME =' ANAME IN ACCTDATA-REP 2220 DISPLAY 'CLIENT: AMOUNT =' AMOUNT IN ACCTDATA-REP 2230 END-IF 2240 END-PERFORM. 2250 * 2260 IF TPEEVENT OF STATUS-REC THEN 2270 IF TPEV-SVCSUCC OF STATUS-REC THEN 2280 DISPLAY 'CLIENT:INQUARY SERVICE SUCCESS' 2290 * 2300 ********************************************************* 2310 * TX-COMMIT(トランザクションのコミット) 2320 ********************************************************* 2330 * 2340 DISPLAY 'CLIENT:TX-COMMIT STARTED' 2350 CALL "TXCOMMIT" USING TX-RETURN-STATUS 2360 DISPLAY 'CLIENT:TX-COMMIT ENDED' 2370 IF RSVAL OF RS NOT = 0 THEN 2380 DISPLAY 'CLIENT:TX-COMMIT FAILED. CODE =' 2390 RSVAL OF RS 2400 END-IF 2410 ELSE 2420 DISPLAY 'CLIENT:EVENT OCCURED IN INQUARY SERVICE' 2430 DISPLAY 'CODE =' TPEVENT OF STATUS-REC 2440 * 2450 ********************************************************* 2460 * TX-ROLLBAK(トランザクションのロールバック) 2470 ********************************************************* 2480 * 2490 DISPLAY 'CLIENT:TX-ROLLBACK STARTED' 2500 CALL "TXROLLBACK" USING TX-RETURN-STATUS 2510 DISPLAY 'CLIENT:TX-ROLLBACK ENDED' 2520 IF RSVAL OF RS NOT = 0 THEN 2530 DISPLAY 'CLIENT:TX-ROLLBACK FAILED. CODE =' 2540 RSVAL OF RS 2550 END-IF 2560 END-IF 2570 ELSE 2580 DISPLAY 'CLIENT:EVENT OCCURED IN INQUARY SERVICE' 2590 DISPLAY 'CODE =' TPEVENT OF STATUS-REC 2600 * 2610 ********************************************************* 2620 * TX-ROLLBAK(トランザクションのロールバック) 2630 ********************************************************* 2640 * 2650 DISPLAY 'CLIENT:TX-ROLLBACK STARTED' 2660 CALL "TXROLLBACK" USING TX-RETURN-STATUS 2670 DISPLAY 'CLIENT:TX-ROLLBACK ENDED' 2680 IF RSVAL OF RS NOT = 0 THEN 2690 DISPLAY 'CLIENT:TX-ROLLBACK FAILED. CODE =' 2700 RSVAL OF RS 2710 END-IF 2720 END-IF. 2730 * 2740 ********************************************************* 2750 * 処理の終了 2760 ********************************************************* 2770 * 2780 PROG-END. 2790 * 2800 DISPLAY 'CLIENT: SEE YOU LATER' 2810 * 2820 ********************************************************* 2830 * RPC-CLOSE(UAPの終了) 2840 ********************************************************* 2850 * 2860 CALL 'CBLDCRPC' USING RPC-CL-ARG. 2870 * 2880 STOP RUN.
10 #ユーザサービス定義の例(convsupファイル) 20 set module = "convsup" #実行形式ファイル名 30 set watch_time = 180 #最大応答待ち時間 40 set receive_from = none #受信方法 50 set trn_expiration_time = 180 60 #トランザクションブランチ限界経過時間 70 set trn_expiration_time_suspend = Y #必ず Y を指定
10 /* SPPのXATMIインタフェース定義の例（cvsppcb.defファイル）*/
20 X_COMMON acctreq {
30 long upperno;
40 long lowerno;
50 };
60 X_COMMON acctdata {
70 long acctno;
80 char aname[128];
90 short amount;
100 };
110 service INQUIRY(X_COMMON acctreq) ;
10 * 20 ********************************************************* 30 * SPPの例（convspp.cblファイル） 40 ********************************************************* 50 * 60 IDENTIFICATION DIVISION. 70 * 80 PROGRAM-ID. MAIN. 90 * 100 ********************************************************* 110 * データ領域の設定 120 ********************************************************* 130 * 140 DATA DIVISION. 150 WORKING-STORAGE SECTION. 160 01 RPC-OP-ARG. 170 02 REQEST PIC X(8) VALUE 'OPEN '. 180 02 STATUS-CODE PIC X(5) VALUE SPACE. 190 02 FILLER PIC X(3). 200 02 FLAGS PIC S9(9) COMP VALUE ZERO. 210 * 220 01 RPC-CL-ARG. 230 02 REQEST PIC X(8) VALUE 'CLOSE '. 240 02 STATUS-CODE PIC X(5) VALUE SPACE. 250 02 FILLER PIC X(3). 260 02 FLAGS PIC S9(9) COMP VALUE ZERO. 270 * 280 01 RSV-ARG. 290 02 REQUEST PIC X(8) VALUE 'MAINLOOP'. 300 02 STATUS-CODE PIC X(5) VALUE SPACE. 310 02 FILLER PIC X(3). 320 02 FLAGS PIC S9(9) COMP VALUE ZERO. 330 * 340 PROCEDURE DIVISION. 350 * 360 ********************************************************* 370 * RPC-OPEN(UAPの開始) 380 ********************************************************* 390 * 400 CALL 'CBLDCRPC' USING RPC-OP-ARG. 410 IF STATUS-CODE OF RPC-OP-ARG NOT = '00000' THEN 420 DISPLAY 'SERVER: RPC-OPEN FAILED. CODE = ' 430 STATUS-CODE OF RPC-OP-ARG 440 GO TO PROG-END 450 END-IF. 460 * 470 ********************************************************* 480 * RPC-MAINLOOP(SPPサービスの開始) 490 ********************************************************* 500 * 510 DISPLAY 'SERVER: ENTERING MAINLOOP...' 520 CALL 'CBLDCRSV' USING RSV-ARG. 530 IF STATUS-CODE OF RSV-ARG NOT = '00000' THEN 540 DISPLAY 'SERVER: RPC-MAINLOOP FAILED. CODE = ' 550 STATUS-CODE OF RSV-ARG 560 END-IF. 570 * 580 ********************************************************* 590 * プログラムの終了 600 ********************************************************* 610 PROG-END. 620 * 630 ********************************************************* 640 * RPC-CLOSE(UAPの終了) 650 ********************************************************* 660 * 670 CALL 'CBLDCRPC' USING RPC-CL-ARG. 680 * 690 ********************************************************* 700 * 処理の終了 710 ********************************************************* 720 * 730 STOP RUN.
10 * 20 ********************************************************* 30 * INQUIRY サービスプログラム(convsvc.cblファイル) 40 ********************************************************* 50 * 60 IDENTIFICATION DIVISION. 70 * 80 PROGRAM-ID. INQUIRY. 90 * 100 ********************************************************* 110 * データ領域の設定 120 ********************************************************* 130 * 140 DATA DIVISION. 150 WORKING-STORAGE SECTION. 160 * 170 ********************************************************* 180 * 変数の宣言 190 ********************************************************* 200 * 210 * TPSVCDEF record 220 * 230 01 SVCDEF-REC. 240 COPY TPSVCDEF. 250 * 260 * TPTYPE record 270 * 280 01 TYPE-REC. 290 COPY TPTYPE. 300 * 310 * TPSTATUS record 320 * 330 01 STATUS-REC. 340 COPY TPSTATUS. 350 * 360 * TPSVCRET record 370 * 380 01 SVCRET-REC. 390 COPY TPSVCRET. 400 * 410 * WK-AREA is where service requests are read into 420 * 430 01 WK-AREA PIC X(136). 440 * 450 01 ACCTREQ-REC REDEFINES WK-AREA. 460 COPY ACCTREQ. 470 * 480 01 ACCTDATA-REC. 490 COPY ACCTDATA. 500 * 510 * TPSVCDEF record for TPSEND 520 * 530 01 ACCTDATADEF-REC. 540 COPY TPSVCDEF. 550 * 560 * TPTYPE record for TPSEND 570 * 580 01 ACCTDATATYPE-REC. 590 COPY TPTYPE. 600 * 610 * 620 ********************************************************* 630 * 照会処理 640 ********************************************************* 650 * 660 PROCEDURE DIVISION. 670 * 680 ***** set length ***** 690 COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA). 700 * 710 ********************************************************* 720 * TPSVCSTART 730 ********************************************************* 740 * 750 CALL "TPSVCSTART" USING 760 SVCDEF-REC TYPE-REC WK-AREA STATUS-REC. 770 * 780 * find user data files between lower and upper account number. 790 * In this case 2 data was found, and was replied. 800 * 810 ********************************************************* 820 * 送信データの設定 830 ********************************************************* 840 MOVE LOW-VALUES TO ACCTDATADEF-REC. 850 MOVE COMM-HANDLE OF SVCDEF-REC TO COMM-HANDLE OF ACCTDATADEF-REC. 860 MOVE "X_COMMON" TO REC-TYPE OF ACCTDATATYPE-REC. 870 MOVE "acctdata" TO SUB-TYPE OF ACCTDATATYPE-REC. 880 COMPUTE LEN OF ACCTDATATYPE-REC = 890 FUNCTION LENGTH(ACCTDATA-REC). 900 * 910 ********************************************************* 920 * TPSEND(第1データの送信) 930 ********************************************************* 940 * 950 MOVE "10000001" TO ACCTNO OF ACCTDATA-REC. 960 MOVE "HITACHI HANAKO" TO ANAME OF ACCTDATA-REC. 970 MOVE "2000" TO AMOUNT OF ACCTDATA-REC. 980 CALL "TPSEND" USING ACCTDATADEF-REC ACCTDATATYPE-REC 990 ACCTDATA-REC STATUS-REC. 1000 IF TPOK OF STATUS-REC THEN 1010 MOVE 0 TO TP-RETURN-VAL OF SVCRET-REC 1020 ELSE 1030 MOVE 1 TO TP-RETURN-VAL OF SVCRET-REC 1040 GO TO PROG-END 1050 END-IF 1060 * 1070 ********************************************************* 1080 * TPSEND(第2データの送信) 1090 ********************************************************* 1100 * 1110 MOVE "10000002" TO ACCTNO OF ACCTDATA-REC. 1120 MOVE "HITACHI TAROU" TO ANAME OF ACCTDATA-REC. 1130 MOVE "1000" TO AMOUNT OF ACCTDATA-REC. 1140 CALL "TPSEND" USING ACCTDATADEF-REC ACCTDATATYPE-REC 1150 ACCTDATA-REC STATUS-REC. 1160 IF TPOK OF STATUS-REC THEN 1170 MOVE 0 TO TP-RETURN-VAL OF SVCRET-REC 1180 ELSE 1190 MOVE 1 TO TP-RETURN-VAL OF SVCRET-REC 1200 GO TO PROG-END 1210 END-IF 1220 * 1230 ********************************************************* 1240 * TPRETURN(受信プログラムの終了) 1250 ********************************************************* 1260 * 1270 SET TPSUCCESS OF SVCRET-REC TO TRUE. 1280 MOVE 1 TO APPL-CODE OF SVCRET-REC. 1290 * 1300 PROG-END. 1310 * 1320 MOVE " " TO REC-TYPE OF TYPE-REC. 1330 MOVE " " TO SUB-TYPE OF TYPE-REC. 1340 MOVE 0 TO LEN OF TYPE-REC. 1350 COPY TPRETURN 1360 REPLACING TPSVCRET-REC BY SVCRET-REC 1370 TPTYPE-REC BY TYPE-REC 1380 DATA-REC BY WK-AREA. 1390 * 1400 ********************************************************* 1410 * 処理の終了 1420 ********************************************************* 1430 * 1440 * 1450 END PROGRAM INQUIRY.
10 # ユーザサービス定義の例(convsppファイル)
20 set service_group = "convspp_svg" #サービスグループ名
30 set module = "convspp" #実行形式ファイル名
40 set service = "INQUIRY=INQUIRY"
50 #サービス名=エントリポイント名
60 set watch_time = 180 #最大応答待ち時間
70 set trn_expiration_time = 240
80 #トランザクションブランチ限界経過時間
90 set trn_expiration_time_suspend = Y #必ず Y を指定
100 set server_type = "xatmi_cbl" #サーバタイプ
110 set receive_from = "socket" #受信方法
All Rights Reserved. Copyright (C) 2006, 2012, Hitachi, Ltd.