Enterprise COBOL for z/OS 6.3.0, Language Reference
O exemplo a seguir simula a construção de um pedido de compra em um item de dados de grupo e gera uma versão XML desse pedido de compra.
O programa XGFX usa XML GENERATE para produzir saída XML no item de dados elementar xmlPO a partir do registro de origem, item de dados do grupo purchaseOrder.
Os itens de dados elementares no registro de origem são convertidos para o formato de caractere conforme necessário e os caracteres são inseridos como os
valores dos atributos XML cujos nomes são derivados dos nomes de dados no registro de origem.
O XGFX chama o programa Pretty, que usa a instrução XML PARSE com o procedimento de processamento p para formatar a saída XML com novas linhas e recuo, para que
o conteúdo XML possa ser verificado mais facilmente.
Programa XGFX
1 2 3 4 5 6 7 8
12345678901234567890123456789012345678901234567890123456789012345678901234567890
IDENTIFICATION DIVISION.
PROGRAM-ID. XGFX.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NUMITEMS PIC 9(002) GLOBAL.
01 PURCHASEORDER GLOBAL.
05 ORDERDATE PIC X(010).
05 SHIPTO.
10 COUNTRY PIC X(002) VALUE 'US'.
10 NAME PIC X(030).
10 STREET PIC X(030).
10 CITY PIC X(030).
10 STATE PIC X(002).
10 ZIP PIC X(010).
05 BILLTO.
10 COUNTRY PIC X(002) VALUE 'US'.
10 NAME PIC X(030).
10 STREET PIC X(030).
10 CITY PIC X(030).
10 STATE PIC X(002).
10 ZIP PIC X(010).
05 ORDERCOMMENT PIC X(080).
05 ITEMS OCCURS 0 TO 20 TIMES DEPENDING ON NUMITEMS.
10 ITEM.
15 PARTNUM PIC X(006).
15 PRODUCTNAME PIC X(050).
15 QUANTITY PIC 9(002).
15 USPRICE PIC 999V99.
15 SHIPDATE PIC X(010).
15 ITEMCOMMENT PIC X(040).
01 NUMCHARS COMP PIC 9(003).
01 XMLPO PIC X(003).
PROCEDURE DIVISION.
M.
MOVE 20 TO NUMITEMS
MOVE SPACES TO PURCHASEORDER
MOVE '1999-10-20' TO ORDERDATE
MOVE 'US' TO COUNTRY OF SHIPTO
MOVE 'ALICE SMITH' TO NAME OF SHIPTO
MOVE '123 MAPLE STREET' TO STREET OF SHIPTO
MOVE 'MILL VALLEY' TO CITY OF SHIPTO
MOVE 'CA' TO STATE OF SHIPTO
MOVE '90952' TO ZIP OF SHIPTO
MOVE 'US' TO COUNTRY OF BILLTO
MOVE 'ROBERT SMITH' TO NAME OF BILLTO
MOVE '8 OAK AVENUE' TO STREET OF BILLTO
MOVE 'OLD TOWN' TO CITY OF BILLTO
MOVE 'PA' TO STATE OF BILLTO
MOVE '95819' TO ZIP OF BILLTO
MOVE 'HURRY, MY LAWN IS GOING WILD!' TO ORDERCOMMENT
MOVE 0 TO NUMITEMS
CALL 'ADDFIRSTITEM'
CALL 'ADDSECONDITEM'
MOVE SPACE TO XMLPO
XML GENERATE XMLPO FROM PURCHASEORDER COUNT IN NUMCHARS
WITH XML-DECLARATION WITH ATTRIBUTES
NAMESPACE 'HTTP://WWW.EXAMPLE.COM' NAMESPACE-PREFIX 'PO'
CALL 'PRETTY' USING XMLPO VALUE NUMCHARS
GOBACK
.
IDENTIFICATION DIVISION.
PROGRAM-ID. 'ADDFIRSTITEM'.
PROCEDURE DIVISION.
ADD 1 TO NUMITEMS
MOVE '872-AA' TO PARTNUM(NUMITEMS)
MOVE 'LAWNMOWER' TO PRODUCTNAME(NUMITEMS)
MOVE 1 TO QUANTITY(NUMITEMS)
MOVE 148.95 TO USPRICE(NUMITEMS)
MOVE 'CONFIRM THIS IS ELECTRIC' TO ITEMCOMMENT(NUMITEMS)
GOBACK.
END PROGRAM 'ADDFIRSTITEM'.
IDENTIFICATION DIVISION.
PROGRAM-ID. 'ADDSECONDITEM'.
PROCEDURE DIVISION.
ADD 1 TO NUMITEMS
MOVE '926-AA' TO PARTNUM(NUMITEMS)
MOVE 'BABY MONITOR' TO PRODUCTNAME(NUMITEMS)
MOVE 1 TO QUANTITY(NUMITEMS)
MOVE 39.98 TO USPRICE(NUMITEMS)
MOVE '1999-05-21' TO SHIPDATE(NUMITEMS)
GOBACK.
END PROGRAM 'ADDSECONDITEM'.
END PROGRAM XGFX.
Program Pretty
Process xmlparse(xmlss), codepage(37)
Identification division.
Program-id. Pretty.
Data division.
Working-storage section.
01 prettyPrint.
05 pose pic 9(003).
05 posd pic 9(003).
05 depth pic 9(002).
05 inx pic 9(003).
05 elementName pic x(030).
05 indent pic x(040).
05 buffer pic x(998).
05 lastitem pic 9(001).
88 unknown value 0.
88 xml-declaration value 1.
88 element value 2.
88 attribute value 3.
88 charcontent value 4.
Linkage section.
01 doc.
02 pic x(001) occurs 16384 times
depending on len.
01 len comp-5 pic 9(009).
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 '<?xml version="' xml-text '"' delimited by size
into buffer with pointer posd
Set xml-declaration to true
When 'ENCODING-DECLARATION'
String ' encoding="' xml-text '"' delimited by size
into buffer with pointer posd
When 'STANDALONE-DECLARATION'
String ' standalone="' xml-text '"' delimited by size
into buffer with pointer posd
When 'START-OF-ELEMENT'
Evaluate true
When xml-declaration
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 '</' 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
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 Pretty.
Saída do programa XGFX
<?xml version="1.0" encoding="IBM-037"?>
<po:purchaseOrder xmlns:po="http://www.example.com" orderDate="1999-10-20" orderComment="Hurry, my lawn is going wild!">
<po:shipTo country="US" name="Alice Smith" street="123 Maple Street" city="Mill Valley" state="CA" zip="90952"/>
<po:billTo country="US" name="Robert Smith" street="8 Oak Avenue" city="Old Town" state="PA" zip="95819"/>
<po:items>
<po:item partNum="872-AA" productName="Lawnmower" quantity="1" USPrice="148.95" shipDate=" " itemComment="Confirm...
</po:items>
<po:items>
<po:item partNum="926-AA" productName="Baby Monitor" quantity="1" USPrice="39.98" shipDate="1999-05-21" itemComme...
</po:items>
</po:purchaseOrder>
© Copyright IBM Corp.
