diff --git a/COBOL Programming Course #3 - Advanced Topics/COBOL Programming Course #3 - Advanced Topics.md b/COBOL Programming Course #3 - Advanced Topics/COBOL Programming Course #3 - Advanced Topics.md index defb114e..849ec90c 100644 --- a/COBOL Programming Course #3 - Advanced Topics/COBOL Programming Course #3 - Advanced Topics.md +++ b/COBOL Programming Course #3 - Advanced Topics/COBOL Programming Course #3 - Advanced Topics.md @@ -743,8 +743,570 @@ Output: {"WS-TEXT":{"WS-MSG":"Hello, World!"}} ``` +## Processing XML input + +The XML PARSE statement can be used in a COBOL program to handle XML input. The COBOL language interface to either of two fast XML parsers is the XML PARSE statement. You choose the best parser for your application using the XMLPARSE compiler option: +The z/OS XML System Services parser is selected by XMLPARSE(XMLSS). +This option offers improved features like namespace processing, XML document validation in accordance with an XML schema, and text fragment conversion to national character representation (Unicode UTF-16). + The COBOL library's integrated XML parser is chosen by XMLPARSE(COMPAT). The XML parser and a processing procedure where you handle parser events exchange control as you process XML input. +To process XML input, use the COBOL facilities listed below: +the XML PARSE statement, which identifies the source XML document, the processing method, and the start of XML parsing. +The XML PARSE statement's additional optional clauses can be used as well: + ENCODING to define the XML document's encoding + VALIDATING to specify the XML schema that the XML document should be validated against + Receiving and processing XML events and any associated document fragments before returning them to the parser for further processing is the processing procedure used to control parsing. + Unique registers for information exchange between the parser and the processing method: + XML-CODE to learn how well the XML parsing is going and, in some cases, to return data to the parser + XML-EVENT to ask the parser for the names of each XML event + A method for quickly determining whether an XML event is complete is provided by XML-INFORMATION. + For XML document fragments that are returned as national + character data, use XML-NTEXT. + Receiving document fragments as alphanumeric data via XML-TEXT + To receive a namespace identifier for an element name or attribute name that is in a namespace, use the tags XML-NAMESPACE or XML-NNAMESPACE. + Use the tags XML-NAMESPACE-PREFIX or XML-NNAMESPACE-PREFIX to + request a namespace prefix for an NAMESPACE-DECLARATION XML event, an element name, or an attribute name. + The XML PARSE statement's optional RETURNING NATIONAL clause can be used to + specify that alphanumeric data items containing XML document fragments should be converted to UTF-16 and then processed using the national special registers XML- NTEXT, XML-NNAMESPACE, and XML-NNAMESPACE-PREFIX. +Only when XMLPARSE(XMLSS) is active can you use the XML PARSE statement's ENCODING, VALIDATING, and RETURNING NATIONAL phrases. + +### XML parser in COBOL +With the help of COBOL's event-based interface, you can parse XML files and convert them into COBOL data structures. +The processing procedure acts on the fragments that the XML parser finds in the source XML document. The fragments are linked to specific XML events, and you must program the processing method to address each individual XML event. +The parsing process is started and the parser's processing protocol is established upon execution of the XML PARSE statement. For each XML event it encounters while analysing the document, the parser hands off control to the processing procedure. +The processing procedure automatically hands back control to the parser after processing the event. The parser continues to examine the XML document after each typical return from the processing procedure in order to report the subsequent event. During this operation, control alternates between the parser and the processing method. +A high-level view of the fundamental control transfer between the parser and your COBOL program is provided in the following figure. +// +![](Images/xml_flow.png) + +Parsing typically goes on until the entire XML document has been processed. + +### Accessing XML documents +You must first make the XML document accessible to your program in order to parse it using an XML PARSE statement. An XML document can typically be obtained by reading it from a file, a WebSphere® MQ message, a CICS® transient queue or communication area, an IMS message processing queue, or a transient queue or communication area. +Use standard COBOL facilities to insert the XML file into a data item in your program if the XML document you want to parse is stored in a file: + a FILE-CONTROL entry for your program's definition of the file. + a file-opening OPEN statement. + To read every record from the file into a data item, use READ statements (either an elementary item of category alphanumeric or national, or an alphanumeric or national group). Either the LOCAL-STORAGE SECTION or the WORKING-STORAGE SECTION can define the data item. + Optionally, use the STRING statement to handle variable-length records, remove extraneous blanks, and string together all of the individual records into a single continuous stream. +You can parse an XML document that is stored in a file if the XMLPARSE(XMLSS) option is enabled by sending the parser one record (or text segment) from the file at a time. The ability to parse very large XML documents is helpful. + +### Parsing XML documents + +#### Writing procedures to process XML +Include code statements to handle XML events in your processing procedure. +The parser sends data to the processing procedure in a number of specialised registers for each event it encounters. Utilize the information in those unique registers to control and populate COBOL data structures. +To find out which event the parser sent to the processing procedure, look in the XML-EVENT special register. +An event name, like "START-OF-ELEMENT," is contained in the XML-EVENT tag. +From the XML-TEXT or XML-NTEXT special register, retrieve the text related to the event. +If the XMLPARSE(XMLSS) option is enabled, you can check the special registers XML- NAMESPACE or XML-NNAMESPACE to see if there is a namespace identifier, if any, associated with the XML event, and XML-NAMESPACE-PREFIX or XML-NNAMESPACE- PREFIX to see if there is a prefix. +The XML special registers are implicitly defined as GLOBAL in the outermost program when used in nested programs. +By following this following link you can check table containing more information about the XML special registers: + +https://www.ibm.com/docs/en/cobol-zos/6.4?topic=documents-writing-procedures-process- xml#:~:text=Table%201.%20Special%20registers%20used%20by%20the%20XML%20parser + +Restrictions: + An XML PARSE statement may not be executed by a processing function directly. However, if a processing procedure uses an INVOKE or CALL statement to transfer control to a method or outermost program, the target method or program can choose to execute the same or a different XML PARSE statement. Using a program with several threads, you can also run the same XML statement or several different XML statements at once. + Any GOBACK or EXIT PROGRAM statement cannot be executed within the scope of the processing procedure, with the exception of returning control from a method or program to which control was transferred by an INVOKE or CALL statement, respectively, that is executed within the scope of the prfocessing procedure. + To stop a run unit, code a STOP RUN statement in a processing routine. + +Taking an Example of parsing an XML with an undeclared namespace prefix: + +Input: + +```
+ Book-Signing Event + + + '. + 02 PIC X(19) VALUE ''. + 02 PIC X(20) VALUE ''. + 02 PIC X(40) VALUE ''. + 02 PIC X(02) VALUE 'C1'. + 02 PIC X(41) VALUE ''. + 02 PIC X(24) VALUE 'C2C3'. + 02 PIC X(32) VALUE ''. + PROCEDURE DIVISION. + MAIN. + DISPLAY 'XML DOCUMENT: ' WS-DATA + DISPLAY ' ' + XML PARSE WS-DATA PROCESSING PROCEDURE H + GOBACK. + IF XML-EVENT = 'EXCEPTION' + DISPLAY ' ' + END-IF + DISPLAY XML-EVENT XML-CODE '|' XML-TEXT '|' + XML-NAMESPACE-PREFIX '|' + XML-NAMESPACE '|' + IF XML-EVENT = 'EXCEPTION' AND XML-CODE = 264192 OR 264193 + MOVE 0 TO XML-CODE + END-IF. + End program XML1. +``` + +Now let’s take an example of parsing an XML document one segment at a time: + +Input: + +``` + +I Love COBOL + +``` +COBOL Program: +```IDENTIFICATION DIVISION. + PROGRAM-ID. XML2. + + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + + FILE-CONTROL. + SELECT INPUT-XML + ASSIGN TO INPUT-FILE + FILE STATUS IS IN-FILE-STAT. + DATA DIVISION. + FILE SECTION. + + FD INPUT-XML + RECORD IS VARYING FROM 1 TO 255 DEPENDING ON REC-LENGTH + RECORDING MODE V. + 01 WS-FDREC. + 02 PIC X OCCURS 1 TO 255 DEPENDING ON REC-LENGTH. + + WORKING-STORAGE SECTION. + + 01 EVENT-NUMBER COMP PIC 99. + 01 REC-LENGTH COMP-5 PIC 9(4). + 01 IN-FILE-STAT PIC 99. + + PROCEDURE DIVISION. + OPEN INPUT INPUT-XML + + IF IN-FILE-STAT NOT = 0 + DISPLAY 'OPEN FAILED, FILE STATUS: ' IN-FILE-STAT + GOBACK + END-IF + + READ INPUT-XML + + IF IN-FILE-STAT NOT = 0 + DISPLAY 'READ FAILED, FILE STATUS: ' IN-FILE-STAT + GOBACK + END-IF + + MOVE 0 TO EVENT-NUMBER + DISPLAY 'STARTING WITH: ' WS-FDREC + DISPLAY 'EVENT NUMBER AND NAME CONTENT OF XML-TEXT' + XML PARSE FDREC PROCESSING PROCEDURE HANDLE-PARSE-EVENTS + CLOSE INPUT-XML + GOBACK. + HANDLE-PARSE-EVENTS. + ADD 1 TO EVENT-NUMBER + DISPLAY ' ' EVENT-NUMBER ': ' XML-EVENT '{' XML-TEXT '}' + EVALUATE XML-EVENT + WHEN 'END-OF-INPUT' + READ INPUT-XML + EVALUATE IN-FILE-STAT + WHEN 0 + MOVE 1 TO XML-CODE + DISPLAY 'CONTINUING WITH: ' FDREC + WHEN 10 + DISPLAY 'AT EOF; NO MORE INPUT.' + WHEN OTHER + DISPLAY 'READ FAILED, FILE STATUS:' IN-FILE-STAT + GOBACK + END-EVALUATE + WHEN OTHER + CONTINUE + END-EVALUATE. + END PROGRAM XML2. + ``` + +Output: +```Starting with: +Event number and name Content of XML-TEXT + 01: START-OF-DOCUMENT {} + 02: VERSION-INFORMATION {1.0} + 03: END-OF-INPUT {} +Continuing with: + 04: START-OF-ELEMENT {Tagline} + 05: END-OF-INPUT {} +Continuing with: I Love COBOL + 06: CONTENT-CHARACTERS { I Love COBOL} + 07: END-OF-INPUT {} +Continuing with: + 08: CONTENT-CHARACTERS {} + 09: END-OF-ELEMENT {Tagline} + 10: END-OF-DOCUMENT {} + ``` + +The XML PARSE statement is used by this program to pass a record from the XML document that it has read from file INPUT-FILE to the parser. Each XML event's processing procedure is given control by the parser after it has processed the XML text. Once each event has been handled, the processing procedure passes control back to the parser. +The parser changes XML-CODE to zero, sets XML-EVENT to END-OF-INPUT, and hands control to the processing procedure at the end of the segment. After setting XML-CODE to 1, the processing procedure exits the parser and reads the following XML record into the parse data item. Up until the READ statement returns the end-of-file status code, the processing procedure and the parser continue to communicate. The processing procedure returns to the parser with XML-CODE still set to zero to indicate +the end of segment processing. + +#### Transforming XML text to COBOL data items +When transferring XML data to a COBOL data item, special techniques must be used because XML data has neither a fixed length nor a fixed format. +Choose whether the XML data belongs at the right end of the COBOL data item or the left end (the default) for alphanumeric items. In the item's definition, include the JUSTIFIED RIGHT clause if the data should go at the right end. +Pay special attention to numerical XML values, especially "decorated" dollar amounts like "$1,234.00" or "$1234". If used as COBOL sending fields, these two strings, which may have the same meaning in XML, require entirely different definitions. +When converting XML data to COBOL data items, use one of the following methods: + Code a MOVE to an alphanumeric item that you redefine appropriately as a numeric-edited item if the format is reasonably regular. Then, make the last move to a numeric (operational) item by moving away from the numeric-edited item and subsequently de-editing it. (In a standard format, + + The number of digits after the decimal point would be the same, there would be a comma to separate values greater than 999, and so on.) + Use the following intrinsic functions for alphanumeric XML data for simplicity and significantly increased flexibility: + XML data that contains plain numbers can be extracted and decoded using NUMVAL. + To extract and decode numerical values from XML data that depicts monetary amounts, use NUMVAL-C. +Utilizing these features, though, degrades performance. + +Encoding of XML documents: +A supported code page must be used to encrypt XML documents. +XML documents must be encoded in Unicode UTF-16 big-endian format, CCSID 1200, when created in or parsed from national data items. +A single-byte EBCDIC encoding, such as Unicode UTF-8 (CCSID 1208), or one of the single- byte EBCDIC encodings listed in the table below, must be used to encode documents created from alphanumeric data items for XML GENERATE statements. Any CCSID from that table may be used in the XML GENERATE statement's ENCODING phrase. +Documents in alphanumeric data items must be encoded as follows for XML PARSE statements: + When XMLPARSE(XMLSS) is active: + If the XML PARSE statement specifies the RETURNING NATIONAL phrase, it should be in any EBCDIC or ASCII encoding that z/OS® Unicode Services supports for conversion to UTF-16. + If the XML PARSE statement does not specify the RETURNING NATIONAL phrase, use UTF-8 (CCSID 1208) or one of the single-byte EBCDIC encodings shown in the table below. + When XMLPARSE(COMPAT) is active: the table below lists the single-byte EBCDIC encodings.If XMLPARSE(COMPAT) is in effect: in one of the single-byte EBCDIC encodings listed in the table below +You can use any supported CCSID (as described above for XML PARSE) in the ENCODING phrase of the XML PARSE statement if XMLPARSE(XMLSS) is active. + +For coded character sets for XML documents table, please visit: https://www.ibm.com/docs/en/cobol-zos/6.4?topic=input-encoding-xml- documents#:~:text=Table%201.%20Coded%20character%20sets%20for%20XML%20document s + +### Handling XML PARSE exceptions + +When an anomaly or error is encountered by the XML parser while parsing, it signals an XML exception event and sets an exception code in the XML-CODE special register. Depending on how the XMLPARSE compiler option is set, different exception codes can occur and different actions can be taken in response to them. +For XMLPARSE(XMLSS): +Return code and reason code: The return code and reason code produced by the parser are combined to create the exception code. Both the return code and the reason code are binary values that are half a word long. These two values are concatenated to create the value in XML-CODE. +If you parse the document without performing validation, the return code is hexadecimal 000C (XRC NOT WELL FORMED), and the reason code is hexadecimal 3035 (XRSN ENDTAG NAME MISMATCH). +In the XML-CODE special register, the processing procedure receives the concatenation of these two values, which is represented by the hexadecimal value 000C3035. +The values returned in XML-CODE for any well-formedness errors when parsing a document with validation are different from the values returned for the same errors when parsing a document without validation. For any validation error, the z/OS XML System Services parser generates the return code 24. (hexadecimal 0018). +See the related reference about exceptions with XMLPARSE(XMLSS) in effect for more details regarding the return codes and reason codes that may be generated. +Processing procedures cannot manage exception events or make parsing resume if XMLPARSE(XMLSS) is active. The parser does not signal any additional events once a processing procedure has returned to it from an exception event. The XML PARSE statement's ON EXCEPTION phrase specifies the statement to which the parser passes control. Control is transferred to the end of the XML PARSE statement if you did not code an ON EXCEPTION phrase. The initial exception code set by the parser is contained in XML-CODE. +Control is transferred to the statement specified in the NOT ON EXCEPTION phrase if no exceptions are encountered while parsing. Control is passed to the end of the XML PARSE statement if you did not code a NOT ON EXCEPTION phrase. XML-CODE has no content. + +### Terminating XML parsing +By setting XML-CODE to -1 in your processing procedure before the procedure returns to the parser from any normal XML event, you can immediately stop parsing without processing any remaining XML text (that is, any event other than EXCEPTION). This technique can be used when the processing procedure has examined enough of the document or has discovered an irregularity in the document that prevents further meaningful processing. When you stop parsing in this manner, the parser does not signal any additional XML events, including the exception event. If the ON EXCEPTION phrase of the XML PARSE statement was specified, control is transferred to that phrase. By testing whether XML-CODE contains -1 in the ON EXCEPTION phrase's imperative statement, you can determine whether parsing was intentionally terminated. If the ON EXCEPTION phrase is not specified, control is transferred to the end of the XML PARSE statement. If the XMLPARSE(COMPAT) compiler option is enabled, you can also stop parsing after any XML EXCEPTION event by returning to the parser without changing the value in XML-CODE. The result is similar to that of intentional termination, except that the parser returns to the XML PARSE statement with the original exception code in XML-CODE. If the XMLPARSE(XMLSS) option is enabled, parsing always ends when an exception occurs. + +## Producing XML output +Using the XML GENERATE statement, a COBOL program can generate XML output. The source and the output data items are specified in the XML GENERATE statement. +Optionally, we can create an XML declaration for the document and force the expression of eligible source data items as attributes rather than as elements in the output. +The XML-CODE special register can be used to check on the progress of XML generation. +Following the conversion of COBOL data items to XML, the output XML can be used in a variety of ways, including deployment in a web service, transmission as a message to MQ(Pipeline), and conversion to a CICS(frontend) communication area. + +The XML generation example is shown below: + +There are several COBOL programs because we are calling one another within the program. +```IDENTIFICATION DIVISION. + PROGRAM-ID. OPXML. + +DATA DIVISION. + WORKING-STORAGE SECTION. + + 01 WS-NUMBERS PIC 99 GLOBAL. + 01 PURCHASEORDER GLOBAL. + 05 ORDERDATE PIC X(10). + 05 SHIPTO. + 10 COUNTRY PIC X(5) VALUE 'INDIA'. + 10 NAME PIC X(30). + 10 STREET PIC X(30). + 10 CITY PIC X(30). + 10 STATE PIC XX. + 10 ZIP PIC X(10). + 05 BILLTO. + 10 COUNTRY PIC X(5) VALUE 'INDIA'. + 10 NAME PIC X(30). + 10 STREET PIC X(30). + 10 CITY PIC X(30). + 10 STATE PIC XX. + 10 ZIP PIC X(10). + 05 ORDERCOMMENT PIC X(80). + 05 ITEMS OCCURS 0 TO 20 TIMES DEPENDING ON WS-NUMBERS. + 10 ITEM. + 15 PARTNUM PIC X(6). + 15 PRODUCTNAME PIC X(50). + 15 QUANTITY PIC 9(2). + 15 PRICE PIC 9(3)V99. + 15 SHIPDATE PIC X(10). + 15 ITEMCOMMENT PIC X(40). + 01 NUMCHARS COMP PIC 9(3). + 01 XMLPO PIC X(999). + +PROCEDURE DIVISION. + + MOVE 20 TO WS-NUMBERS + MOVE SPACES TO PURCHASEORDER + + MOVE '2022-11-30' TO ORDERDATE + + MOVE 'US' TO COUNTRY OF SHIPTO + MOVE 'JENNY' TO NAME OF SHIPTO + MOVE '123 STREET ' TO STREET OF SHIPTO + MOVE 'BOSTON' TO CITY OF SHIPTO + MOVE ‘STATE A' TO STATE OF SHIPTO + MOVE '12345' TO ZIP OF SHIPTO + + MOVE 'INDIA' TO COUNTRY OF BILLTO + MOVE 'SAI' TO NAME OF BILLTO + MOVE '123 STREET ' TO STREET OF BILLTO + MOVE 'Delhi' TO CITY OF BILLTO + MOVE ‘UK' TO STATE OF BILLTO + MOVE '12346' TO ZIP OF BILLTO + MOVE ‘PLEASE SHIP ASAP' TO ORDERCOMMENT + + MOVE 0 TO WS-NUMBERS + + CALL 'ADDITEMONE' + CALL 'ADDITEMSECOND' + + MOVE SPACE TO XMLPO + XML GENERATE XMLPO FROM PURCHASEORDER COUNT IN NUMCHARS + WITH XML-DECLARATION WITH ATTRIBUTES + NAMESPACE 'HTTP://WWW.SAMPLE.COM' NAMESPACE-PREFIX 'PO' + CALL 'SECONDP' USING XMLPO VALUE NUMCHARS + GOBACK. + +IDENTIFICATION DIVISION. + PROGRAM-ID. 'ADDITEMONE'. + +PROCEDURE DIVISION. + ADD 1 TO WS-NUMBERS + MOVE '123-DD' TO PARTNUM(WS-NUMBERS) + MOVE 'TSHIRT' TO PRODUCTNAME(WS-NUMBERS) + MOVE 1 TO QUANTITY(WS-NUMBERS) + MOVE 148.95 TO PRICE(WS-NUMBERS) + MOVE 'CONFIRM’ TO ITEMCOMMENT(WS-NUMBERS) + GOBACK. +END PROGRAM 'ADDITEMONE'. + + + + +IDENTIFICATION DIVISION. + PROGRAM-ID. 'ADDITEMSECOND'. + +PROCEDURE DIVISION. + ADD 1 TO WS-NUMBERS + MOVE '926-AA' TO PARTNUM(WS-NUMBERS) + MOVE 'PANT' TO PRODUCTNAME(WS-NUMBERS) + MOVE 1 TO QUANTITY(WS-NUMBERS) + MOVE 39.98 TO PRICE(WS-NUMBERS) + MOVE '2022-11-30' TO SHIPDATE(WS-NUMBERS) + GOBACK. +END PROGRAM 'ADDITEMSECOND'. + +END PROGRAM OPXML. + +PROCESS XMLPARSE(XMLSS), CODEPAGE(37) +IDENTIFICATION DIVISION. + PROGRAM-ID. SECONDP. +DATA DIVISION. + WORKING-STORAGE SECTION. + 01 PRETTYPRINT. + 05 POSE PIC 999. + 05 POSD PIC 999. + 05 DEPTH PIC 99. + 05 INX PIC 999. + 05 ELEMENTNAME PIC X(30). + 05 INDENT PIC X(40). + 05 BUFFER PIC X(998). + 05 LASTITEM PIC 9. + 88 UNKNOWN VALUE 0. + 88 XML-DECLARATION VALUE 1. + 88 ELEMENT VALUE 2. + 88 ATTRIBUTE VALUE 3. + 88 CHARCONTENT VALUE 4. + LINKAGE SECTION. + 1 DOC. + 2 PIC X OCCURS 16384 TIMES DEPENDING ON LEN. + 1 LEN COMP-5 PIC 9(9). +PROCEDURE DIVISION USING DOC VALUE LEN. + M. + MOVE SPACE TO PRETTYPRINT + MOVE 0 TO DEPTH + MOVE 1 TO POSD POSE + XML PARSE DOC PROCESSING PROCEDURE P + GOBACK + . + P. + EVALUATE XML-EVENT + WHEN 'VERSION-INFORMATION' + STRING '' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + SET UNKNOWN TO TRUE + PERFORM PRINTLINE + MOVE 1 TO POSD + WHEN ELEMENT + STRING '>' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + WHEN ATTRIBUTE + STRING '">' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + END-EVALUATE + IF ELEMENTNAME NOT = SPACE + PERFORM PRINTLINE + END-IF + MOVE XML-TEXT TO ELEMENTNAME + ADD 1 TO DEPTH + MOVE 1 TO POSE + SET ELEMENT TO TRUE + IF XML-NAMESPACE-PREFIX = SPACE + STRING '<' XML-TEXT DELIMITED BY SIZE + INTO BUFFER WITH POINTER POSE + ELSE + STRING '<' XML-NAMESPACE-PREFIX ':' XML-TEXT + DELIMITED BY SIZE INTO BUFFER WITH POINTER POSE + END-IF + MOVE POSE TO POSD + WHEN 'ATTRIBUTE-NAME' + IF ELEMENT + STRING ' ' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + ELSE + STRING '" ' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + END-IF + IF XML-NAMESPACE-PREFIX = SPACE + STRING XML-TEXT '="' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + ELSE + STRING XML-NAMESPACE-PREFIX ':' XML-TEXT '="' + DELIMITED BY SIZE INTO BUFFER WITH POINTER POSD + END-IF + SET ATTRIBUTE TO TRUE + WHEN 'NAMESPACE-DECLARATION' + IF ELEMENT + STRING ' ' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + ELSE + STRING '" ' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + END-IF + IF XML-NAMESPACE-PREFIX = SPACE + STRING 'XMLNS="' XML-NAMESPACE DELIMITED BY SIZE + INTO BUFFER WITH POINTER POSD + ELSE + STRING 'XMLNS:' XML-NAMESPACE-PREFIX '="' XML-NAMESPACE + DELIMITED BY SIZE INTO BUFFER WITH POINTER POSD + END-IF + SET ATTRIBUTE TO TRUE + WHEN 'ATTRIBUTE-CHARACTERS' + STRING XML-TEXT DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + WHEN 'ATTRIBUTE-CHARACTER' + STRING XML-TEXT DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + WHEN 'CONTENT-CHARACTERS' + EVALUATE TRUE + WHEN ELEMENT + STRING '>' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + WHEN ATTRIBUTE + STRING '">' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + END-EVALUATE + STRING XML-TEXT DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + SET CHARCONTENT TO TRUE + WHEN 'CONTENT-CHARACTER' + EVALUATE TRUE + WHEN ELEMENT + STRING '>' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + WHEN ATTRIBUTE + STRING '">' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + END-EVALUATE + STRING XML-TEXT DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + SET CHARCONTENT TO TRUE + WHEN 'END-OF-ELEMENT' + MOVE SPACE TO ELEMENTNAME + EVALUATE TRUE + WHEN ELEMENT + STRING '/>' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + WHEN ATTRIBUTE + STRING '"/>' DELIMITED BY SIZE INTO BUFFER + WITH POINTER POSD + WHEN OTHER + IF XML-NAMESPACE-PREFIX = SPACE + STRING '' DELIMITED BY SIZE + INTO BUFFER WITH POINTER POSD + ELSE + STRING '' + DELIMITED BY SIZE INTO BUFFER WITH POINTER POSD + END-IF + END-EVALUATE + SET UNKNOWN TO TRUE + PERFORM PRINTLINE + SUBTRACT 1 FROM DEPTH + MOVE 1 TO POSD + WHEN OTHER + CONTINUE + END-EVALUATE + . + PRINTLINE. + COMPUTE INX = FUNCTION MAX(0 2 * DEPTH - 2) + POSD - 1 + IF INX > 120 + COMPUTE INX = 117 - FUNCTION MAX(0 2 * DEPTH - 2) + IF DEPTH > 1 + DISPLAY INDENT(1:2 * DEPTH - 2) BUFFER(1:INX) '...' + ELSE + DISPLAY BUFFER(1:INX) '...' + END-IF + ELSE + IF DEPTH > 1 + DISPLAY INDENT(1:2 * DEPTH - 2) BUFFER(1:POSD - 1) + ELSE + DISPLAY BUFFER(1:POSD - 1) + END-IF + END-IF + . +END PROGRAM PROGRAMP. +``` + + +Output: + +``` + + + + + +``` \newpage # COBOL Program Compilation diff --git a/COBOL Programming Course #3 - Advanced Topics/Images/xml_flow.png b/COBOL Programming Course #3 - Advanced Topics/Images/xml_flow.png new file mode 100644 index 00000000..f3ff8fca Binary files /dev/null and b/COBOL Programming Course #3 - Advanced Topics/Images/xml_flow.png differ