000010 IDENTIFICATION DIVISION. 000020 PROGRAM-ID. RCXGSOAP. 000030 AUTHOR. REDVERS CONSULTING LTD. 000040****************************************************************** 000050* This program generates a sample SOAP XML document using the * 000060* Redvers COBOL XML Interface generator subroutine RCXMLGEN. * 000070****************************************************************** 000080 ENVIRONMENT DIVISION. 000090 000100 DATA DIVISION. 000110 000120 WORKING-STORAGE SECTION. 000130 000140*** Start of COBOL Record Definition (CRD) 000150 01 ENV-ENVELOPE. 000160 03 XMLNS-ENV PIC X(60). 000170 03 XMLNS-APPH PIC X(60). 000180 03 XMLNS-APPB PIC X(60). 000190 03 ENV-HEADER. 000200 05 APPH-RESERVATION. 000210 07 ENV-UNDERSTAND PIC X(5). 000220 07 APPH-REFNO PIC Z(7)9. 000230 07 APPH-TIMESTAMP PIC X(23). 000240 03 ENV-BODY. 000250 05 APPB-RES-DETAILS. 000260 07 APPB-TRAIN. 000270 09 APPB-DATE PIC 99/99/9999. 000280 09 APPB-TIME PIC X(5). 000290 09 APPB-FROM PIC X(20). 000300 09 APPB-TO PIC X(20). 000310 09 APPB-SEAT PIC X(3). 000320 07 APPB-PASSENGER. 000330 09 APPB-NAME PIC X(20). 000340 07 APPB-PRICE. 000350 09 APPB-AMOUNT PIC $$$,$$9.99. 000360 09 APPB-COMMENTS PIC X(80) 000370 OCCURS 10. 000380*** End of COBOL Record Definition (CRD) 000390 000400*** Start of the CRD SOURCE AREA 000410 01 CRD-SOURCE-AREA. 000420 03 FILLER PIC X(80) VALUE 000430 "000000 01 ENV-ENVELOPE. ". 000440 03 FILLER PIC X(80) VALUE 000450 "000000* ". 000460 03 FILLER PIC X(80) VALUE 000470 "000000 03 XMLNS-ENV PIC X(60). ". 000480 03 FILLER PIC X(80) VALUE 000490 "000000* ". 000500 03 FILLER PIC X(80) VALUE 000510 "000000 03 XMLNS-APPH PIC X(60). ". 000520 03 FILLER PIC X(80) VALUE 000530 "000000* ". 000540 03 FILLER PIC X(80) VALUE 000550 "000000 03 XMLNS-APPB PIC X(60). ". 000560 03 FILLER PIC X(80) VALUE 000570 "000000* ". 000580 03 FILLER PIC X(80) VALUE 000590 "000000 03 ENV-HEADER. ". 000600 03 FILLER PIC X(80) VALUE 000610 "000000* ". 000620 03 FILLER PIC X(80) VALUE 000630 "000000 05 APPH-RESERVATION. ". 000640 03 FILLER PIC X(80) VALUE 000650 "000000* ". 000660 03 FILLER PIC X(80) VALUE 000670 "000000 07 ENV-UNDERSTAND PIC X(5). ". 000680 03 FILLER PIC X(80) VALUE 000690 "000000* ". 000700 03 FILLER PIC X(80) VALUE 000710 "000000 07 APPH-REFNO PIC Z(7)9. ". 000720 03 FILLER PIC X(80) VALUE 000730 "000000* ". 000740 03 FILLER PIC X(80) VALUE 000750 "000000 07 APPH-TIMESTAMP PIC X(23). ". 000760 03 FILLER PIC X(80) VALUE 000770 "000000* ". 000780 03 FILLER PIC X(80) VALUE 000790 "000000 03 ENV-BODY. ". 000800 03 FILLER PIC X(80) VALUE 000810 "000000* ". 000820 03 FILLER PIC X(80) VALUE 000830 "000000 05 APPB-RES-DETAILS. ". 000840 03 FILLER PIC X(80) VALUE 000850 "000000* ". 000860 03 FILLER PIC X(80) VALUE 000870 "000000 07 APPB-TRAIN. ". 000880 03 FILLER PIC X(80) VALUE 000890 "000000* ". 000900 03 FILLER PIC X(80) VALUE 000910 "000000 09 APPB-DATE PIC 99/99/9999.". 000920 03 FILLER PIC X(80) VALUE 000930 "000000* ". 000940 03 FILLER PIC X(80) VALUE 000950 "000000 09 APPB-TIME PIC X(5). ". 000960 03 FILLER PIC X(80) VALUE 000970 "000000* ". 000980 03 FILLER PIC X(80) VALUE 000990 "000000 09 APPB-FROM PIC X(20). ". 001000 03 FILLER PIC X(80) VALUE 001010 "000000* ". 001020 03 FILLER PIC X(80) VALUE 001030 "000000 09 APPB-TO PIC X(20). ". 001040 03 FILLER PIC X(80) VALUE 001050 "000000* ". 001060 03 FILLER PIC X(80) VALUE 001070 "000000 09 APPB-SEAT PIC X(3). ". 001080 03 FILLER PIC X(80) VALUE 001090 "000000* ". 001100 03 FILLER PIC X(80) VALUE 001110 "000000 07 APPB-PASSENGER. ". 001120 03 FILLER PIC X(80) VALUE 001130 "000000* ". 001140 03 FILLER PIC X(80) VALUE 001150 "000000 09 APPB-NAME PIC X(20). ". 001160 03 FILLER PIC X(80) VALUE 001170 "000000* ". 001180 03 FILLER PIC X(80) VALUE 001190 "000000 07 APPB-PRICE. ". 001200 03 FILLER PIC X(80) VALUE 001210 "000000* ". 001220 03 FILLER PIC X(80) VALUE 001230 "000000 09 APPB-AMOUNT PIC $$$,$$9.99.". 001240 03 FILLER PIC X(80) VALUE 001250 "000000* ". 001260 03 FILLER PIC X(80) VALUE 001270 "000000 09 APPB-COMMENTS PIC X(80) ". 001280 03 FILLER PIC X(80) VALUE 001290 "000000 OCCURS 10. ". 001300 03 FILLER PIC X(80) VALUE 001310 "000000* ". 001320*** End of the CRD SOURCE AREA 001330 001340*** Storage area for the largest possible XML document: 001350 01 XML-DOCUMENT PIC X(16000) VALUE SPACE. 001360 001370 01 WS-OTHER-PARAMETERS. 001380 03 WS-COBOL-RECORD-LENGTH PIC S9(8) BINARY VALUE ZERO. 001390 03 WS-CRD-SOURCE-COUNT PIC S9(8) BINARY VALUE ZERO. 001400 03 WS-XML-DOCUMENT-LENGTH PIC S9(8) BINARY VALUE ZERO. 001410 03 WS-FEEDBACK-CODE PIC S9(4) BINARY VALUE ZERO. 001420 03 WS-FEEDBACK-TEXT PIC X(80) VALUE SPACE. 001430 001440 PROCEDURE DIVISION. 001450 001460 TOP-LEVEL SECTION. 001470****************************************************************** 001480* This section populates the CRD with application data and * 001490* performs the section that calls RCXMLGEN. * 001500****************************************************************** 001510 TOP-ENTER. 001520 001530 INITIALIZE ENV-ENVELOPE. 001540 001550 MOVE "http://www.w3.org/2003/05/soap-envelope" 001560 TO XMLNS-ENV. 001570 MOVE "http://www.redversconsulting.com/schema/apphead" 001580 TO XMLNS-APPH. 001590 MOVE "http://www.redversconsulting.com/schema/appbody" 001600 TO XMLNS-APPB. 001610 001620 MOVE "true" TO ENV-UNDERSTAND. 001630 MOVE 1234567 TO APPH-REFNO. 001640 MOVE "2015-06-24T14:26:59.125" 001650 TO APPH-TIMESTAMP. 001660 001670 MOVE 07042015 TO APPB-DATE. 001680 MOVE "09:30" TO APPB-TIME. 001690 MOVE "New York" TO APPB-FROM. 001700 MOVE "Chicago" TO APPB-TO. 001710 MOVE "57B" TO APPB-SEAT. 001720 001730 MOVE "John Smith" TO APPB-NAME. 001740 001750 MOVE 1234.25 TO APPB-AMOUNT. 001760 MOVE "Includes lunch & dinner." 001770 TO APPB-COMMENTS (1). 001780 STRING QUOTE "Have a nice day!" QUOTE 001790 DELIMITED BY SIZE 001800 INTO APPB-COMMENTS (2). 001810 001820 PERFORM A-CALL-RCXMLGEN. 001830 001840*** Display the XML document and processing complete message: 001850 DISPLAY XML-DOCUMENT (1:WS-XML-DOCUMENT-LENGTH). 001860 DISPLAY WS-FEEDBACK-TEXT. 001870 001880 STOP RUN. 001890 001900 TOP-EXIT. 001910 EXIT. 001920 001930 A-CALL-RCXMLGEN SECTION. 001940****************************************************************** 001950* This section executes the CALL to the interface and checks * 001960* the feedback code. * 001970****************************************************************** 001980 A-ENTER. 001990 002000 COMPUTE WS-CRD-SOURCE-COUNT = LENGTH OF CRD-SOURCE-AREA / 80. 002010 MOVE LENGTH OF ENV-ENVELOPE TO WS-COBOL-RECORD-LENGTH. 002020 MOVE LENGTH OF XML-DOCUMENT TO WS-XML-DOCUMENT-LENGTH. 002030 002040 CALL "RCXMLGEN" USING ENV-ENVELOPE 002050 WS-COBOL-RECORD-LENGTH 002060 CRD-SOURCE-AREA 002070 WS-CRD-SOURCE-COUNT 002080 XML-DOCUMENT 002090 WS-XML-DOCUMENT-LENGTH 002100 WS-FEEDBACK-CODE 002110 WS-FEEDBACK-TEXT. 002120 002130 IF WS-FEEDBACK-CODE > 10 002140 DISPLAY "BAD RETURN FROM RCXMLGEN - FEEDBACK CODE IS " 002150 WS-FEEDBACK-CODE 002160 DISPLAY " MESSAGE READS: " WS-FEEDBACK-TEXT 002170 STOP RUN 002180 END-IF. 002190 002200 A-EXIT. 002210 EXIT.