ここで示す例題の処理概要を,次に説明します。
[説明]宿泊施設の空き状況を調べるサービスと,飛行機の空き状況を調べるサービスを,SUPから呼びます。前者は非同期に,後者は同期的に応答を受信します。
例題のUAPの構成を次の図に示します。
図6-4 同期的に応答を受信するリクエスト/レスポンス型サービスの通信形態
通信に使う型付きバッファの構造体を次に示します。
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 会話型サービスの通信形態
通信に使う型付きバッファの構造体を次に示します。
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" #受信方法