├── README.md
├── assert.rex
├── aux2svg.rex
├── devisio.rex
├── idl2wsdl.rex
├── idlfile.txt
├── images
    └── lose-the-horse-luke.jpg
├── io.rex
├── jcl2xml.rex
├── oorexx
    └── oorexxXMLparser.cls
├── parsexml.rex
├── pretty.rex
├── rexxpp.rex
├── soap.rex
├── test.xml
├── testmod.rex
└── testnew.rex


/README.md:
--------------------------------------------------------------------------------
  1 | # A REXX XML PARSER
  2 | 
  3 | ![the big picture](./images/lose-the-horse-luke.jpg)
  4 | 
  5 | ## Function
  6 | 
  7 | This is a Rexx XML parser that you can append to your
  8 | own Rexx source. You can then parse xml files into an
  9 | in-memory model and access the model via a DOM-like
 10 | API.
 11 | 
 12 | This version has been tested on:
 13 | 
 14 | * z/OS v2.3 TSO (using TSO/REXX)
 15 | * Windows (using Regina Rexx 3.9.1)
 16 | * Linux (using Regina Rexx 3.9.1)
 17 | 
 18 | ## Installation
 19 | 
 20 |    1. Copy the distribution library to your Rexx library.
 21 | 
 22 |    1. Execute the REXXPP INCLUDE pre-processor by running:
 23 | 
 24 |       `REXXPP yourlib(PRETTY) PRETTYPP`
 25 | 
 26 |       This will append PARSEXML to PRETTY and create PRETTYPP.
 27 |       You will be prompted for the location of each include
 28 |       file that cannot be found.
 29 |       Obviously, you can just use the editor if you prefer!
 30 | 
 31 |    1. Execute PRETTYPP to parse the TESTXML file by:
 32 | 
 33 |       `PRETTYPP yourlib(TESTXML)   (NOBLANKS`
 34 | 
 35 |       If you supply any options, be sure to put a space before
 36 |       the opening parenthesis. A closing parenthesis is
 37 |       optional.
 38 | 
 39 |    1. Repeat steps 2 and 3 for each of the other sample Rexx
 40 |       procedures if you want.
 41 | 
 42 | ## Usage
 43 | 
 44 |    1. Initialize the parser by:
 45 | 
 46 |       `call initParser [options...]`
 47 | 
 48 |    1. Parse the XML file to build an in-memory model
 49 | 
 50 |       `returncode = parseFile('filename')`
 51 | 
 52 |       ...or...
 53 | 
 54 |       `returncode = parseString('xml in a string')`
 55 | 
 56 |    1. Navigate the in-memory model with the DOM API. For
 57 |       example:
 58 | 
 59 |       ```rexx
 60 |       say 'The document element is called',
 61 |                             getName(getDocumentElement())
 62 |       say 'Children of the document element are:'
 63 |       node = getFirstChild(getDocumentElement())
 64 |       do while node <> ''
 65 |           if isElementNode(node)
 66 |           then say 'Element node:' getName(node)
 67 |           else say '   Text node:' getText(node)
 68 |           node = getNextSibling(node)
 69 |       end
 70 |       ```
 71 | 
 72 |    1. Optionally, destroy the in-memory model:
 73 | 
 74 |       `call destroyParser`
 75 | 
 76 | ## Input
 77 | 
 78 | The input to the parser consists of either an XML file or a string containing:
 79 | 
 80 |    1. An optional XML prolog:
 81 | 
 82 |       * 0 or 1 XML declaration:
 83 | 
 84 |         ```xml
 85 |         <?xml version="1.0" encoding="..." ...?>
 86 |         ```
 87 | 
 88 |       * 0 or more comments, Processing Instructions (PI's), and whitespace:
 89 | 
 90 |         ```xml
 91 |         <!-- a comment -->
 92 |         <?target string?>
 93 |         ```
 94 | 
 95 |       * 0 or 1 document type declaration. Formats:
 96 | 
 97 |         ```xml
 98 |         <!DOCTYPE root SYSTEM "sysid">
 99 |         <!DOCTYPE root PUBLIC "pubid" SYSTEM "sysid">
100 |         <!DOCTYPE root [internal dtd]>
101 |         ```
102 | 
103 |    1. An XML body:
104 | 
105 |       * 1 Document element containing 0 or more child
106 |          elements. For example:
107 | 
108 |          ```xml
109 |          <doc attr1="value1" attr2="value2"...>
110 |            Text of doc element
111 |            <child1 attr1="value1">
112 |              Text of child1 element
113 |            </child1>
114 |            More text of doc element
115 |            <!-- an empty child element follows -->
116 |            <child2/>
117 |            Even more text of doc element
118 |          </doc>
119 |          ```
120 | 
121 |       * Elements may contain:
122 | 
123 |          * Unparsed character data:
124 | 
125 |          ```xml
126 |          <![CDATA[...unparsed data...]]>
127 |          ```
128 | 
129 |          * Entity references:
130 | 
131 |          ```xml
132 |          &name;
133 |          ```
134 | 
135 |          * Character references:
136 | 
137 |          ```xml
138 |          &#nnnnn;
139 |          &#xXXXX;
140 |          ```
141 | 
142 |    1. An XML epilog (which is ignored):
143 | 
144 |       * 0 or more comments, Processing Instructions (PIs), and whitespace.
145 | 
146 | ## Application Programming Interface
147 | 
148 |    1. The basic setup/teardown API calls are:
149 | 
150 |       `initParser [options]`
151 | 
152 |          Initialises the parser's global variables and
153 |          remembers any runtime options you specify. The
154 |          options recognized are:
155 | 
156 |          | Option   | Meaning                        |
157 |          | -------- | ------------------------------ |
158 |          | NOBLANKS | Suppress whitespace-only nodes |
159 |          | DEBUG    | Display some debugging info    |
160 |          | DUMP     | Display the parse tree         |
161 | 
162 |       `parseFile(filename)`
163 | 
164 |          Parses the XML data in the specified filename and
165 |          builds an in-memory model that can be accessed via
166 |          the DOM API (see below).
167 | 
168 |       `parseString(text)`
169 | 
170 |          Parses the XML data in the specified string.
171 | 
172 |       `destroyParser`
173 | 
174 |          Destroys the in-memory model and miscellaneous
175 |          global variables.
176 | 
177 |    1. In addition, the following utility API calls can be
178 |       used:
179 | 
180 |       `removeWhitespace(text)`
181 | 
182 |          Returns the supplied text string but with all
183 |          whitespace characters removed, multiple spaces
184 |          replaced with single spaces, and leading and
185 |          trailing spaces removed.
186 | 
187 |       `removeQuotes(text)`
188 | 
189 |          Returns the supplied text string but with any
190 |          enclosing apostrophes or double-quotes removed.
191 | 
192 |       `escapeText(text)`
193 | 
194 |          Returns the supplied text string but with special
195 |          characters encoded (for example, `<` becomes `&lt;`)
196 | 
197 |       `toString(node)`
198 | 
199 |          Walks the document tree (beginning at the specified
200 |          node) and returns a string in XML format.
201 | 
202 | ## DOM API
203 | 
204 | The DOM (or DOM-like) calls that you can use are
205 | listed below:
206 | 
207 |    1. Document query/navigation API calls
208 | 
209 |       `getRoot()`
210 | 
211 |          Returns the node number of the root node. This
212 |          can be used in calls requiring a node argument.
213 |          In this implementation, `getDocumentElement()` and
214 |          `getRoot()` are (incorrectly) synonymous - this may
215 |          change, so you should use `getDocumentElement()`
216 |          in preference to `getRoot()`.
217 | 
218 |       `getDocumentElement()`
219 | 
220 |          Returns the node number of the document element.
221 |          The document element is the topmost element node.
222 |          You should use this in preference to `getRoot()`
223 |          (see above).
224 | 
225 |       `getName(node)`
226 | 
227 |          Returns the name of the specified node.
228 | 
229 |       `getNodeValue(node)` or `getText(node)`
230 | 
231 |          Returns the text content of an unnamed node. A
232 |          node without a name can only contain text. It
233 |          cannot have attributes or children.
234 | 
235 |       `getAttributeCount(node)`
236 | 
237 |          Returns the number of attributes present on the
238 |          specified node.
239 | 
240 |       `getAttributeMap(node)`
241 | 
242 |          Builds a map of the attributes of the specified
243 |          node. The map can be accessed via the following
244 |          variables:
245 | 
246 |          | Variable          | Content                         |
247 |          | ----------------- | ------------------------------- |
248 |          | g.0ATTRIBUTE.0    | The number of attributes mapped |
249 |          | g.0ATTRIBUTE.n    | The name of attribute number `n` (in order of appearance) where `n` > 0 |
250 |          | g.0ATTRIBUTE.name | The value of the attribute called `name` |
251 | 
252 |       `getAttributeName(node,n)`
253 | 
254 |          Returns the name of the nth attribute of the
255 |          specified node (1 is first, 2 is second, etc).
256 | 
257 |       `getAttributeNames(node)`
258 | 
259 |          Returns a space-delimited list of the names of the
260 |          attributes of the specified node.
261 | 
262 |       `getAttribute(node,name)`
263 | 
264 |          Returns the value of the attribute called `name` of
265 |          the specified node.
266 | 
267 |       `getAttribute(node,n)`
268 | 
269 |          Returns the value of the `n`th attribute of the
270 |          specified node (1 is first, 2 is second, etc).
271 | 
272 |       `setAttribute(node,name,value)`
273 | 
274 |          Updates the value of the attribute called 'name'
275 |          of the specified node. If no attribute exists with
276 |          that name, then one is created.
277 | 
278 |       `setAttributes(node,name1,value1,name2,value2,...)`
279 | 
280 |          Updates the attributes of the specified node. Zero
281 |          or more name/value pairs are be specified as the
282 |          arguments.
283 | 
284 |       `hasAttribute(node,name)`
285 | 
286 |          Returns 1 if the specified node has an attribute
287 |          with the specified name, else 0.
288 | 
289 |       `getParentNode(node)` or `getParent(node)`
290 | 
291 |          Returns the node number of the specified node's
292 |          parent. If the node number returned is 0, then the
293 |          specified node is the root node.
294 |          All nodes have a parent (except the root node).
295 | 
296 |       `getFirstChild(node)`
297 | 
298 |          Returns the node number of the specified node's
299 |          first child node.
300 | 
301 |       `getLastChild(node)`
302 | 
303 |          Returns the node number of the specified node's
304 |          last child node.
305 | 
306 |       `getChildNodes(node)` or `getChildren(node)`
307 | 
308 |          Returns a space-delimited list of node numbers of
309 |          the children of the specified node. You can use
310 |          this list to step through the children as follows:
311 | 
312 |          ```rexx
313 |          children = getChildren(node)
314 |          say 'Node' node 'has' words(children) 'children'
315 |          do i = 1 to words(children)
316 |            child = word(children,i)
317 |            say 'Node' child 'is' getName(child)
318 |          end
319 |          ```
320 | 
321 |       `getChildrenByName(node,name)`
322 | 
323 |          Returns a space-delimited list of node numbers of
324 |          the immediate children of the specified `node` which
325 |          are called `name`. Names are case-sensitive.
326 | 
327 |       `getElementsByTagName(node,name)`
328 | 
329 |          Returns a space-delimited list of node numbers of
330 |          the descendants of the specified `node` which are
331 |          called `name`. Names are case-sensitive.
332 | 
333 |       `getNextSibling(node)`
334 | 
335 |          Returns the node number of the specified node's
336 |          next sibling node. That is, the next node sharing
337 |          the same parent.
338 | 
339 |       `getPreviousSibling(node)`
340 | 
341 |          Returns the node number of the specified node's
342 |          previous sibling node. That is, the previous node
343 |          sharing the same parent.
344 | 
345 |       `getProcessingInstruction(name)`
346 | 
347 |          Returns the value of the Processing Instruction (PI) with the specified
348 |          target name.
349 | 
350 |       `getProcessingInstructionList()`
351 | 
352 |          Returns a space-delimited list of the names of all
353 |          PI target names.
354 | 
355 |       `getNodeType(node)`
356 | 
357 |          Returns a number representing the specified node's
358 |          type. The possible values can be compared to the
359 |          following global variables:
360 | 
361 |          | Variable                       | Content |
362 |          | ------------------------------ | ------- |
363 |          | g.0ELEMENT_NODE                | 1       |
364 |          | g.0ATTRIBUTE_NODE              | 2       |
365 |          | g.0TEXT_NODE                   | 3       |
366 |          | g.0CDATA_SECTION_NODE          | 4       |
367 |          | g.0ENTITY_REFERENCE_NODE       | 5       |
368 |          | g.0ENTITY_NODE                 | 6       |
369 |          | g.0PROCESSING_INSTRUCTION_NODE | 7       |
370 |          | g.0COMMENT_NODE                | 8       |
371 |          | g.0DOCUMENT_NODE               | 9       |
372 |          | g.0DOCUMENT_TYPE_NODE          | 10      |
373 |          | g.0DOCUMENT_FRAGMENT_NODE      | 11      |
374 |          | g.0NOTATION_NODE               | 12      |
375 | 
376 |          Note: as this exposes internal implementation
377 |          details, it is best not to use this routine.
378 |          Consider using `isTextNode()` etc instead (see below).
379 | 
380 |       `isCDATA(node)`
381 | 
382 |          Returns 1 if the specified node is an unparsed
383 |          character data (CDATA) node, else 0. CDATA nodes
384 |          are used to contain content that you do not want
385 |          to be treated as XML data. For example, HTML data.
386 | 
387 |       `isElementNode(node)`
388 | 
389 |          Returns 1 if the specified node is an element node,
390 |          else 0.
391 | 
392 |       `isTextNode(node)`
393 | 
394 |          Returns 1 if the specified node is a text node,
395 |          else 0.
396 | 
397 |       `isCommentNode(node)`
398 | 
399 |          Returns 1 if the specified node is a comment node,
400 |          else 0. Note: when a document is parsed, comment
401 |          nodes are ignored. This routine returns 1 iff a
402 |          comment node has been inserted into the in-memory
403 |          document tree by using `createComment()`.
404 | 
405 |       `hasChildren(node)`
406 | 
407 |          Returns 1 if the specified node has one or more
408 |          child nodes, else 0.
409 | 
410 |       `getDocType(doctype)`
411 | 
412 |          Gets the text of the `<!DOCTYPE>` prolog node.
413 | 
414 |    1. Document creation/mutation API calls
415 | 
416 |       `createDocument(name)`
417 | 
418 |          Returns the node number of a new document node
419 |          with the specified name.
420 | 
421 |       `createDocumentFragment(name)`
422 | 
423 |          Returns the node number of a new document fragment
424 |          node with the specified name.
425 | 
426 |       `createElement(name)`
427 | 
428 |          Returns the node number of a new empty element
429 |          node with the specified name. An element node can
430 |          have child nodes.
431 | 
432 |       `createTextNode(data)`
433 | 
434 |          Returns the node number of a new text node. A text
435 |          node can *not* have child nodes.
436 | 
437 |       `createCDATASection(data)`
438 | 
439 |          Returns the node number of a new Character Data
440 |          (CDATA) node. A CDATA node can *not* have child
441 |          nodes. CDATA nodes are used to contain content
442 |          that you do not want to be treated as XML data.
443 |          For example, HTML data.
444 | 
445 |       `createComment(data)`
446 | 
447 |          Returns the node number of a new comment node.
448 |          A comment node can *not* have child nodes.
449 | 
450 |       `appendChild(node,parent)`
451 | 
452 |          Appends the specified node to the end of the list
453 |          of children of the specified parent node.
454 | 
455 |       `insertBefore(node,refnode)`
456 | 
457 |          Inserts node `node` before the reference node
458 |          `refnode`.
459 | 
460 |       `removeChild(node)`
461 | 
462 |          Removes the specified node from its parent and
463 |          returns its node number. The removed child is now
464 |          an orphan.
465 | 
466 |       `replaceChild(newnode,oldnode)`
467 | 
468 |          Replaces the old child `oldnode` with the new
469 |          child `newnode` and returns the old child's node
470 |          number. The old child is now an orphan.
471 | 
472 |       `setAttribute(node,attrname,attrvalue)`
473 | 
474 |          Adds or replaces the attribute called `attrname`
475 |          on the specified node with the value `attrvalue`.
476 | 
477 |       `removeAttribute(node,attrname)`
478 | 
479 |          Removes the attribute called `attrname` from the
480 |          specified node.
481 | 
482 |       `setDocType(doctype)`
483 | 
484 |          Sets the text of the `<!DOCTYPE>` prolog node.
485 | 
486 |       `cloneNode(node,[deep])`
487 | 
488 |          Creates a copy (a clone) of the specified node
489 |          and returns its node number. If deep = 1 then
490 |          all descendants of the specified node are also
491 |          cloned, else only the specified node and its
492 |          attributes are cloned.
493 | 
494 | ## NOTES
495 | 
496 |    1. This parser creates global variables and so its
497 |       operation may be severely jiggered if you update
498 |       any of them accidentally (or on purpose). The
499 |       variables you should avoid updating yourself are:
500 | 
501 |       | REXX Variable     |
502 |       | ----------------- |
503 |       | g.0ATTRIBUTE.n    |
504 |       | g.0ATTRIBUTE.name |
505 |       | g.0ATTRSOK        |
506 |       | g.0DTD            |
507 |       | g.0ENDOFDOC       |
508 |       | g.0ENTITIES       |
509 |       | g.0ENTITY.name    |
510 |       | g.0FIRST.n        |
511 |       | g.0LAST.n         |
512 |       | g.0NAME.n         |
513 |       | g.0NEXT.n         |
514 |       | g.0NEXTID         |
515 |       | g.0OPTION.name    |
516 |       | g.0OPTIONS        |
517 |       | g.0PARENT.n       |
518 |       | g.0PI             |
519 |       | g.0PI.name        |
520 |       | g.0PREV.n         |
521 |       | g.0PUBLIC         |
522 |       | g.0ROOT           |
523 |       | g.0STACK          |
524 |       | g.0SYSTEM         |
525 |       | g.0TEXT.n         |
526 |       | g.0TYPE.n         |
527 |       | g.0WHITESPACE     |
528 |       | g.0XML            |
529 |       | g.?XML            |
530 |       | g.?XML.VERSION    |
531 |       | g.?XML.ENCODING   |
532 |       | g.?XML.STANDALONE |
533 | 
534 |    1. To reduce the incidence of name clashes, procedure
535 |       names that are not meant to be part of the public
536 |       API have been prefixed with '_'.
537 | 


--------------------------------------------------------------------------------
/assert.rex:
--------------------------------------------------------------------------------
  1 | /*REXX 2.0.0
  2 | Copyright (c) 2009-2020, Andrew J. Armstrong
  3 | All rights reserved.
  4 | 
  5 | Redistribution and use in source and binary forms, with or without 
  6 | modification, are permitted provided that the following conditions are 
  7 | met:
  8 | 
  9 |     * Redistributions of source code must retain the above copyright 
 10 |       notice, this list of conditions and the following disclaimer.
 11 |     * Redistributions in binary form must reproduce the above copyright 
 12 |       notice, this list of conditions and the following disclaimer in 
 13 |       the documentation and/or other materials provided with the
 14 |       distribution.
 15 | 
 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
 19 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
 22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 27 | 
 28 | */
 29 | 
 30 | /*REXX*****************************************************************
 31 | **                                                                   **
 32 | ** NAME     - ASSERT                                                 **
 33 | **                                                                   **
 34 | ** FUNCTION - Unit test assertion plumbing.                          **
 35 | **                                                                   **
 36 | **                                                                   **
 37 | ** SYNTAX   - n/a                                                    **
 38 | **                                                                   **
 39 | ** NOTES    - 1. You will have to either append the ASSERT rexx code **
 40 | **               manually to your Rexx source, or run your Rexx      **
 41 | **               source through the REXXPP rexx pre-processor.       **
 42 | **                                                                   **
 43 | **               To use the pre-processor, run:                      **
 44 | **                                                                   **
 45 | **               rexxpp yourrexx xyz                                 **
 46 | **                                                                   **
 47 | **               ...and then run the resulting 'xyz' rexx procedure: **
 48 | **                                                                   **
 49 | **               xyz                                                 **
 50 | **                                                                   **
 51 | **                                                                   **
 52 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com>    **
 53 | **                                                                   **
 54 | ** HISTORY  - Date     By  Reason (most recent at the top please)    **
 55 | **            -------- --- ----------------------------------------- **
 56 | **            20090822 AJA Changed from GPL to BSD license.          **
 57 | **            20060803 AJA Added message number to messages.         **
 58 | **            20050517 AJA Initial version.                          **
 59 | **                                                                   **
 60 | **********************************************************************/
 61 | 
 62 |   parse source . . sSourceFile .
 63 |   parse value sourceline(1) with . sVersion
 64 |   say 'Unit test routines' sVersion
 65 |   say 'You cannot invoke this rexx by itself!'
 66 |   say
 67 |   say 'This rexx is a collection of subroutines to be called'
 68 |   say 'from your own rexx procedures. You should either:'
 69 |   say '  - Append this procedure to your own rexx procedure,'
 70 |   say '    or,'
 71 |   say '  - Append the following line to your rexx:'
 72 |   say '    /* INCLUDE' sSourceFile '*/'
 73 |   say '    ...and run the rexx preprocessor:'
 74 |   say '    rexxpp myrexx myrexxpp'
 75 |   say '    This will create myrexxpp by appending this file to myrexx'
 76 | exit
 77 | 
 78 | assertEquals: procedure
 79 |   parse arg expected,actual,message
 80 |   if actual <> expected
 81 |   then call failNotEquals expected,actual,message
 82 | return
 83 | 
 84 | assertTrue: procedure
 85 |   parse arg condition,message
 86 |   if condition = 0
 87 |   then call failNotEquals 1,condition,message
 88 | return
 89 | 
 90 | assertFalse: procedure
 91 |   parse arg condition,message
 92 |   if condition = 1
 93 |   then call failNotEquals 0,condition,message
 94 | return
 95 | 
 96 | failNotEquals: procedure:
 97 |   parse arg expected,actual,message
 98 |   reason = 'expected:<'expected'> but was:<'actual'>'
 99 |   if message = ''
100 |   then say 'ASS001E Assertion failed:' reason
101 |   else say 'ASS002E Assertion failed:' message reason
102 | return
103 | 


--------------------------------------------------------------------------------
/aux2svg.rex:
--------------------------------------------------------------------------------
 1 | /*REXX 2.0.0
 2 | 
 3 |   CICS Auxiliary Trace Visualizer V2.0
 4 |   Copyright (C) 2005-2020 Andrew J. Armstrong
 5 | 
 6 |   This example is now hosted separately at
 7 | 
 8 |   https://github.com/abend0c1/aux2svg
 9 | 
10 | */


--------------------------------------------------------------------------------
/devisio.rex:
--------------------------------------------------------------------------------
  1 | /*REXX 2.0.0
  2 | Copyright (c) 2009-2020, Andrew J. Armstrong
  3 | All rights reserved.
  4 | 
  5 | Redistribution and use in source and binary forms, with or without 
  6 | modification, are permitted provided that the following conditions are 
  7 | met:
  8 | 
  9 |     * Redistributions of source code must retain the above copyright 
 10 |       notice, this list of conditions and the following disclaimer.
 11 |     * Redistributions in binary form must reproduce the above copyright 
 12 |       notice, this list of conditions and the following disclaimer in 
 13 |       the documentation and/or other materials provided with the
 14 |       distribution.
 15 | 
 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
 19 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
 22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 27 | 
 28 | */
 29 | 
 30 | /*REXX*****************************************************************
 31 | **                                                                   **
 32 | ** NAME     - DEVISIO                                                **
 33 | **                                                                   **
 34 | ** FUNCTION - Removes non-SVG markup from SVG documents created by   **
 35 | **            Microsoft Visio. The Microsoft-specific extensions are **
 36 | **            identified by the 'v:' name space.                     **
 37 | **                                                                   **
 38 | ** USAGE    - You can run this Rexx on an IBM mainframe, or on a PC  **
 39 | **            by using Regina Rexx from:                             **
 40 | **                                                                   **
 41 | **               http://regina-rexx.sourceforge.net                  **
 42 | **                                                                   **
 43 | **                                                                   **
 44 | ** SYNTAX   - DEVISIO infile outfile [(options...]                   **
 45 | **                                                                   **
 46 | **            Where,                                                 **
 47 | **            infile   = Microsoft Visio SVG file.                   **
 48 | **            outfile  = SVG file.                                   **
 49 | **            options  = Options                                     **
 50 | **                                                                   **
 51 | ** NOTES    - 1. You will have to either append the PARSEXML and     **
 52 | **               PRETTY source files manually to this file, or run   **
 53 | **               this file through the REXX rexx pre-processor.      **
 54 | **                                                                   **
 55 | **               To use the pre-processor, run:                      **
 56 | **                                                                   **
 57 | **               tso rexxpp your.rexx.lib(devisio)                   **
 58 | **                                                                   **
 59 | **                                                                   **
 60 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com>    **
 61 | **                                                                   **
 62 | ** HISTORY  - Date     By  Reason (most recent at the top please)    **
 63 | **            -------- --- ----------------------------------------- **
 64 | **            20090822 AJA Changed from GPL to BSD license.          **
 65 | **            20051026 AJA Initial version.                          **
 66 | **                                                                   **
 67 | **********************************************************************/
 68 | 
 69 |   parse arg sFileIn sFileOut' ('sOptions')'
 70 | 
 71 |   numeric digits 16
 72 |   parse value sourceline(1) with . sVersion
 73 |   say 'VIS000I Microsoft Visio SVG extensions remover' sVersion
 74 |   if sFileIn = ''
 75 |   then do
 76 |     say 'Syntax:'
 77 |     say '   devisio infile outfile (options'
 78 |     say
 79 |     say 'Where:'
 80 |     say '   infile  = Microsoft Visio SVG file'
 81 |     say '   outfile = SVG file (without Microsoft extensions)'
 82 |     exit
 83 |   end
 84 | 
 85 |   sOptions = 'NOBLANKS' translate(sOptions)
 86 |   call initParser sOptions /* DO THIS FIRST! Sets g. vars to '' */
 87 | 
 88 |   parse source g.0ENV .
 89 |   if g.0ENV = 'TSO'
 90 |   then do
 91 |     address ISPEXEC
 92 |     'CONTROL ERRORS RETURN'
 93 |     g.0LINES = 0
 94 |   end
 95 | 
 96 |   call Prolog
 97 | 
 98 |   /* Open the specified file and parse it */
 99 |   nParseRC = parseFile(sFileIn)
100 |   doc = getDocumentElement()
101 | 
102 |   g.0PREFIXES = getVisioNamespacePrefixes(doc)
103 |   say 'VIS002I Removing elements and attributes with prefixes:',
104 |       g.0PREFIXES
105 | 
106 |   call removeVisioTags doc
107 | 
108 |   call findAllReferences doc
109 | 
110 |   call removeUnusedReferences doc
111 | 
112 |   /* fix ups to make the svg render properly...*/
113 |   call setAttributes doc,,
114 |                'xml:space','default',,
115 |                'xmlns:xlink','http://www.w3.org/1999/xlink'
116 | 
117 |   call prettyPrinter sFileOut
118 | 
119 |   call Epilog
120 | exit
121 | 
122 | getVisioNamespacePrefixes: procedure expose g.
123 |   parse arg doc
124 |   sAttrNames = getAttributeNames(doc)
125 |   sPrefixes = ''
126 |   do i = 1 to words(sAttrNames)
127 |     sAttrName = word(sAttrNames,i)
128 |     if left(sAttrName,6) = 'xmlns:'
129 |     then do
130 |       sNameSpace = getAttribute(doc,sAttrName)
131 |       if pos('schemas.microsoft.com',sNameSpace) > 0
132 |       then do
133 |         sPrefix = substr(sAttrName,7)
134 |         sPrefixes = sPrefixes sPrefix
135 |         say 'VIS001I Removing' sAttrName'='getAttribute(doc,sAttrName)
136 |         call removeAttribute doc,sAttrName
137 |       end
138 |     end
139 |   end
140 | return strip(sPrefixes)
141 | 
142 | removeVisioTags: procedure expose g.
143 |   parse arg node
144 |   sTagName = getNodeName(node)
145 |   if isVisioExtension(sTagName)
146 |   then call removeChild node
147 |   else do
148 |     if sTagName = 'marker' /* HACK: fixes Visio 2003 bug */
149 |     then call setAttribute node,'overflow','visible'
150 |     sAttrNames = getAttributeNames(node)
151 |     do i = 1 to words(sAttrNames)
152 |       sAttrName = word(sAttrNames,i)
153 |       if isVisioExtension(sAttrName)
154 |       then call removeAttribute node,sAttrName
155 |     end
156 |     children = getChildNodes(node)
157 |     do i = 1 to words(children)
158 |       child = word(children,i)
159 |       call removeVisioTags child
160 |     end
161 |   end
162 | return
163 | 
164 | isVisioExtension: procedure expose g.
165 |   parse arg sTagName .
166 |   if wordpos(sTagName,'title desc') > 0 then return 1
167 |   if pos(':',sTagName) = 0              then return 0
168 |   parse arg sPrefix':'
169 |   if wordpos(sPrefix,g.0PREFIXES) > 0   then return 1
170 | return 0
171 | 
172 | findAllReferences: procedure expose g.
173 |   parse arg node
174 |   sText = getNodeValue(node)
175 |   do while pos('url(#',sText) > 0
176 |     parse var sText 'url(#'sId')'sText
177 |     sRef = '#'sId
178 |     g.0ID.sRef = 1
179 |   end
180 |   if hasAttribute(node,'xlink:href')
181 |   then do
182 |     sId = getAttribute(node,'xlink:href')
183 |     if left(sId,1) = '#' /* is it a local reference? */
184 |     then g.0ID.sId = 1 /* For example: g.0ID.#mrkr13-14 = 1 */
185 |   end
186 |   children = getChildNodes(node)
187 |   do i = 1 to words(children)
188 |     child = word(children,i)
189 |     call findAllReferences child
190 |   end
191 | return
192 | 
193 | removeUnusedReferences: procedure expose g.
194 |   parse arg node
195 |   if hasAttribute(node,'id')
196 |   then do
197 |     sId = getAttribute(node,'id')
198 |     sRef = '#'sId
199 |     if g.0ID.sRef <> 1
200 |     then call removeAttribute node,'id'
201 |   end
202 |   children = getChildNodes(node)
203 |   do i = 1 to words(children)
204 |     child = word(children,i)
205 |     call removeUnusedReferences child
206 |   end
207 | return
208 | 
209 | 
210 | Prolog: procedure expose g.
211 | return
212 | 
213 | Epilog: procedure expose g.
214 | return
215 | 
216 | /*INCLUDE pretty.rex */
217 | 


--------------------------------------------------------------------------------
/idl2wsdl.rex:
--------------------------------------------------------------------------------
   1 | /*REXX 2.0.0
   2 | Copyright (c) 2009-2020, Andrew J. Armstrong
   3 | All rights reserved.
   4 | 
   5 | Redistribution and use in source and binary forms, with or without 
   6 | modification, are permitted provided that the following conditions are 
   7 | met:
   8 | 
   9 |     * Redistributions of source code must retain the above copyright 
  10 |       notice, this list of conditions and the following disclaimer.
  11 |     * Redistributions in binary form must reproduce the above copyright 
  12 |       notice, this list of conditions and the following disclaimer in 
  13 |       the documentation and/or other materials provided with the
  14 |       distribution.
  15 | 
  16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
  17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
  18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
  19 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
  20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
  22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
  26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  27 | 
  28 | */
  29 | 
  30 | /*REXX*****************************************************************
  31 | **                                                                   **
  32 | ** NAME     - IDL2WSDL                                               **
  33 | **                                                                   **
  34 | ** FUNCTION - Converts an EntireX Interface Definition Language (IDL)**
  35 | **            file into a Web Services Description Language (WSDL)   **
  36 | **            file.  It may be useful for sites that want to         **
  37 | **            re-implement an EntireX application as a Web Service.  **
  38 | **            It takes the tedium of converting the relatively easy  **
  39 | **            to understand IDL file format into the hideously       **
  40 | **            complex WSDL file format.                              **
  41 | **                                                                   **
  42 | **                                                                   **
  43 | ** USAGE    - You can run this Rexx on an IBM mainframe, or on a PC  **
  44 | **            by using Regina Rexx from:                             **
  45 | **                                                                   **
  46 | **               http://regina-rexx.sourceforge.net                  **
  47 | **                                                                   **
  48 | **                                                                   **
  49 | ** SYNTAX     IDL2WSDL infile [url [ns  [ (options [)] ]]]'          **
  50 | **                                                                   **
  51 | **            Where,                                                 **
  52 | **            infile  = Name of your EntireX Interface Definition    **
  53 | **                      Language (IDL) file. For example:            **
  54 | **                      example.idl                                  **
  55 | **            url     = URL of the service. For example:             **
  56 | **                      http://10.1.2.3:8080/cics/cwba/soapima       **
  57 | **            ns      = Namespace of the service. For example:       **
  58 | **                      http://myservice.example.org                 **
  59 | **            options = RPC      - Remote Procedure Call (style)     **
  60 | **                      DOCUMENT - XML document (style)              **
  61 | **                      ENCODED  - Parameters defined inline (use)   **
  62 | **                      LITERAL  - Parameters defined by schema (use)**
  63 | **                      WRAPPED  - Special case of DOCUMENT LITERAL  **
  64 | **                      XML      - Create XML file (for debugging)   **
  65 | **                                                                   **
  66 | **            Valid style and use combinations are:                  **
  67 | **            WRAPPED            <-- This is the default             **
  68 | **            DOCUMENT LITERAL                                       **
  69 | **            RPC LITERAL                                            **
  70 | **            RPC ENCODED                                            **
  71 | **                                                                   **
  72 | ** NOTES    - 1. This Rexx uses the Rexx XML parser in CBT FILE 647  **
  73 | **               from www.cbttape.org.                               **
  74 | **               You will have to either append the PARSEXML and     **
  75 | **               PRETTY source files manually to this file, or run   **
  76 | **               this file through the REXX rexx pre-processor.      **
  77 | **                                                                   **
  78 | **               To use the pre-processor on TSO, run:               **
  79 | **                                                                   **
  80 | **               tso rexxpp your.rexx.lib(idl2wsdl)                  **
  81 | **                                                                   **
  82 | **               To use the pre-processor on Windows, run:           **
  83 | **                                                                   **
  84 | **               rexx rexxpp idl2wsdl.rexx idl2wsdl.new              **
  85 | **                                                                   **
  86 | **               ...and then rename the .new file to .rexx           **
  87 | **                                                                   **
  88 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com>    **
  89 | **                                                                   **
  90 | ** HISTORY  - Date     By  Reason (most recent at the top please)    **
  91 | **            -------- --- ----------------------------------------- **
  92 | **            20090822 AJA Changed from GPL to BSD license.          **
  93 | **            20060525 AJA Update documentation.                     **
  94 | **            20060216 AJA User must supply URL & namespace.         **
  95 | **            20051106 AJA Support RPC/DOC + ENC/LIT/WRAPPED.        **
  96 | **            20051102 AJA Intial version.                           **
  97 | **                                                                   **
  98 | **********************************************************************/
  99 | 
 100 |   parse arg sFileIn sURL sNamespace' ('sOptions')'
 101 | 
 102 |   numeric digits 16
 103 |   parse value sourceline(1) with . sVersion
 104 |   say 'IDL000I EntireX IDL to WSDL File Converter' sVersion
 105 |   if sFileIn = ''
 106 |   then do
 107 |     say 'Syntax:'
 108 |     say '   IDL2WSDL infile url ns (options'
 109 |     say
 110 |     say 'Where:'
 111 |     say '   infile  = EntireX IDL input file. For example:'
 112 |     say '             example.idl'
 113 |     say '   url     = URL of the service. For example:'
 114 |     say '             http://10.1.2.3:8080/cics/cwba/soapima'
 115 |     say '   ns      = Namespace of the service. For example:'
 116 |     say '             http://myservice.example.org'
 117 |     say '   options = RPC      - Remote Procedure Call (style)'
 118 |     say '             DOCUMENT - XML document (style)'
 119 |     say '             ENCODED  - Parameters defined inline (use)'
 120 |     say '             LITERAL  - Parameters defined by schema (use)'
 121 |     say '             WRAPPED  - Special case of DOCUMENT LITERAL'
 122 |     say '             XML      - Create XML file (for debugging)'
 123 |     say
 124 |     say '   Valid option combinations are:'
 125 |     say '     WRAPPED'
 126 |     say '     DOCUMENT LITERAL'
 127 |     say '     RPC LITERAL'
 128 |     say '     RPC ENCODED'
 129 |     exit
 130 |   end
 131 |   say 'IDL001I Reading EntireX IDL file in' sFileIn
 132 | 
 133 | 
 134 |   sOptions = 'NOBLANKS' translate(sOptions)
 135 |   call initParser sOptions /* DO THIS FIRST! Sets g. vars to '' */
 136 |   call setDocType /* we don't need a doctype declaration */
 137 | 
 138 |   g.0FILEIDL = sFileIn
 139 |   g.0URL = prompt(sURL,,
 140 |                   'Enter URL of this service',,
 141 |                   'http://10.1.2.3:8080/cics/cwba/soapima/')
 142 |   g.0NAMESPACE = prompt(sNamespace,,
 143 |                   'Enter XML namespace of this service',,
 144 |                   'http://myservice.example.org')
 145 | 
 146 |   parse source g.0ENV .
 147 |   if g.0ENV = 'TSO'
 148 |   then do
 149 |     address ISPEXEC
 150 |     'CONTROL ERRORS RETURN'
 151 |     g.0LINES = 0
 152 |   end
 153 | 
 154 |   call setOptions sOptions
 155 |   call Prolog
 156 | 
 157 |   /* Read the IDL file into an in-memory XML document */
 158 |   idl = scanEntireXIdlFile()
 159 | 
 160 |   sFileName = getFilenameWithoutExtension(sFileIn)
 161 |   libraries = getChildNodes(idl)
 162 |   do i = 1 to words(libraries)
 163 |     library = word(libraries,i)
 164 |     sLibrary = getAttribute(library,'name')
 165 |     call createWSDL sFileName'.'sLibrary,library
 166 |   end
 167 | 
 168 |   call Epilog
 169 | exit
 170 | 
 171 | prompt: procedure expose g.
 172 |   parse arg sReply,sPrompt,sDefault
 173 |   if sReply = ''
 174 |   then do
 175 |     say 'IDL000R' sPrompt '['sDefault']:'
 176 |     parse pull sReply
 177 |     if sReply = '' then sReply = sDefault
 178 |   end
 179 | return sReply
 180 | 
 181 | 
 182 | /*
 183 | <wsdl:definitions targetNamespace="yournamespace"
 184 |     xmlns:apachesoap="http://xml.apache.org/xml-soap"
 185 |     xmlns:impl="yournamespace"
 186 |     xmlns:intf="yournamespace"
 187 |     xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
 188 |     xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/"
 189 |     xmlns:wsdlsoap="http://schemas.xmlsoap.org/wsdl/soap/"
 190 |     xmlns:xsd="http://www.w3.org/2001/XMLSchema">
 191 |     .
 192 |     .
 193 | </wsdl:definitions>
 194 | */
 195 | createWSDL: procedure expose g.
 196 |   parse arg sFile,node
 197 |   if g.0OPTION.XML
 198 |   then call prettyPrinter sFile'.xml',,node
 199 | 
 200 |   /* Build the high-level WSDL file structure... */
 201 |   g.0DEFS     = createElement('wsdl:definitions')
 202 |   g.0TYPES    = createElement('wsdl:types')
 203 |   g.0PORTTYPE = createElement('wsdl:portType')
 204 |   g.0BINDING  = createElement('wsdl:binding')
 205 |   g.0SERVICE  = createElement('wsdl:service')
 206 | 
 207 |   /* The porttype, binding and service elements are more-or-less the
 208 |      same for all combinations of style and use, so build them now... */
 209 |   call defineDefinitions node
 210 |   call defineTypes node
 211 |   call definePortType node
 212 |   call defineBinding node
 213 |   call defineService node
 214 |   call appendChild g.0TYPES,g.0DEFS
 215 | 
 216 | 
 217 |   /* Now add message elements depending on style and use... */
 218 |   select
 219 |     when g.0OPTION.WRAPPED then,
 220 |       call createDocWrapped node
 221 |     when g.0OPTION.DOCUMENT & g.0OPTION.LITERAL then,
 222 |       call createDocLiteral node
 223 |     when g.0OPTION.RPC & g.0OPTION.LITERAL then,
 224 |       call createRpcLiteral node
 225 |     when g.0OPTION.RPC & g.0OPTION.ENCODED then,
 226 |       call createRpcEncoded node
 227 |     otherwise,
 228 |       call createDocWrapped node
 229 |   end
 230 | 
 231 |   call appendChild g.0PORTTYPE,g.0DEFS
 232 |   call appendChild g.0BINDING,g.0DEFS
 233 |   call appendChild g.0SERVICE,g.0DEFS
 234 | 
 235 |   /* Serialise the WSDL document to a file... */
 236 |   call prettyPrinter sFile'.wsdl',,g.0DEFS
 237 | return
 238 | 
 239 | 
 240 | defineDefinitions: procedure expose g.
 241 |   parse arg node
 242 |   call setAttributes g.0DEFS,,
 243 |        'targetNamespace',g.0NAMESPACE,,
 244 |        'xmlns:impl',g.0NAMESPACE,,
 245 |        'xmlns:intf',g.0NAMESPACE,,
 246 |        'xmlns:wsdl','http://schemas.xmlsoap.org/wsdl/',,
 247 |        'xmlns:wsdlsoap','http://schemas.xmlsoap.org/wsdl/soap/',,
 248 |        'xmlns:xsd','http://www.w3.org/2001/XMLSchema'
 249 | 
 250 |   if g.0OPTION.ENCODED
 251 |   then call setAttribute g.0DEFS,,
 252 |        'xmlns:soapenc','http://schemas.xmlsoap.org/soap/encoding/'
 253 | 
 254 |   call appendChild createComment('Created by EntireX IDL-to-WSDL',
 255 |        'converter V1.0 on' date() time() userid()),g.0DEFS
 256 | 
 257 |   if g.0OPTION.WRAPPED
 258 |   then call appendChild createComment('Style='getStyle() '(wrapped)',
 259 |             'Use='getUse()),g.0DEFS
 260 |   else call appendChild createComment('Style='getStyle(),
 261 |             'Use='getUse()),g.0DEFS
 262 | return
 263 | 
 264 | /*
 265 | <wsdl:types>
 266 |     <schema targetNamespace="yournamespace"
 267 |             xmlns="http://www.w3.org/2001/XMLSchema">
 268 |         <import
 269 |             namespace="http://schemas.xmlsoap.org/soap/encoding/"/>
 270 |         <complexType name="SecurityContext">
 271 |             <sequence>
 272 |                 <element name="reason" nillable="true"
 273 |                          type="soapenc:string"/>
 274 |                 <element name="reasonCode" nillable="true"
 275 |                          type="soapenc:int"/>
 276 |                 <element name="returnCode" nillable="true"
 277 |                          type="soapenc:int"/>
 278 |                 <element name="success" nillable="true"
 279 |                          type="soapenc:boolean"/>
 280 |                 <element name="userid" nillable="true"
 281 |                          type="soapenc:string"/>
 282 |             </sequence>
 283 |         </complexType>
 284 |     </schema>
 285 | </wsdl:types>
 286 | */
 287 | defineTypes: procedure expose g.
 288 |   parse arg node
 289 |   g.0SCHEMA = createElement('schema')
 290 |   call appendChild g.0SCHEMA,g.0TYPES
 291 |   if g.0OPTION.DOCUMENT | g.0OPTION.WRAPPED
 292 |   then call setAttribute g.0SCHEMA,'elementFormDefault','qualified'
 293 |   call setAttributes g.0SCHEMA,,
 294 |        'targetNamespace',g.0NAMESPACE,,
 295 |        'xmlns','http://www.w3.org/2001/XMLSchema'
 296 |   if g.0OPTION.ENCODED
 297 |   then do
 298 |     import = createElement('import')
 299 |     call appendChild import,g.0SCHEMA
 300 |     call setAttribute import,,
 301 |          'namespace','http://schemas.xmlsoap.org/soap/encoding/'
 302 |   end
 303 |   structuresnode = getChildrenByName(node,'structures')
 304 |   structures = getChildren(structuresnode)
 305 |   do i = 1 to words(structures)
 306 |     struct = word(structures,i)
 307 |     call appendComplexType struct,g.0SCHEMA
 308 |   end
 309 | return
 310 | 
 311 | /*
 312 | <wsdl:operation name="verify">
 313 |     <wsdl:input message="impl:verifyRequest"
 314 |                 name="verifyRequest"/>
 315 |     <wsdl:output message="impl:verifyResponse"
 316 |                  name="verifyResponse"/>
 317 | </wsdl:operation>
 318 | */
 319 | definePortType: procedure expose g.
 320 |   parse arg node
 321 |   sService = getAttribute(node,'name')
 322 |   call setAttribute g.0PORTTYPE,'name',sService
 323 |   programs = getChildrenByName(node,'programs')
 324 |   if programs <> ''
 325 |   then do
 326 |     programs = getChildren(programs)
 327 |     do i = 1 to words(programs)
 328 |       program = word(programs,i)
 329 |       sOperation = getAttribute(program,'name')
 330 |       operation = createElement('wsdl:operation')
 331 |       call appendChild operation,g.0PORTTYPE
 332 |       call setAttribute operation,'name',sOperation
 333 |       input = createElement('wsdl:input')
 334 |       call appendChild input,operation
 335 |       call setAttributes input,,
 336 |            'message','impl:'sOperation'Request',,
 337 |            'name',sOperation'Request'
 338 |       output = createElement('wsdl:output')
 339 |       call appendChild output,operation
 340 |       call setAttributes output,,
 341 |            'message','impl:'sOperation'Response',,
 342 |            'name',sOperation'Response'
 343 |     end
 344 |   end
 345 | return
 346 | 
 347 | /*
 348 | <wsdl:binding name="SecuritySoapBinding"
 349 |               type="impl:Security">
 350 |   <wsdlsoap:binding style="rpc"
 351 |                     transport="http://schemas.xmlsoap.org/soap/http"/>
 352 |   <wsdl:operation name="verify">
 353 |   <wsdlsoap:operation soapAction=""/>
 354 |     <wsdl:input name="verifyRequest">
 355 |         <wsdlsoap:body
 356 |             encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
 357 |             namespace="yournamespace"
 358 |             use="encoded"/>
 359 |     </wsdl:input>
 360 |     <wsdl:output name="verifyResponse">
 361 |         <wsdlsoap:body
 362 |             encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
 363 |             namespace="yournamespace"
 364 |             use="encoded"/>
 365 |     </wsdl:output>
 366 |   </wsdl:operation>
 367 |     .
 368 |     .
 369 | </wsdl:binding>
 370 | */
 371 | defineBinding: procedure expose g.
 372 |   parse arg node
 373 |   sService = getAttribute(node,'name')
 374 |   call setAttributes g.0BINDING,,
 375 |        'name',sService'SoapBinding',,
 376 |        'type','impl:'sService
 377 |   soapbinding = createElement('wsdlsoap:binding')
 378 |   call appendChild soapbinding,g.0BINDING
 379 |   call setAttributes soapbinding,,
 380 |        'style',getStyle(),,
 381 |        'transport','http://schemas.xmlsoap.org/soap/http'
 382 |   programs = getChildrenByName(node,'programs')
 383 |   if programs <> ''
 384 |   then do
 385 |     programs = getChildren(programs)
 386 |     do i = 1 to words(programs)
 387 |       program = word(programs,i)
 388 |       sOperation = getAttribute(program,'name')
 389 |       operation = createElement('wsdl:operation')
 390 |       call setAttribute operation,'name',sOperation
 391 |       call appendChild operation,g.0BINDING
 392 |       soapoperation = createElement('wsdlsoap:operation')
 393 |       call appendChild soapoperation,operation
 394 |       call setAttribute soapoperation,'soapAction',''
 395 | 
 396 |       input = createElement('wsdl:input')
 397 |       call appendChild input,operation
 398 |       call setAttribute input,'name',sOperation'Request'
 399 |       body = createElement('wsdlsoap:body')
 400 |       call appendChild body,input
 401 |       if g.0OPTION.ENCODED
 402 |       then call setAttribute body,,
 403 |            'encodingStyle','http://schemas.xmlsoap.org/soap/encoding/'
 404 |       call setAttributes body,,
 405 |            'namespace',g.0NAMESPACE,,
 406 |            'use',getUse()
 407 | 
 408 |       output = createElement('wsdl:output')
 409 |       call appendChild output,operation
 410 |       call setAttribute output,'name',sOperation'Response'
 411 |       body = createElement('wsdlsoap:body')
 412 |       call appendChild body,output
 413 |       if g.0OPTION.ENCODED
 414 |       then call setAttribute body,,
 415 |            'encodingStyle','http://schemas.xmlsoap.org/soap/encoding/'
 416 |       if g.0OPTION.RPC
 417 |       then call setAttribute body,'namespace',g.0NAMESPACE
 418 |       call setAttribute body,'use',getUse()
 419 |     end
 420 |   end
 421 | return
 422 | 
 423 | getStyle: procedure expose g.
 424 |   if g.0OPTION.RPC
 425 |   then sStyle = 'rpc'
 426 |   else sStyle = 'document'
 427 | return sStyle
 428 | 
 429 | getUse: procedure expose g.
 430 |   if g.0OPTION.ENCODED
 431 |   then sUse = 'encoded'
 432 |   else sUse = 'literal'
 433 | return sUse
 434 | 
 435 | /*
 436 | <wsdl:service name="SecurityService">
 437 |     <wsdl:port binding="impl:SecuritySoapBinding"
 438 |                name="Security">
 439 |         <wsdlsoap:address
 440 |             location="http://10.9.2.31:5080/axis/services/Security"/>
 441 |     </wsdl:port>
 442 | </wsdl:service>
 443 | */
 444 | defineService: procedure expose g.
 445 |   parse arg node
 446 |   sService = getAttribute(node,'name')
 447 |   call setAttribute g.0SERVICE,'name',sService'Service'
 448 |   port = createElement('wsdl:port')
 449 |   call appendChild port,g.0SERVICE
 450 |   call setAttributes port,,
 451 |        'binding','impl:'sService'SoapBinding',,
 452 |        'name',sService
 453 |   addr = createElement('wsdlsoap:address')
 454 |   call appendChild addr,port
 455 |   call setAttribute addr,,
 456 |        'location',g.0URL || sService
 457 | return
 458 | 
 459 | /*
 460 | style=document, use=literal [WS-I compliant, with restrictions]
 461 | 
 462 | Elements of the SOAP body are the names of XML Schema elements that
 463 | describe each parameter (there is no wrapper operation and no multi-ref)
 464 | 
 465 |    <soap:body>
 466 |      <arg1Element>5</arg1Element>
 467 |      <arg2Element>5.0</arg2Element>
 468 |    </soap:body>
 469 | 
 470 | */
 471 | createDocLiteral: procedure expose g.
 472 |   parse arg node
 473 |   say 'IDL003I Generating WSDL style=DOCUMENT use=LITERAL'
 474 |   /*
 475 |   <wsdl:message name="changePasswordRequest">
 476 |       <wsdl:part name="userid" element="xsd:string"/>
 477 |       <wsdl:part name="password" element="xsd:string"/>
 478 |       <wsdl:part name="newPassword" element="xsd:string"/>
 479 |   </wsdl:message>
 480 |   <wsdl:message name="changePasswordResponse">
 481 |       <wsdl:part name="changePasswordReturn"
 482 |                  element="impl:SecurityContext"/>
 483 |   </wsdl:message>
 484 |       .
 485 |       .
 486 |   */
 487 |   programs = getChildrenByName(node,'programs')
 488 |   if programs <> ''
 489 |   then do
 490 |     programs = getChildren(programs)
 491 |     do i = 1 to words(programs)
 492 |       program = word(programs,i)
 493 |       sOperation = getAttribute(program,'name')
 494 |       request  = createElement('wsdl:message')
 495 |       call appendChild request,g.0DEFS
 496 |       call setAttribute request,'name',sOperation'Request'
 497 |       response = createElement('wsdl:message')
 498 |       call appendChild response,g.0DEFS
 499 |       call setAttribute response,'name',sOperation'Response'
 500 |       parms = getChildren(program)
 501 |       do j = 1 to words(parms)
 502 |         parm = word(parms,j)
 503 |         sType = getAttribute(parm,'type')
 504 |         if sType <> '' /* if it is not a group */
 505 |         then do
 506 |           sName = getAttribute(parm,'name')
 507 |           sDir  = getAttribute(parm,'direction')
 508 |           if wordpos('In',sDir) > 0
 509 |           then call appendPartSchema sName,sType,request
 510 |           if wordpos('Out',sDir) > 0
 511 |           then call appendPartSchema sOperation'Return',sType,response
 512 |         end
 513 |       end
 514 |     end
 515 |   end
 516 | return
 517 | 
 518 | /*
 519 | <wsdl:part name="userid1" element="impl:userid1"/>
 520 |                                          |
 521 |                   .----------------------'
 522 |                   |
 523 |                   V
 524 | <element name="userid1" type="xsd:string"/>
 525 | or
 526 | <element name="userid1" type="impl:schemaReference"/>
 527 | */
 528 | appendPartSchema: procedure expose g.
 529 |   parse arg sName,sEntireXType,node
 530 |   sElementName = sName
 531 |   if g.0USED.sElementName = 1 /* If this name is already used */
 532 |   then do
 533 |     do i = 1 by 1 until g.0USED.sNameX = ''
 534 |       sNameX = sElementName || i
 535 |     end
 536 |     sElementName = sNameX
 537 |   end
 538 |   g.0USED.sElementName = 1
 539 |   element = createElement('element')
 540 |   call appendChild element,g.0SCHEMA
 541 |   call setAttributes element,,
 542 |        'name',sElementName,,
 543 |        'type',getSchemaEncoding(sEntireXType)
 544 |   part = createElement('wsdl:part')
 545 |   call appendChild part,node
 546 |   call setAttributes part,,
 547 |        'name',sName,,
 548 |        'element','impl:'sElementName
 549 | return
 550 | 
 551 | 
 552 | /*
 553 | style=wrapped
 554 | 
 555 | Special case of DOCLIT where there is only one parameter and it has the
 556 | same qname as the operation. In such cases, there is no actual type with
 557 | the name. The elements are treated as parameters to the operation
 558 | 
 559 |    <soap:body>
 560 |       <one-arg-same-name-as-operation>
 561 |          <arg1Element>5</arg1Element>
 562 |          <arg2Element>5.0</arg2Element>
 563 |       </one-arg-same-name-as-operation>
 564 |    </soap:body>
 565 | 
 566 | */
 567 | createDocWrapped: procedure expose g.
 568 |   parse arg node
 569 |   say 'IDL003I Generating WSDL style=DOCUMENT (WRAPPED) use=LITERAL'
 570 |   /*
 571 |   <wsdl:message name="verifyRequest">
 572 |       <wsdl:part element="impl:verify" name="parameters"/>
 573 |   </wsdl:message>
 574 |   <wsdl:message name="verifyResponse">
 575 |       <wsdl:part element="impl:verifyResponse" name="parameters"/>
 576 |   </wsdl:message>
 577 |       .
 578 |       .
 579 |   */
 580 |   programs = getChildrenByName(node,'programs')
 581 |   if programs <> ''
 582 |   then do
 583 |     programs = getChildren(programs)
 584 |     do i = 1 to words(programs)
 585 |       program = word(programs,i)
 586 |       sOperation = getAttribute(program,'name')
 587 |       sRequestElement = sOperation
 588 |       sResponseElement = sOperation'Response'
 589 | 
 590 |       call appendMessage sOperation'Request',sRequestElement
 591 |       call appendMessage sOperation'Response',sResponseElement
 592 | 
 593 |       request  = getSequence(sRequestElement)
 594 |       response = getSequence(sResponseElement)
 595 |       parms = getChildren(program)
 596 |       do j = 1 to words(parms)
 597 |         parm = word(parms,j)
 598 |         sType = getAttribute(parm,'type')
 599 |         if sType <> '' /* if it is not a group */
 600 |         then do
 601 |           sName = getAttribute(parm,'name')
 602 |           sDir  = getAttribute(parm,'direction')
 603 |           if wordpos('In',sDir) > 0
 604 |           then call appendWrapped sName,sType,request
 605 |           if wordpos('Out',sDir) > 0
 606 |           then call appendWrapped sOperation'Return',sType,response
 607 |         end
 608 |       end
 609 |     end
 610 |   end
 611 | return
 612 | 
 613 | appendMessage: procedure expose g.
 614 |   parse arg sMessageName,sElementName
 615 |   message = createElement('wsdl:message')
 616 |   call appendChild message,g.0DEFS
 617 |   call setAttribute message,'name',sMessageName
 618 |   part = createElement('wsdl:part')
 619 |   call appendChild part,message
 620 |   call setAttributes part,,
 621 |        'name','parameters',,
 622 |        'element','impl:'sElementName
 623 | return
 624 | 
 625 | /*
 626 |   <element name="verify">
 627 |       <complexType>
 628 |           <sequence>
 629 |               <element name="userid" type="xsd:string"/>
 630 |               <element name="password" type="xsd:string"/>
 631 |           </sequence>
 632 |       </complexType>
 633 |   </element>
 634 |   <element name="verifyResponse">
 635 |       <complexType>
 636 |           <sequence>
 637 |               <element name="verifyReturn"
 638 |                        type="impl:SecurityContext"/>
 639 |           </sequence>
 640 |       </complexType>
 641 |   </element>
 642 | */
 643 | getSequence: procedure expose g.
 644 |   parse arg sName
 645 |   element = createElement('element')
 646 |   call appendChild element,g.0SCHEMA
 647 |   call setAttribute element,'name',sName
 648 |   complexType = createElement('complexType')
 649 |   call appendChild complexType,element
 650 |   sequence = createElement('sequence')
 651 |   call appendChild sequence,complexType
 652 | return sequence
 653 | 
 654 | /*
 655 |    <element name="userid" type="xsd:string"/>
 656 |    or
 657 |    <element name="verifyReturn" type="impl:schemaReference"/>
 658 | */
 659 | appendWrapped: procedure expose g.
 660 |   parse arg sName,sEntireXType,sequence
 661 |   element = createElement('element')
 662 |   call appendChild element,sequence
 663 |   call setAttributes element,,
 664 |        'name',sName,,
 665 |        'type',getSchemaEncoding(sEntireXType)
 666 | return
 667 | 
 668 | /*
 669 | style=document, use=encoded [NOT WS-I compliant]
 670 | 
 671 | There is no enclosing operation name element, but the parmeters are
 672 | encoded using SOAP encoding. This mode is not (well?) supported by
 673 | Apache Axis.
 674 | 
 675 | */
 676 | createDocEncoded: procedure expose g.
 677 |   parse arg node
 678 |   say 'IDL099W WSDL style=DOCUMENT use=ENCODED not supported'
 679 | return
 680 | 
 681 | /*
 682 | style=rpc, use=literal
 683 | 
 684 | First element of the SOAP body is the operation.
 685 | The operation contains elements describing the parameters,
 686 | which are not serialized as encoded (and no multi-ref)
 687 | 
 688 |    <soap:body>
 689 |       <operation>
 690 |          <arg1>5</arg1>
 691 |          <arg2>5.0</arg2>
 692 |       </operation>
 693 |    </soap:body>
 694 | 
 695 | */
 696 | createRpcLiteral: procedure expose g.
 697 |   parse arg node
 698 |   say 'IDL003I Generating WSDL style=RPC use=LITERAL'
 699 |   /*
 700 |   <wsdl:message name="changePasswordRequest">
 701 |       <wsdl:part name="userid" type="xsd:string"/>
 702 |       <wsdl:part name="password" type="xsd:string"/>
 703 |       <wsdl:part name="newPassword" type="xsd:string"/>
 704 |   </wsdl:message>
 705 |   <wsdl:message name="changePasswordResponse">
 706 |       <wsdl:part name="changePasswordReturn"
 707 |                  type="impl:SecurityContext"/>
 708 |   </wsdl:message>
 709 |       .
 710 |       .
 711 |   */
 712 |   programs = getChildrenByName(node,'programs')
 713 |   if programs <> ''
 714 |   then do
 715 |     programs = getChildren(programs)
 716 |     do i = 1 to words(programs)
 717 |       program = word(programs,i)
 718 |       sOperation = getAttribute(program,'name')
 719 |       request  = createElement('wsdl:message')
 720 |       call appendChild request,g.0DEFS
 721 |       call setAttribute request,'name',sOperation'Request'
 722 |       response = createElement('wsdl:message')
 723 |       call appendChild response,g.0DEFS
 724 |       call setAttribute response,'name',sOperation'Response'
 725 |       parms = getChildren(program)
 726 |       do j = 1 to words(parms)
 727 |         parm = word(parms,j)
 728 |         sType = getAttribute(parm,'type')
 729 |         if sType <> '' /* if it is not a group */
 730 |         then do
 731 |           sName = getAttribute(parm,'name')
 732 |           sDir  = getAttribute(parm,'direction')
 733 |           if wordpos('In',sDir) > 0
 734 |           then call appendPartType sName,sType,request
 735 |           if wordpos('Out',sDir) > 0
 736 |           then call appendPartType sOperation'Return',sType,response
 737 |         end
 738 |       end
 739 |     end
 740 |   end
 741 | return
 742 | 
 743 | /*
 744 | style=rpc, use=encoded [NOT WS-I compliant]
 745 | 
 746 | First element of the SOAP body is the operation.
 747 | The operation contains elements describing the parameters,
 748 | which are serialized as encoded (possibly multi-ref)
 749 | 
 750 |    <soap:body>
 751 |       <operation>
 752 |          <arg1 xsi:type="xsd:int">5</arg1>
 753 |          <arg2 xsi:type="xsd:float">5.0</arg2>
 754 |       </operation>
 755 |    </soap:body>
 756 | 
 757 | */
 758 | createRpcEncoded: procedure expose g.
 759 |   parse arg node
 760 |   say 'IDL003I Generating WSDL style=RPC use=ENCODED'
 761 |   /*
 762 |   <wsdl:message name="changePasswordRequest">
 763 |       <wsdl:part name="userid" type="soapenc:string"/>
 764 |       <wsdl:part name="password" type="soapenc:string"/>
 765 |       <wsdl:part name="newPassword" type="soapenc:string"/>
 766 |   </wsdl:message>
 767 |   <wsdl:message name="changePasswordResponse">
 768 |       <wsdl:part name="changePasswordReturn"
 769 |                  type="impl:SecurityContext"/>
 770 |   </wsdl:message>
 771 |       .
 772 |       .
 773 |   */
 774 |   programs = getChildrenByName(node,'programs')
 775 |   if programs <> ''
 776 |   then do
 777 |     programs = getChildren(programs)
 778 |     do i = 1 to words(programs)
 779 |       program = word(programs,i)
 780 |       sOperation = getAttribute(program,'name')
 781 |       request  = createElement('wsdl:message')
 782 |       call appendChild request,g.0DEFS
 783 |       call setAttribute request,'name',sOperation'Request'
 784 |       response = createElement('wsdl:message')
 785 |       call appendChild response,g.0DEFS
 786 |       call setAttribute response,'name',sOperation'Response'
 787 |       parms = getChildren(program)
 788 |       do j = 1 to words(parms)
 789 |         parm = word(parms,j)
 790 |         sType = getAttribute(parm,'type')
 791 |         if sType <> '' /* if it is not a group */
 792 |         then do
 793 |           sName = getAttribute(parm,'name')
 794 |           sDir  = getAttribute(parm,'direction')
 795 |           if wordpos('In',sDir) > 0
 796 |           then call appendPartType sName,sType,request
 797 |           if wordpos('Out',sDir) > 0
 798 |           then call appendPartType sOperation'Return',sType,response
 799 |         end
 800 |       end
 801 |     end
 802 |   end
 803 | return
 804 | 
 805 | /*
 806 | <wsdl:part name="userid" type="soapenc:string"/>
 807 | or
 808 | <wsdl:part name="operationReturn" type="impl:schemaReference"/>
 809 | */
 810 | appendPartType: procedure expose g.
 811 |   parse arg sName,sEntireXType,node
 812 |   part = createElement('wsdl:part')
 813 |   call appendChild part,node
 814 |   call setAttributes part,,
 815 |        'name',sName,,
 816 |        'type',getEncoding(sEntireXType)
 817 | return
 818 | 
 819 | /*
 820 | <complexType name="SecurityContext">
 821 |     <sequence>
 822 |         <element name="reason" nillable="true"
 823 |                  type="soapenc:string"/>
 824 |         <element name="reasonCode" nillable="true"
 825 |                  type="soapenc:int"/>
 826 |         <element name="returnCode" nillable="true"
 827 |                  type="soapenc:int"/>
 828 |         <element name="success" nillable="true"
 829 |                  type="soapenc:boolean"/>
 830 |         <element name="userid" nillable="true"
 831 |                  type="soapenc:string"/>
 832 |     </sequence>
 833 | </complexType>
 834 | */
 835 | appendComplexType: procedure expose g.
 836 |   parse arg struct,schema
 837 |   sStructureName = getAttribute(struct,'name')
 838 |   complexType = createElement('complexType')
 839 |   call appendChild complexType,schema
 840 |   call setAttribute complexType,'name',sStructureName
 841 |   sequence = createElement('sequence')
 842 |   call appendChild sequence,complexType
 843 |   parms = getChildNodes(struct)
 844 |   do i = 1 to words(parms)
 845 |     parm = word(parms,i)
 846 |     nLevel = getAttribute(parm,'level')
 847 |     sName  = getAttribute(parm,'name')
 848 |     sType  = getAttribute(parm,'type')
 849 |     sDirection = getAttribute(parm,'direction')
 850 |     select
 851 |       when sType = '' then do
 852 |         /* ignore an EntireX grouping level */
 853 |       end
 854 |       when left(sType,1) = "'" then do
 855 |         parse var sType "'"sRef"'"
 856 |       end
 857 |       otherwise do
 858 |         call appendElement sName,sType,sequence
 859 |       end
 860 |     end
 861 |   end
 862 | return
 863 | 
 864 | /*
 865 | <sequence>
 866 |     <element name="reason" nillable="true"
 867 |              type="soapenc:string"/>
 868 |     <element name="reasonCode" nillable="true"
 869 |              type="soapenc:int"/>
 870 |     <element name="returnCode" nillable="true"
 871 |              type="soapenc:int"/>
 872 |     <element name="success" nillable="true"
 873 |              type="soapenc:boolean"/>
 874 |     <element name="userid" nillable="true"
 875 |              type="soapenc:string"/>
 876 | </sequence>
 877 | */
 878 | appendElement: procedure expose g.
 879 |   parse arg sName,sEntireXType,sequence
 880 |   element = createElement('element')
 881 |   call appendChild element,sequence
 882 |   call setAttributes element,,
 883 |        'name',sName,,
 884 |        'nillable','true',,
 885 |        'type',getEncoding(sEntireXType)
 886 | return
 887 | 
 888 | getEncoding: procedure expose g.
 889 |   parse arg sEntireXType
 890 |   if g.0OPTION.ENCODED
 891 |   then sEncoding = getSoapEncoding(sEntireXType)
 892 |   else sEncoding = getSchemaEncoding(sEntireXType)
 893 | return sEncoding
 894 | 
 895 | /* Map an EntireX data type to a SOAP encoded type */
 896 | getSoapEncoding: procedure expose g.
 897 |   parse arg sEntireXType . 1 sType1 +1 1 sType2 +2
 898 |   select
 899 |     when sType1 = 'A' then do /* alphanumeric */
 900 |       if sType2 = 'AV'        /* variable length */
 901 |       then sEncoding = 'soapenc:string'
 902 |       else sEncoding = 'soapenc:string'
 903 |     end
 904 |     when sType1 = 'B' then do /* binary */
 905 |       if sType2 = 'BV'        /* variable length */
 906 |       then sEncoding = 'soapenc:int'
 907 |       else sEncoding = 'soapenc:int'
 908 |     end
 909 |     when sType1 = 'D' then do /* date */
 910 |       sEncoding = 'soapenc:date'
 911 |     end
 912 |     when sType1 = 'F' then do /* floating point */
 913 |       sEncoding = 'soapenc:float'
 914 |     end
 915 |     when sType1 = 'I' then do /* integer */
 916 |       sEncoding = 'soapenc:int'
 917 |     end
 918 |     when sType1 = 'L' then do /* logical */
 919 |       sEncoding = 'soapenc:boolean'
 920 |     end
 921 |     when sType1 = 'N' then do /* numeric */
 922 |       if sType2 = 'NU'        /* unsigned */
 923 |       then sEncoding = 'soapenc:decimal'
 924 |       else sEncoding = 'soapenc:decimal'
 925 |     end
 926 |     when sType1 = 'P' then do /* packed decimal */
 927 |       if sType2 = 'PU'        /* unsigned */
 928 |       then sEncoding = 'soapenc:decimal'
 929 |       else sEncoding = 'soapenc:decimal'
 930 |     end
 931 |     when sType1 = 'T' then do /* time */
 932 |       sEncoding = 'soapenc:time'
 933 |     end
 934 |     when sType1 = "'" then do /* reference to a struct */
 935 |       parse var sEntireXType "'"sReference"'"
 936 |       sEncoding = 'impl:'sReference
 937 |     end
 938 |     otherwise do
 939 |       sEncoding = 'soapenc:anyType'
 940 |     end
 941 |   end
 942 | return sEncoding
 943 | 
 944 | /* Map an EntireX data type to an XML schema data type */
 945 | getSchemaEncoding: procedure expose g.
 946 |   parse arg sEntireXType . 1 sType1 +1 1 sType2 +2
 947 |   select
 948 |     when sType1 = 'A' then do /* alphanumeric */
 949 |       if sType2 = 'AV'        /* variable length */
 950 |       then sEncoding = 'xsd:string'
 951 |       else sEncoding = 'xsd:string'
 952 |     end
 953 |     when sType1 = 'B' then do /* binary */
 954 |       if sType2 = 'BV'        /* variable length */
 955 |       then sEncoding = 'xsd:int'
 956 |       else sEncoding = 'xsd:int'
 957 |     end
 958 |     when sType1 = 'D' then do /* date */
 959 |       sEncoding = 'xsd:date'
 960 |     end
 961 |     when sType1 = 'F' then do /* floating point */
 962 |       sEncoding = 'xsd:float'
 963 |     end
 964 |     when sType1 = 'I' then do /* integer */
 965 |       sEncoding = 'xsd:int'
 966 |     end
 967 |     when sType1 = 'L' then do /* logical */
 968 |       sEncoding = 'xsd:boolean'
 969 |     end
 970 |     when sType1 = 'N' then do /* numeric */
 971 |       if sType2 = 'NU'        /* unsigned */
 972 |       then sEncoding = 'xsd:decimal'
 973 |       else sEncoding = 'xsd:decimal'
 974 |     end
 975 |     when sType1 = 'P' then do /* packed decimal */
 976 |       if sType2 = 'PU'        /* unsigned */
 977 |       then sEncoding = 'xsd:decimal'
 978 |       else sEncoding = 'xsd:decimal'
 979 |     end
 980 |     when sType1 = 'T' then do /* time */
 981 |       sEncoding = 'xsd:time'
 982 |     end
 983 |     when sType1 = "'" then do /* reference to a struct */
 984 |       parse var sEntireXType "'"sReference"'"
 985 |       sEncoding = 'impl:'sReference
 986 |     end
 987 |     otherwise do
 988 |       sEncoding = 'xsd:anyType'
 989 |     end
 990 |   end
 991 | return sEncoding
 992 | 
 993 | 
 994 | getFilenameWithoutExtension: procedure expose g.
 995 |   parse arg sFile
 996 |   parse value reverse(sFile) with '.'sRest
 997 | return reverse(sRest)
 998 | 
 999 | scanEntireXIdlFile: procedure expose g.
1000 |   idl = createElement('idl')
1001 |   g.0FILEIN = openFile(g.0FILEIDL)
1002 |   sLine = getNextLine()
1003 |   do while g.0RC = 0 & sLine <> '** End of file'
1004 |     parse var sLine sAction sName ' is'
1005 |     select
1006 |       when sAction = 'library' then do
1007 |         parse var sName sName':'sAlias
1008 |         sName  = strip(sName,'BOTH',"'")
1009 |         sAlias = strip(sAlias,'BOTH',"'")
1010 |         library = createElement('library')
1011 |         call setAttributes library,,
1012 |              'name',sName,,
1013 |              'alias',sAlias
1014 |         call appendChild library,idl
1015 |         structures = createElement('structures')
1016 |         call appendChild structures,library
1017 |         programs = createElement('programs')
1018 |         call appendChild programs,library
1019 |       end
1020 |       when sAction = 'program' then do
1021 |         parse var sName sName':'sAlias
1022 |         sName  = strip(sName,'BOTH',"'")
1023 |         sAlias = strip(sAlias,'BOTH',"'")
1024 |         program = createElement('program')
1025 |         call setAttributes program,,
1026 |              'name',sName,,
1027 |              'alias',sAlias
1028 |         call appendChild program,programs
1029 |         call getParameters program
1030 |       end
1031 |       when sAction = 'struct' then do
1032 |         parse var sName sName':'sAlias
1033 |         g.0STRUCT = sName
1034 |         sName  = strip(sName,'BOTH',"'")
1035 |         sAlias = strip(sAlias,'BOTH',"'")
1036 |         struct = createElement('struct')
1037 |         call setAttributes struct,,
1038 |              'name',sName,,
1039 |              'alias',sAlias
1040 |         call appendChild struct,structures
1041 |         call getParameters struct
1042 |       end
1043 |       otherwise do
1044 |         say 'IDL002E Unknown IDL file input line:' sLine
1045 |       end
1046 |     end
1047 |     sLine = getNextLine()
1048 |   end
1049 |   rc = closeFile(g.0FILEIN)
1050 | return idl
1051 | 
1052 | getParameters: procedure expose g.
1053 |   parse arg parent
1054 |   sLine = getLineContaining('define data parameter')
1055 |   if g.0RC <> 0 then return
1056 |   sLine = getNextLine()
1057 |   do while g.0RC = 0 & sLine <> 'end-define'
1058 |     parse var sLine nLevel sName '('sType')' sDirection
1059 |     parm = createElement('parm')
1060 |     call appendChild parm,parent
1061 |     call setAttributes parm,,
1062 |          'level',nLevel,,
1063 |          'name',strip(sName),,
1064 |          'type',sType
1065 |     if sDirection <> ''
1066 |     then call setAttribute parm,'direction',strip(sDirection)
1067 |     sLine = getNextLine()
1068 |   end
1069 | return
1070 | 
1071 | getLineContaining: procedure expose g.
1072 |   parse arg sSearchArg
1073 |   sLine = getLine(g.0FILEIN)
1074 |   do while g.0RC = 0 & pos(sSearchArg, sLine) = 0
1075 |     sLine = getLine(g.0FILEIN)
1076 |   end
1077 | return sLine
1078 | 
1079 | getNextLine: procedure expose g.
1080 |   sLine = removeWhiteSpace(getLine(g.0FILEIN))
1081 |   do while g.0RC = 0 & (sLine = '' | left(sLine,2) = '/*')
1082 |     sLine = removeWhiteSpace(getLine(g.0FILEIN))
1083 |   end
1084 |   if pos('/*',sLine) > 0
1085 |   then parse var sLine sLine '/*' .
1086 | return sLine
1087 | 
1088 | setOptions: procedure expose g.
1089 |   parse upper arg sOptions
1090 |   /* set default options... */
1091 |   g.0OPTION.DUMP     = 0
1092 |   g.0OPTION.XML      = 0
1093 |   g.0OPTION.RPC      = 0
1094 |   g.0OPTION.DOCUMENT = 0
1095 |   g.0OPTION.ENCODED  = 0
1096 |   g.0OPTION.LITERAL  = 0
1097 |   g.0OPTION.WRAPPED  = 0
1098 |   do i = 1 to words(sOptions)
1099 |     sOption = word(sOptions,i)
1100 |     g.0OPTION.sOption = 1
1101 |   end
1102 |   if g.0OPTION.RPC | g.0OPTION.DOCUMENT |,
1103 |      g.0OPTION.ENCODED | g.0OPTION.LITERAL | g.0OPTION.WRAPPED
1104 |   then nop
1105 |   else do /* Set the default style... */
1106 |     g.0OPTION.WRAPPED  = 1
1107 |   end
1108 |   if g.0OPTION.WRAPPED
1109 |   then do
1110 |     g.0OPTION.DOCUMENT = 1
1111 |     g.0OPTION.LITERAL  = 1
1112 |     g.0OPTION.RPC      = 0
1113 |     g.0OPTION.ENCODED  = 0
1114 |   end
1115 |   if g.0OPTION.DOCUMENT then g.0OPTION.RPC = 0
1116 |   if g.0OPTION.RPC      then g.0OPTION.DOCUMENT = 0
1117 |   if g.0OPTION.LITERAL  then g.0OPTION.ENCODED = 0
1118 |   if g.0OPTION.ENCODED  then g.0OPTION.LITERAL = 0
1119 | return
1120 | 
1121 | Prolog:
1122 |   if g.0ENV = 'TSO'
1123 |   then g.0LF = '15'x
1124 |   else g.0LF = '0A'x
1125 |   doc = createDocument('dummy') /* just to get structures in place */
1126 | return
1127 | 
1128 | Epilog: procedure expose g.
1129 | return
1130 | 
1131 | /*INCLUDE pretty.rex */
1132 | 


--------------------------------------------------------------------------------
/idlfile.txt:
--------------------------------------------------------------------------------
 1 | /*********************************************************************
 2 | /** This is an example IDL file that you can process using the
 3 | /** IDL2WSDL rexx procedure.
 4 | /*********************************************************************
 5 | library 'TalkingClock' is
 6 |   program 'getTime' is
 7 |     define data parameter
 8 |     1 result   (A32)   Out
 9 |     end-define
10 | 
11 |   program 'Sprechen' is
12 |     define data parameter
13 |     1 result   (AV80)   Out
14 |     end-define
15 | 
16 |   program 'Speak' is
17 |     define data parameter
18 |     1 result   (AV80)   Out
19 |     end-define
20 | 
21 | library 'Security' is
22 |   program 'changePassword' is
23 |     define data parameter
24 |     1 userid   (A8)   In
25 |     1 password   (A8)   In
26 |     1 newPassword   (A8)   In
27 |     1 result   ('SecurityContext')   Out
28 |     end-define
29 | 
30 |   program 'verify' is /*Authenticate a userid
31 |     define data parameter
32 |     1 userid   (A8)   In
33 |     1 password   (A8)   In
34 |     1 result   ('SecurityContext')   Out
35 |     end-define
36 | 
37 |   program 'authorise' is /*Authorise access to a resource
38 |     define data parameter
39 |     1 userid   (A8)   In
40 |     1 password   (A8)   In
41 |     1 resource   (A44)   In
42 |     1 result   ('SecurityContext')   Out
43 |     end-define
44 | 
45 | /*The result of a Security operation is a collection of return and reason codes
46 |   struct 'SecurityContext' is
47 |     define data parameter
48 |     1 userid   (A8)
49 |     1 success   (L)
50 |     1 returnCode   (B4)
51 |     1 reasonCode   (B4)
52 |     1 reason   (AV80)
53 |     end-define
54 | 
55 | /*Preceding comment lines
56 | library 'Gamut':'Gamut Alias' is
57 |   /*Same line comment
58 |   struct 'aStructure' is
59 |     define data parameter
60 |     1 aVar2   (D)
61 |     1 aVar3   (A1)
62 |     1 aVar4   (BV)
63 |     1 aVar5   (F4)
64 |     1 aVar6   (I4)
65 |     1 aVar7   (L)
66 |     1 aVar8   (N8.3)
67 |     1 aVar9   (NU8.3)
68 |     1 aVar10   (P8.3)
69 |     1 aVar11   (PU8.3)
70 |     1 aVar12   (T)
71 |     1 aGroup
72 |       2 aVar1   (AV80/1,2,3)    aligned
73 |       2 aGroup2
74 |         3 aVar3   (AV)
75 |         3 aVar2   (AV)
76 |     end-define
77 | 
78 |   /*Preceding comment lines
79 |   program 'Operation':'Operation Alias' is /*Same line comment
80 |     define data parameter
81 |     1 aParm1   (A1)   In
82 |     1 aParm2   (AV)   Out
83 |     1 aStructureRef   ('aStructure')   In
84 |     1 aStructureRef2   ('aStructure')   Out
85 |     1 aStructureRef3   ('aStructure')   In Out
86 |     end-define
87 | 
88 | 
89 | ** End of file
90 | 


--------------------------------------------------------------------------------
/images/lose-the-horse-luke.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/abend0c1/rexxxmlparser/488d40d94449e049d94a4eef2416ec46011efda4/images/lose-the-horse-luke.jpg


--------------------------------------------------------------------------------
/io.rex:
--------------------------------------------------------------------------------
  1 | /*REXX 2.0.0
  2 | Copyright (c) 2009-2020, Andrew J. Armstrong
  3 | All rights reserved.
  4 | 
  5 | Redistribution and use in source and binary forms, with or without 
  6 | modification, are permitted provided that the following conditions are 
  7 | met:
  8 | 
  9 |     * Redistributions of source code must retain the above copyright 
 10 |       notice, this list of conditions and the following disclaimer.
 11 |     * Redistributions in binary form must reproduce the above copyright 
 12 |       notice, this list of conditions and the following disclaimer in 
 13 |       the documentation and/or other materials provided with the
 14 |       distribution.
 15 | 
 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
 19 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
 22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 27 | 
 28 | */
 29 | 
 30 | /*REXX*****************************************************************
 31 | **                                                                   **
 32 | ** NAME     - IO                                                     **
 33 | **                                                                   **
 34 | ** FUNCTION - Simple I/O routines.                                   **
 35 | **                                                                   **
 36 | ** API      - The routines in this module are:                       **
 37 | **                                                                   **
 38 | **            openFile(filename,options,attrs)                       **
 39 | **                Opens the specified file with the specified options**
 40 | **                and returns a file handle to be used in other I/O  **
 41 | **                operations. By default the file will be opened for **
 42 | **                input. Specify 'OUTPUT' to open it for output.     **
 43 | **                For TSO, you can specify any operand of the TSO    **
 44 | **                ALLOCATE command in the third operand. For example:**
 45 | **                rc = openFile('MY.FILE','OUTPUT','RECFM(F,B)'      **
 46 | **                              'LRECL(80) BLKSIZE(27920)')          **
 47 | **                                                                   **
 48 | **            closeFile(handle)                                      **
 49 | **                Closes the file specified by 'handle' (which was   **
 50 | **                returned by the openFile() routine.                **
 51 | **                                                                   **
 52 | **            getLine(handle)                                        **
 53 | **                Reads the next line from the file specified by     **
 54 | **                'handle'.                                          **
 55 | **                                                                   **
 56 | **            putLine(handle,data)                                   **
 57 | **                Appends the specified data to the file specified   **
 58 | **                by 'handle'.                                       **
 59 | **                                                                   **
 60 | **                                                                   **
 61 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com>    **
 62 | **                                                                   **
 63 | ** HISTORY  - Date     By  Reason (most recent at the top please)    **
 64 | **            -------- --------------------------------------------- **
 65 | **            20090822 AJA Changed from GPL to BSD license.          **
 66 | **            20061017 AJA Added support for UNIX environment.       **
 67 | **                         Tested on Ubuntu Linux 6.06 LTS.          **
 68 | **            20050930 AJA Initial version.                          **
 69 | **                                                                   **
 70 | **********************************************************************/
 71 | 
 72 |   parse source . . sSourceFile .
 73 |   parse value sourceline(1) with . sVersion
 74 |   say 'Simple Rexx I/O routines' sVersion
 75 |   say 'You cannot invoke this rexx by itself!'
 76 |   say
 77 |   say 'This rexx is a collection of subroutines to be called'
 78 |   say 'from your own rexx procedures. You should either:'
 79 |   say '  - Append this procedure to your own rexx procedure,'
 80 |   say '    or,'
 81 |   say '  - Append the following line to your rexx:'
 82 |   say '    /* INCLUDE' sSourceFile '*/'
 83 |   say '    ...and run the rexx preprocessor:'
 84 |   say '    rexxpp myrexx myrexxpp'
 85 |   say '    This will create myrexxpp by appending this file to myrexx'
 86 | exit
 87 | 
 88 | /*-------------------------------------------------------------------*
 89 |  * Open a file
 90 |  *-------------------------------------------------------------------*/
 91 | 
 92 | openFile: procedure expose g.
 93 |   parse arg sFile,sOptions,sAttrs
 94 |   hFile = ''
 95 |   select
 96 |     when g.0ENV = 'TSO' then do
 97 |       bOutput = wordpos('OUTPUT',sOptions) > 0
 98 |       bQuoted = left(sFile,1) = "'"
 99 |       if bQuoted then sFile = strip(sFile,,"'")
100 |       parse var sFile sDataset'('sMember')'
101 |       if sMember <> '' then sFile = sDataset
102 |       if bQuoted then sFile = "'"sFile"'"
103 |       if bOutput
104 |       then 'LMINIT  DATAID(hFile) DATASET(&sFile) ENQ(EXCLU)'
105 |       else 'LMINIT  DATAID(hFile) DATASET(&sFile)'
106 |       if sMember <> ''
107 |       then do /* Open a member of a PDS */
108 |         'LMOPEN  DATAID(&hFile) OPTION(INPUT)' /* Input initially */
109 |         /* ... can't update ISPF stats when opened for output */
110 |         g.0MEMBER.hFile = sMember
111 |         'LMMFIND DATAID(&hFile) MEMBER('sMember') STATS(YES)'
112 |         if bOutput
113 |         then do
114 |           if rc = 0
115 |           then g.0STATS.hFile = zlvers','zlmod','zlc4date
116 |           else g.0STATS.hFile = '1,0,0000/00/00'
117 |           'LMCLOSE DATAID(&hFile)'
118 |           'LMOPEN  DATAID(&hFile) OPTION(&sOptions)'
119 |         end
120 |       end
121 |       else do /* Open a sequential dataset */
122 |         'LMOPEN  DATAID(&hFile) OPTION(&sOptions)'
123 |         if rc <> 0 /* If dataset does not already exist... */
124 |         then do /* Create sequential dataset then open it */
125 |           'LMCLOSE DATAID(&hFile)'
126 |           'LMFREE  DATAID(&hFile)'
127 |           address TSO 'ALLOCATE DATASET('sFile') NEW CATALOG',
128 |                       'SPACE(5,15) TRACKS RECFM(V,B)',
129 |                       'LRECL('g.0OPTION.WRAP.1 + 4')',
130 |                       'BLKSIZE(27990)' sAttrs
131 |           if bOutput
132 |           then do
133 |             'LMINIT  DATAID(hFile) DATASET(&sFile) ENQ(EXCLU)'
134 |             'LMOPEN  DATAID(&hFile) OPTION(&sOptions)'
135 |           end
136 |           else do
137 |             'LMINIT  DATAID(hFile) DATASET(&sFile)'
138 |             'LMOPEN  DATAID(&hFile) OPTION(INPUT)'
139 |           end
140 |         end
141 |       end
142 |       g.0OPTIONS.hFile = sOptions
143 |       g.0rc = rc /* Return code from LMOPEN */
144 |     end
145 |     otherwise do
146 |       if wordpos('OUTPUT',sOptions) > 0
147 |       then junk = stream(sFile,'COMMAND','OPEN WRITE REPLACE')
148 |       else junk = stream(sFile,'COMMAND','OPEN READ')
149 |       hFile = sFile
150 |       if stream(sFile,'STATUS') = 'READY'
151 |       then g.0rc = 0
152 |       else g.0rc = 4
153 |     end
154 |   end
155 | return hFile
156 | 
157 | /*-------------------------------------------------------------------*
158 |  * Read a line from the specified file
159 |  *-------------------------------------------------------------------*/
160 | 
161 | getLine: procedure expose g.
162 |   parse arg hFile
163 |   sLine = ''
164 |   select
165 |     when g.0ENV = 'TSO' then do
166 |       'LMGET DATAID(&hFile) MODE(INVAR)',
167 |             'DATALOC(sLine) DATALEN(nLine) MAXLEN(32768)'
168 |       g.0rc = rc
169 |       sLine = strip(sLine,'TRAILING')
170 |       if sLine = '' then sLine = ' '
171 |     end
172 |     otherwise do
173 |       g.0rc = 0
174 |       if chars(hFile) > 0
175 |       then sLine = linein(hFile)
176 |       else g.0rc = 4
177 |     end
178 |   end
179 | return sLine
180 | 
181 | /*-------------------------------------------------------------------*
182 |  * Append a line to the specified file
183 |  *-------------------------------------------------------------------*/
184 | 
185 | putLine: procedure expose g.
186 |   parse arg hFile,sLine
187 |   select
188 |     when g.0ENV = 'TSO' then do
189 |       g.0LINES = g.0LINES + 1
190 |       'LMPUT DATAID(&hFile) MODE(INVAR)',
191 |             'DATALOC(sLine) DATALEN('length(sLine)')'
192 |     end
193 |     otherwise do
194 |       junk = lineout(hFile,sLine)
195 |       rc = 0
196 |     end
197 |   end
198 | return rc
199 | 
200 | /*-------------------------------------------------------------------*
201 |  * Close the specified file
202 |  *-------------------------------------------------------------------*/
203 | 
204 | closeFile: procedure expose g.
205 |   parse arg hFile
206 |   rc = 0
207 |   select
208 |     when g.0ENV = 'TSO' then do
209 |       if g.0MEMBER.hFile <> '', /* if its a PDS */
210 |       & wordpos('OUTPUT',g.0OPTIONS.hFile) > 0 /* opened for output */
211 |       then do
212 |         parse value date('STANDARD') with yyyy +4 mm +2 dd +2
213 |         parse var g.0STATS.hFile zlvers','zlmod','zlc4date
214 |         zlcnorc  = min(g.0LINES,65535)   /* Number of lines   */
215 |         nVer = right(zlvers,2,'0')right(zlmod,2,'0')  /* vvmm */
216 |         nVer = right(nVer+1,4,'0')       /* vvmm + 1          */
217 |         parse var nVer zlvers +2 zlmod +2
218 |         if zlc4date = '0000/00/00'
219 |         then zlc4date = yyyy'/'mm'/'dd   /* Creation date     */
220 |         zlm4date = yyyy'/'mm'/'dd        /* Modification date */
221 |         zlmtime  = time()                /* Modification time */
222 |         zluser   = userid()              /* Modification user */
223 |         'LMMREP DATAID(&hFile) MEMBER('g.0MEMBER.hFile') STATS(YES)'
224 |       end
225 |       'LMCLOSE DATAID(&hFile)'
226 |       'LMFREE  DATAID(&hFile)'
227 |     end
228 |     otherwise do
229 |       if stream(hFile,'COMMAND','CLOSE') = 'UNKNOWN'
230 |       then rc = 0
231 |       else rc = 4
232 |     end
233 |   end
234 | return rc


--------------------------------------------------------------------------------
/pretty.rex:
--------------------------------------------------------------------------------
  1 | /*REXX 2.0.0
  2 | Copyright (c) 2009-2020, Andrew J. Armstrong
  3 | All rights reserved.
  4 | 
  5 | Redistribution and use in source and binary forms, with or without 
  6 | modification, are permitted provided that the following conditions are 
  7 | met:
  8 | 
  9 |     * Redistributions of source code must retain the above copyright 
 10 |       notice, this list of conditions and the following disclaimer.
 11 |     * Redistributions in binary form must reproduce the above copyright 
 12 |       notice, this list of conditions and the following disclaimer in 
 13 |       the documentation and/or other materials provided with the
 14 |       distribution.
 15 | 
 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
 19 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
 22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 27 | 
 28 | */
 29 | 
 30 | /*REXX*****************************************************************
 31 | **                                                                   **
 32 | ** NAME     - PRETTY                                                 **
 33 | **                                                                   **
 34 | ** FUNCTION - Pretty printer. This demonstrates the XML parser by    **
 35 | **            reformatting an xml input file.                        **
 36 | **                                                                   **
 37 | **                                                                   **
 38 | ** SYNTAX   - pretty infile [outfile] (options...)                   **
 39 | **                                                                   **
 40 | **            Where,                                                 **
 41 | **            infile   = Name of file to be parsed                   **
 42 | **            outfile  = Name of file to store the pretty output in. **
 43 | **                       The default is the console.                 **
 44 | **            options  = NOBLANKS - Suppress whitespace-only nodes   **
 45 | **                       DEBUG    - Display some debugging info      **
 46 | **                       DUMP     - Display the parse tree           **
 47 | **                                                                   **
 48 | **                                                                   **
 49 | ** NOTES    - 1. You will have to either append the PARSEXML source  **
 50 | **               manually to this demo source, or run this demo      **
 51 | **               source through the REXXPP rexx pre-processor.       **
 52 | **                                                                   **
 53 | **               To use the pre-processor, run:                      **
 54 | **                                                                   **
 55 | **               rexxpp pretty prettypp                              **
 56 | **                                                                   **
 57 | **               ...and then run the resulting rexx procedure over   **
 58 | **               an XML file of your choice:                         **
 59 | **                                                                   **
 60 | **               prettypp testxml [outxml]                           **
 61 | **                ...or...                                           **
 62 | **               prettypp testxml [outxml] (noblanks                 **
 63 | **                ...or...                                           **
 64 | **               prettypp testxml [outxml] (noblanks dump            **
 65 | **                                                                   **
 66 | **                                                                   **
 67 | **                                                                   **
 68 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com     **
 69 | **                                                                   **
 70 | ** HISTORY  - Date     By  Reason (most recent at the top please)    **
 71 | **            -------- --------------------------------------------- **
 72 | **            20200628 AJA Added showNodeNonRecursive function.      **
 73 | **            20090822 AJA Changed from GPL to BSD license.          **
 74 | **            20050920 AJA Allow root node to be specified.          **
 75 | **            20050907 AJA Escape text of attribute values.          **
 76 | **            20040706 AJA Assume default indentation amount.        **
 77 | **                         Allow output to a file.                   **
 78 | **            20031031 AJA Fix escaping text.                        **
 79 | **            20030911 AJA Removed default filename value. You       **
 80 | **                         must specify your own filename.           **
 81 | **            20030905 AJA Initial version.                          **
 82 | **                                                                   **
 83 | **********************************************************************/
 84 | 
 85 |   parse arg sFileIn sFileOut' ('sOptions')'
 86 |   parse value sourceline(1) with . sVersion
 87 |   say 'PRP000I Pretty Printer' sVersion
 88 | 
 89 |   /* Initialise the parser */
 90 |   call initParser sOptions /* <-- This is in PARSEXML rexx */
 91 | 
 92 |   /* Open the specified file and parse it */
 93 |   nParseRC = parseFile(sFileIn)
 94 | 
 95 |   parse source g.0ENV .
 96 |   if g.0ENV = 'TSO'
 97 |   then do
 98 |     address ISPEXEC
 99 |     'CONTROL ERRORS RETURN'
100 |     g.0LINES = 0
101 |     g.0NONRECURSIVE = 1
102 |   end
103 | 
104 |   call prettyPrinter sFileOut,2 /* 2 is the indentation amount */
105 | 
106 | exit nParseRC
107 | 
108 | /*-------------------------------------------------------------------*
109 |  * An example of how to navigate the tree
110 |  *-------------------------------------------------------------------*/
111 | 
112 | prettyPrinter: procedure expose g.
113 |   parse arg sFileOut,g.0TAB,nRoot
114 |   if g.0TAB = '' then g.0TAB = 2 /* indentation amount */
115 |   if nRoot = '' then nRoot = getRoot()
116 |   g.0INDENT = 0
117 |   g.0FILEOUT = ''
118 |   if sFileOut <> ''
119 |   then do
120 |     g.0FILEOUT = openFile(sFileOut,'OUTPUT')
121 |     if g.0rc = 0
122 |     then say 'PRP001I Creating' sFileOut
123 |     else do
124 |       say 'PRP002E Could not create' sFileOut'. Writing to console...'
125 |       g.0FILEOUT = '' /* null handle means write to console */
126 |     end
127 |   end
128 | 
129 |   call _setDefaultEntities
130 | 
131 |   call emitProlog
132 |   if g.0NONRECURSIVE = 1
133 |   then do
134 |     call showNodeNonRecursive nRoot
135 |    end
136 |   else do
137 |     g.0INDENT = -g.0TAB
138 |     call showNode nRoot
139 |   end
140 | 
141 |   if g.0FILEOUT <> ''
142 |   then do
143 |     say 'PRP002I Created' sFileOut
144 |     rc = closeFile(g.0FILEOUT)
145 |   end
146 | return
147 | 
148 | showNodeNonRecursive: procedure expose g.
149 |   parse arg topNodeAgain
150 |   g.0INDENT = 0
151 |   node = topNodeAgain
152 |   do until node = topNodeAgain | node = 0
153 |     if g.0SEEN.node = ''
154 |     then call emitBegin node
155 |     else call emitEnd node
156 |     g.0SEEN.node = 1
157 |     if g.0SOUTH.node = '' then do
158 |       g.0SOUTH.node = 1
159 |       if hasChildren(node)
160 |       then do
161 |         node = getFirstChild(node)
162 |       end
163 |       else do
164 |         call emitEnd node
165 |         nextSibling = getNextSibling(node)
166 |         if nextSibling = ''
167 |         then node = getParent(node)
168 |         else node = nextSibling
169 |       end
170 |     end
171 |     else do
172 |       nextSibling = getNextSibling(node)
173 |       if nextSibling = ''
174 |       then node = getParent(node)
175 |       else node = nextSibling
176 |     end
177 |   end
178 |   call emitEnd node
179 |   drop g.0SOUTH. g.0SEEN.
180 | return
181 | 
182 | emitBegin: procedure expose g.
183 |   parse arg node
184 |   select
185 |     when isElementNode(node) then call emitElementNodeNonRecursive(node)
186 |     when isTextNode(node)    then call emitTextNode(node)
187 |     when isCommentNode(node) then call emitCommentNode(node)
188 |     when isCDATA(node)       then call emitCDATA(node)
189 |     otherwise nop
190 |   end
191 |   g.0INDENT = g.0INDENT + 2
192 | return
193 | 
194 | emitEnd: procedure expose g.
195 |   parse arg node
196 |   g.0INDENT = g.0INDENT - 2
197 |   if isElementNode(node) & hasChildren(node)
198 |   then call Say '</'getName(node)'>'
199 | return
200 | 
201 | emitElementNodeNonRecursive: procedure expose g.
202 |   parse arg node
203 |   if hasChildren(node)
204 |   then call Say '<'getName(node)getAttrs(node)'>'
205 |   else call Say '<'getName(node)getAttrs(node)'/>'
206 | return
207 | 
208 | getAttrs: procedure expose g.
209 |   parse arg node
210 |   sAttrs = ''
211 |   do i = 1 to getAttributeCount(node)
212 |     sAttrs = sAttrs getAttributeName(node,i)'="' ||,
213 |                     escapeText(getAttribute(node,i))'"'
214 |   end
215 | return sAttrs
216 | 
217 | emitProlog: procedure expose g.
218 |   if g.?xml.version = ''
219 |   then sVersion = '1.0'
220 |   else sVersion = g.?xml.version
221 |   if g.?xml.encoding = ''
222 |   then sEncoding = 'UTF-8'
223 |   else sEncoding = g.?xml.encoding
224 |   if g.?xml.standalone = ''
225 |   then sStandalone = 'yes'
226 |   else sStandalone = g.?xml.standalone
227 | 
228 |   g.0INDENT = 0
229 |   call Say '<?xml version="'sVersion'"',
230 |                 'encoding="'sEncoding'"',
231 |               'standalone="'sStandalone'"?>'
232 | 
233 |   sDocType = getDocType()
234 |   if sDocType <> ''
235 |   then call Say '<!DOCTYPE' getName(getDocumentElement()) sDocType'>'
236 | return
237 | 
238 | showNode: procedure expose g.
239 |   parse arg node
240 |   g.0INDENT = g.0INDENT + g.0TAB
241 |   select
242 |     when isTextNode(node)    then call emitTextNode    node
243 |     when isCommentNode(node) then call emitCommentNode node
244 |     when isCDATA(node)       then call emitCDATA       node
245 |     otherwise                     call emitElementNode node
246 |   end
247 |   g.0INDENT = g.0INDENT - g.0TAB
248 | return
249 | 
250 | setPreserveWhitespace: procedure expose g.
251 |   parse arg bPreserve
252 |   g.0PRESERVEWS = bPreserve = 1
253 | return
254 | 
255 | emitTextNode: procedure expose g.
256 |   parse arg node
257 |   sText = getText(node)
258 |   if sText = '' then return
259 |   if g.0PRESERVEWS = 1
260 |   then call Say escapeText(sText)
261 |   else call Say escapeText(removeWhitespace(sText))
262 | return
263 | 
264 | emitCommentNode: procedure expose g.
265 |   parse arg node
266 |   call Say '<!--'getText(node)' -->'
267 | return
268 | 
269 | emitCDATA: procedure expose g.
270 |   parse arg node
271 |   call Say '<![CDATA['getText(node)']]>'
272 | return
273 | 
274 | emitElementNode: procedure expose g.
275 |   parse arg node
276 |   sName = getName(node)
277 |   sAttrs = ''
278 |   do i = 1 to getAttributeCount(node)
279 |     sAttrs = sAttrs getAttributeName(node,i)'="' ||,
280 |                     escapeText(getAttribute(node,i))'"'
281 |   end
282 |   sChildren = getChildren(node)
283 |   if sChildren = ''
284 |   then do
285 |     if sAttrs = ''
286 |     then call Say '<'sName'/>'
287 |     else call Say '<'sName strip(sAttrs)'/>'
288 |   end
289 |   else do
290 |     if sAttrs = ''
291 |     then call Say '<'sName'>'
292 |     else call Say '<'sName strip(sAttrs)'>'
293 |     child = getFirstChild(node)
294 |     do while child <> ''
295 |       call showNode child
296 |       child = getNextSibling(child)
297 |     end
298 |     call Say '</'sName'>'
299 |   end
300 | return
301 | 
302 | Say: procedure expose g.
303 |   parse arg sMessage
304 |   sLine = copies(' ',g.0INDENT)sMessage
305 |   if g.0FILEOUT = ''
306 |   then say sLine
307 |   else call putLine g.0FILEOUT,sLine
308 | return
309 | 
310 | /*INCLUDE io.rex */
311 | /*INCLUDE parsexml.rex */
312 | 


--------------------------------------------------------------------------------
/rexxpp.rex:
--------------------------------------------------------------------------------
  1 | /*REXX 2.0.0
  2 | Copyright (c) 2009-2020, Andrew J. Armstrong
  3 | All rights reserved.
  4 | 
  5 | Redistribution and use in source and binary forms, with or without 
  6 | modification, are permitted provided that the following conditions are 
  7 | met:
  8 | 
  9 |     * Redistributions of source code must retain the above copyright 
 10 |       notice, this list of conditions and the following disclaimer.
 11 |     * Redistributions in binary form must reproduce the above copyright 
 12 |       notice, this list of conditions and the following disclaimer in 
 13 |       the documentation and/or other materials provided with the
 14 |       distribution.
 15 | 
 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
 19 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
 22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 27 | 
 28 | */
 29 | 
 30 | /*REXX*****************************************************************
 31 | **                                                                   **
 32 | ** NAME     - REXXPP                                                 **
 33 | **                                                                   **
 34 | ** FUNCTION - Rexx INCLUDE pre-processor.  This rexx will read the   **
 35 | **            specified filename looking for /*INCLUDE file */       **
 36 | **            directives. For each INCLUDE found, it will append     **
 37 | **            the content of the specified file to the output file.  **
 38 | **                                                                   **
 39 | **            The start and end of the included content is marked by **
 40 | **            /*INCLUDED file */ and /*INCLUDEZ file */ lines. Remove**
 41 | **            these markers at your peril, because they allow REXXPP **
 42 | **            to intelligently handle a file that has already been   **
 43 | **            pre-processed.                                         **
 44 | **                                                                   **
 45 | **                                                                   **
 46 | ** SYNTAX   - REXXPP filein fileout                                  **
 47 | **                                                                   **
 48 | **            Where,                                                 **
 49 | **            filein   = Name of the file to pre-process.            **
 50 | **            fileout  = Name of the file to contain the resulting   **
 51 | **                       output. On TSO, the default for fileout is  **
 52 | **                       filein. On Windows there is no default.     **
 53 | **                                                                   **
 54 | ** EXAMPLE  - 1. If file1 contains:                                  **
 55 | **              say "it's goodnight from me..."                      **
 56 | **            /*INCLUDE file2 */  /* <-- Note: starts in column 1 */ **
 57 | **            exit                                                   **
 58 | **                                                                   **
 59 | **            2. And file2 contains:                                 **
 60 | **              say "...and it's goodnight from him"                 **
 61 | **                                                                   **
 62 | **            3. And you run: rexxpp file1 file3                     **
 63 | **                                                                   **
 64 | **            4. Then file3 will contain:                            **
 65 | **              say "it's goodnight from me..."                      **
 66 | **            /*INCLUDED file2 */                                    **
 67 | **              say "...and it's goodnight from him"                 **
 68 | **            /*INCLUDEZ file2 */                                    **
 69 | **            exit                                                   **
 70 | **                                                                   **
 71 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com>    **
 72 | **                                                                   **
 73 | ** HISTORY  - Date     By  Reason (most recent at the top please)    **
 74 | **            -------- --------------------------------------------- **
 75 | **            20090822 AJA Changed from GPL to BSD license.          **
 76 | **            20060505 AJA Prompt user for missing file names.       **
 77 | **            20050601 AJA Ensure each file included only once.      **
 78 | **            20050518 AJA Default fileout is filein (TSO only).     **
 79 | **            20031217 AJA Allow output to be re-processed.          **
 80 | **            20030912 AJA Use stream() to close win32 file.         **
 81 | **            20030904 AJA Initial version.                          **
 82 | **                                                                   **
 83 | **********************************************************************/
 84 | 
 85 |   parse arg sFileIn sFileOut' ('sOptions')'
 86 |   parse source g.0SYSTEM .
 87 |   if g.0SYSTEM = 'TSO'
 88 |   then do
 89 |     address ISPEXEC
 90 |     'CONTROL ERRORS RETURN'
 91 |     g.0LINES = 0
 92 |     if sFileOut = ''
 93 |     then sFileOut = sFileIn /* you can do this on TSO but not Windows*/
 94 |   end
 95 |   g.0LEVEL = 0
 96 |   parse value sourceline(1) with . sVersion
 97 |   call Say 'RPP000I Rexx INCLUDE Pre-processor' sVersion
 98 |   call Say 'RPP001I Output file is:' sFileOut
 99 |   sFileOut = getFile(sFileOut,'OUTPUT')
100 |   hFileOut = g.0hFile
101 |   if g.0rc = 0
102 |   then do
103 |     call Say 'RPP001I Input file is:' sFileIn
104 |     sFileIn = getFile(sFileIn)
105 |     hFileIn = g.0hFile
106 |     call includeFile sFileIn,hFileIn,hFileOut
107 |   end
108 |   else call Say 'RPP003E Could not create file:' sFileOut
109 |   call Say 'RRP004I Done.'
110 |   rc = closeFile(hFileOut)
111 | exit
112 | 
113 | /*-------------------------------------------------------------------*
114 |  * Display an indented message
115 |  *-------------------------------------------------------------------*/
116 | 
117 | Say: procedure expose g.
118 |   parse arg sMessage
119 |   say copies(' ',g.0LEVEL)sMessage
120 | return
121 | 
122 | /*-------------------------------------------------------------------*
123 |  * Open the file, or one nominated by the user
124 |  *-------------------------------------------------------------------*/
125 | 
126 | getFile: procedure expose g.
127 |   parse arg sFile,sMode
128 |   if sFile <> ''
129 |   then do
130 |     sFile = strip(sFile)
131 |     g.0hFile = openFile(sFile,sMode)
132 |     do while g.0rc <> 0 & sFile <> ''
133 |       call Say 'RPP006E Could not open file:' sFile
134 |       call Say 'RPP007A Enter full path to file:' sFile
135 |       parse pull sFile
136 |       if sFile <> ''
137 |       then g.0hFile = openFile(sFile,sMode)
138 |     end
139 |   end
140 | return sFile
141 | 
142 | /*-------------------------------------------------------------------*
143 |  * Recursively include files specified by 'INCLUDE' tags
144 |  *-------------------------------------------------------------------*/
145 | 
146 | includeFile: procedure expose g.
147 |   parse arg sFile,hFileIn,hFileOut
148 |   if sFile = '' then return
149 |   g.0LEVEL = g.0LEVEL + 2
150 |   if g.0INCLUDED.sFile = 1                               /* 20050601 */
151 |   then call Say 'RPP005I Already included file:' sFile   /* 20050601 */
152 |   else do                                                /* 20050601 */
153 |     g.0INCLUDED.sFile = 1                                /* 20050601 */
154 |     call Say 'RPP002I Including file:' sFile
155 |     sLine = getLine(hFileIn)
156 |     do while g.0rc = 0
157 |       select
158 |         when left(sLine,10) = '/*INCLUDE '
159 |         then do
160 |           parse var sLine '/*INCLUDE' sFile '*/'
161 |           call include sFile,hFileOut
162 |         end
163 |         when left(sLine,11) = '/*INCLUDED '
164 |         then do
165 |           parse var sLine '/*INCLUDED' sFile '*/'
166 |           call exclude sFile,hFileIn
167 |           call include sFile,hFileOut
168 |         end
169 |         otherwise g.0rc = putLine(hFileOut,sLine)
170 |       end
171 |       sLine = getLine(hFileIn)
172 |     end
173 |     rc = closeFile(hFileIn)
174 |     call Say 'RRP004I Done.'
175 |   end
176 |   g.0LEVEL = g.0LEVEL - 2
177 | return
178 | 
179 | /*-------------------------------------------------------------------*
180 |  * Append the specified file to the output file
181 |  *-------------------------------------------------------------------*/
182 | 
183 | include: procedure expose g.
184 |   parse arg sFile,hFileOut
185 |   sFile = strip(sFile)
186 |   sFile = getFile(sFile) /* open it, else ask user */
187 |   hFileIn = g.0hFile
188 |   if g.0rc = 0
189 |   then do
190 |     g.0rc = putLine(hFileOut,'/*INCLUDED' sFile '*/')
191 |     call includeFile sFile,hFileIn,hFileOut
192 |     g.0rc = putLine(hFileOut,'/*INCLUDEZ' sFile '*/')
193 |   end
194 | return
195 | 
196 | /*-------------------------------------------------------------------*
197 |  * Skip over the specified file in the input file
198 |  *-------------------------------------------------------------------*/
199 | 
200 | exclude: procedure expose g.
201 |   parse arg sFile,hFileIn
202 |   sFile = strip(sFile)
203 |   do until sFile = sFileIncluded | g.0rc <> 0
204 |     sLine = getLine(hFileIn)
205 |     if left(sLine,11) = '/*INCLUDEZ '
206 |     then parse var sLine '/*INCLUDEZ' sFileIncluded '*/'
207 |   end
208 | return
209 | 
210 | /*REXX 2.0.0.1
211 | 
212 | Copyright (c) 2009, Andrew J. Armstrong
213 | All rights reserved.
214 | 
215 | Redistribution and use in source and binary forms, with or without 
216 | modification, are permitted provided that the following conditions are 
217 | met:
218 | 
219 |     * Redistributions of source code must retain the above copyright 
220 |       notice, this list of conditions and the following disclaimer.
221 |     * Redistributions in binary form must reproduce the above copyright 
222 |       notice, this list of conditions and the following disclaimer in 
223 |       the documentation and/or other materials provided with the
224 |       distribution.
225 | 
226 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
227 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
228 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
229 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
230 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
231 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
232 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
233 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
234 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
235 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
236 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
237 | 
238 | */
239 | 
240 | /*REXX*****************************************************************
241 | **                                                                   **
242 | ** NAME     - IO                                                     **
243 | **                                                                   **
244 | ** FUNCTION - Simple I/O routines.                                   **
245 | **                                                                   **
246 | ** API      - The routines in this module are:                       **
247 | **                                                                   **
248 | **            openFile(filename,options,attrs)                       **
249 | **                Opens the specified file with the specified options**
250 | **                and returns a file handle to be used in other I/O  **
251 | **                operations. By default the file will be opened for **
252 | **                input. Specify 'OUTPUT' to open it for output.     **
253 | **                For TSO, you can specify any operand of the TSO    **
254 | **                ALLOCATE command in the third operand. For example:**
255 | **                rc = openFile('MY.FILE','OUTPUT','RECFM(F,B)'      **
256 | **                              'LRECL(80) BLKSIZE(27920)')          **
257 | **                                                                   **
258 | **            closeFile(handle)                                      **
259 | **                Closes the file specified by 'handle' (which was   **
260 | **                returned by the openFile() routine.                **
261 | **                                                                   **
262 | **            getLine(handle)                                        **
263 | **                Reads the next line from the file specified by     **
264 | **                'handle'.                                          **
265 | **                                                                   **
266 | **            putLine(handle,data)                                   **
267 | **                Appends the specified data to the file specified   **
268 | **                by 'handle'.                                       **
269 | **                                                                   **
270 | **                                                                   **
271 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com>    **
272 | **                                                                   **
273 | ** HISTORY  - Date     By  Reason (most recent at the top please)    **
274 | **            -------- --------------------------------------------- **
275 | **            20090822 AJA Changed from GPL to BSD license.          **
276 | **            20061017 AJA Added support for UNIX environment.       **
277 | **                         Tested on Ubuntu Linux 6.06 LTS.          **
278 | **            20050930 AJA Initial version.                          **
279 | **                                                                   **
280 | **********************************************************************/
281 | 
282 |   parse source . . sSourceFile .
283 |   parse value sourceline(1) with . sVersion .
284 |   say 'Simple Rexx I/O routines' sVersion
285 |   say 'You cannot invoke this rexx by itself!'
286 |   say
287 |   say 'This rexx is a collection of subroutines to be called'
288 |   say 'from your own rexx procedures. You should either:'
289 |   say '  - Append this procedure to your own rexx procedure,'
290 |   say '    or,'
291 |   say '  - Append the following line to your rexx:'
292 |   say '    /* INCLUDE' sSourceFile '*/'
293 |   say '    ...and run the rexx preprocessor:'
294 |   say '    rexxpp myrexx myrexxpp'
295 |   say '    This will create myrexxpp by appending this file to myrexx'
296 | exit
297 | 
298 | /*-------------------------------------------------------------------*
299 |  * Open a file
300 |  *-------------------------------------------------------------------*/
301 | 
302 | openFile: procedure expose g.
303 |   parse arg sFile,sOptions,sAttrs
304 |   hFile = ''
305 |   select
306 |     when g.0ENV = 'TSO' then do
307 |       bOutput = wordpos('OUTPUT',sOptions) > 0
308 |       bQuoted = left(sFile,1) = "'"
309 |       if bQuoted then sFile = strip(sFile,,"'")
310 |       parse var sFile sDataset'('sMember')'
311 |       if sMember <> '' then sFile = sDataset
312 |       if bQuoted then sFile = "'"sFile"'"
313 |       if bOutput
314 |       then 'LMINIT  DATAID(hFile) DATASET(&sFile) ENQ(EXCLU)'
315 |       else 'LMINIT  DATAID(hFile) DATASET(&sFile)'
316 |       if sMember <> ''
317 |       then do /* Open a member of a PDS */
318 |         'LMOPEN  DATAID(&hFile) OPTION(INPUT)' /* Input initially */
319 |         /* ... can't update ISPF stats when opened for output */
320 |         g.0MEMBER.hFile = sMember
321 |         'LMMFIND DATAID(&hFile) MEMBER('sMember') STATS(YES)'
322 |         if bOutput
323 |         then do
324 |           if rc = 0
325 |           then g.0STATS.hFile = zlvers','zlmod','zlc4date
326 |           else g.0STATS.hFile = '1,0,0000/00/00'
327 |           'LMCLOSE DATAID(&hFile)'
328 |           'LMOPEN  DATAID(&hFile) OPTION(&sOptions)'
329 |         end
330 |       end
331 |       else do /* Open a sequential dataset */
332 |         'LMOPEN  DATAID(&hFile) OPTION(&sOptions)'
333 |         if rc <> 0 /* If dataset does not already exist... */
334 |         then do /* Create sequential dataset then open it */
335 |           'LMCLOSE DATAID(&hFile)'
336 |           'LMFREE  DATAID(&hFile)'
337 |           address TSO 'ALLOCATE DATASET('sFile') NEW CATALOG',
338 |                       'SPACE(5,15) TRACKS RECFM(V,B)',
339 |                       'LRECL('g.0OPTION.WRAP.1 + 4')',
340 |                       'BLKSIZE(27990)' sAttrs
341 |           if bOutput
342 |           then do
343 |             'LMINIT  DATAID(hFile) DATASET(&sFile) ENQ(EXCLU)'
344 |             'LMOPEN  DATAID(&hFile) OPTION(&sOptions)'
345 |           end
346 |           else do
347 |             'LMINIT  DATAID(hFile) DATASET(&sFile)'
348 |             'LMOPEN  DATAID(&hFile) OPTION(INPUT)'
349 |           end
350 |         end
351 |       end
352 |       g.0OPTIONS.hFile = sOptions
353 |       g.0rc = rc /* Return code from LMOPEN */
354 |     end
355 |     otherwise do
356 |       if wordpos('OUTPUT',sOptions) > 0
357 |       then junk = stream(sFile,'COMMAND','OPEN WRITE REPLACE')
358 |       else junk = stream(sFile,'COMMAND','OPEN READ')
359 |       hFile = sFile
360 |       if stream(sFile,'STATUS') = 'READY'
361 |       then g.0rc = 0
362 |       else g.0rc = 4
363 |     end
364 |   end
365 | return hFile
366 | 
367 | /*-------------------------------------------------------------------*
368 |  * Read a line from the specified file
369 |  *-------------------------------------------------------------------*/
370 | 
371 | getLine: procedure expose g.
372 |   parse arg hFile
373 |   sLine = ''
374 |   select
375 |     when g.0ENV = 'TSO' then do
376 |       'LMGET DATAID(&hFile) MODE(INVAR)',
377 |             'DATALOC(sLine) DATALEN(nLine) MAXLEN(32768)'
378 |       g.0rc = rc
379 |       sLine = strip(sLine,'TRAILING')
380 |       if sLine = '' then sLine = ' '
381 |     end
382 |     otherwise do
383 |       g.0rc = 0
384 |       if chars(hFile) > 0
385 |       then sLine = linein(hFile)
386 |       else g.0rc = 4
387 |     end
388 |   end
389 | return sLine
390 | 
391 | /*-------------------------------------------------------------------*
392 |  * Append a line to the specified file
393 |  *-------------------------------------------------------------------*/
394 | 
395 | putLine: procedure expose g.
396 |   parse arg hFile,sLine
397 |   select
398 |     when g.0ENV = 'TSO' then do
399 |       g.0LINES = g.0LINES + 1
400 |       'LMPUT DATAID(&hFile) MODE(INVAR)',
401 |             'DATALOC(sLine) DATALEN('length(sLine)')'
402 |     end
403 |     otherwise do
404 |       junk = lineout(hFile,sLine)
405 |       rc = 0
406 |     end
407 |   end
408 | return rc
409 | 
410 | /*-------------------------------------------------------------------*
411 |  * Close the specified file
412 |  *-------------------------------------------------------------------*/
413 | 
414 | closeFile: procedure expose g.
415 |   parse arg hFile
416 |   rc = 0
417 |   select
418 |     when g.0ENV = 'TSO' then do
419 |       if g.0MEMBER.hFile <> '', /* if its a PDS */
420 |       & wordpos('OUTPUT',g.0OPTIONS.hFile) > 0 /* opened for output */
421 |       then do
422 |         parse value date('STANDARD') with yyyy +4 mm +2 dd +2
423 |         parse var g.0STATS.hFile zlvers','zlmod','zlc4date
424 |         zlcnorc  = min(g.0LINES,65535)   /* Number of lines   */
425 |         nVer = right(zlvers,2,'0')right(zlmod,2,'0')  /* vvmm */
426 |         nVer = right(nVer+1,4,'0')       /* vvmm + 1          */
427 |         parse var nVer zlvers +2 zlmod +2
428 |         if zlc4date = '0000/00/00'
429 |         then zlc4date = yyyy'/'mm'/'dd   /* Creation date     */
430 |         zlm4date = yyyy'/'mm'/'dd        /* Modification date */
431 |         zlmtime  = time()                /* Modification time */
432 |         zluser   = userid()              /* Modification user */
433 |         'LMMREP DATAID(&hFile) MEMBER('g.0MEMBER.hFile') STATS(YES)'
434 |       end
435 |       'LMCLOSE DATAID(&hFile)'
436 |       'LMFREE  DATAID(&hFile)'
437 |     end
438 |     otherwise do
439 |       if stream(hFile,'COMMAND','CLOSE') = 'UNKNOWN'
440 |       then rc = 0
441 |       else rc = 4
442 |     end
443 |   end
444 | return rc


--------------------------------------------------------------------------------
/soap.rex:
--------------------------------------------------------------------------------
  1 | /*REXX 2.0.0
  2 | Copyright (c) 2009-2020, Andrew J. Armstrong
  3 | All rights reserved.
  4 | 
  5 | Redistribution and use in source and binary forms, with or without 
  6 | modification, are permitted provided that the following conditions are 
  7 | met:
  8 | 
  9 |     * Redistributions of source code must retain the above copyright 
 10 |       notice, this list of conditions and the following disclaimer.
 11 |     * Redistributions in binary form must reproduce the above copyright 
 12 |       notice, this list of conditions and the following disclaimer in 
 13 |       the documentation and/or other materials provided with the
 14 |       distribution.
 15 | 
 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
 19 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
 22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 27 | 
 28 | */
 29 | 
 30 | /* REXX ***************************************************************
 31 | **                                                                   **
 32 | ** NAME     - SOAP                                                   **
 33 | **                                                                   **
 34 | ** FUNCTION - This exec invokes a Web Service and displays the       **
 35 | **            response. It assumes you are running the Apache Axis   **
 36 | **            SOAP server on the specified host and port. Other SOAP **
 37 | **            servers should also work but have not been tested.     **
 38 | **                                                                   **
 39 | **            Each time you invoke the client, you specify the SOAP  **
 40 | **            server hostname and port, and the name of the service  **
 41 | **            that you want to use. The client will then retrieve    **
 42 | **            the Web Services Definition Language (WSDL) definitions**
 43 | **            for that service from the SOAP server. If there is     **
 44 | **            only one operation defined for that service then that  **
 45 | **            operation is invoked automatically, else you will be   **
 46 | **            prompted to select the operation to be invoked. If the **
 47 | **            operation requires one or more parameters then you     **
 48 | **            will be prompted for each parameter. No attempt is     **
 49 | **            made to validate the input you supply. The operation   **
 50 | **            is invoked and the response is displayed.              **
 51 | **                                                                   **
 52 | ** NOTES    - 1. You will have to either append the PARSEXML and     **
 53 | **               PRETTY source files manually to this file, or run   **
 54 | **               this file through the REXX rexx pre-processor.      **
 55 | **                                                                   **
 56 | **               To use the pre-processor, run:                      **
 57 | **                                                                   **
 58 | **               tso rexxpp your.rexx.lib(soap)                      **
 59 | **                                                                   **
 60 | **            2. You can download Apache Axis from:                  **
 61 | **               http://ws.apache.org/axis/                          **
 62 | **                                                                   **
 63 | **            3. Start the Apache Axis server by issuing the         **
 64 | **               following command (all on one line with no line     **
 65 | **               breaks):                                            **
 66 | **                                                                   **
 67 | **               java org.apache.axis.transport.http.SimpleAxisServer**
 68 | **                    -p 8080                                        **
 69 | **                                                                   **
 70 | **               ...you will need to have the Axis jar files in your **
 71 | **               classpath, of course.                               **
 72 | **                                                                   **
 73 | **            4. If you need to go through a proxy server, then      **
 74 | **               specify the proxy server hostname and port number   **
 75 | **               in the z.!PROXYHOST and z.!PROXYPORT variables      **
 76 | **               (see below).                                        **
 77 | **                                                                   **
 78 | **            5. If you have access to the Internet, you can try the **
 79 | **               SOAP client out by running:                         **
 80 | **                                                                   **
 81 | **               soap vizier.cfa.harvard.edu:8080 UCD                **
 82 | **                                                                   **
 83 | **                                                                   **
 84 | **                                                                   **
 85 | **                                                                   **
 86 | ** SYNTAX   - SOAP url [service] [(options...]                       **
 87 | **                                                                   **
 88 | **            Where,                                                 **
 89 | **            url       = The URL of the Axis SOAP server. Format is:**
 90 | **                        hostname:port/path                         **
 91 | **                        hostname - Axis SOAP server hostname       **
 92 | **                        port - default is 80                       **
 93 | **                        path - default is axis/services            **
 94 | **            service   = Service name (default is Version). This    **
 95 | **                        name is case-sensitive.                    **
 96 | **            options   = One or more options:                       **
 97 | **                        TRACE - Trace network I/O                  **
 98 | **                        DEBUG - Dump message contents in hex       **
 99 | **                        XML   - Display messages contents in XML   **
100 | **                        NOPROXY - Do not use proxy host.           **
101 | **                                                                   **
102 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com>    **
103 | **                                                                   **
104 | ** HISTORY  - Date     By  Reason (most recent at the top please)    **
105 | **            -------- --- ----------------------------------------- **
106 | **            20090822 AJA Changed from GPL to BSD license.          **
107 | **            20050602 AJA Retrieve WSDL from SOAP server and prompt **
108 | **                         user for the operation and parameters.    **
109 | **            20050601 AJA Added proxy host support.                 **
110 | **            20050531 AJA Original version.                         **
111 | **                                                                   **
112 | **********************************************************************/
113 | 
114 |   parse arg sURL sService . '('sOptions')'
115 |   sOptions = translate(sOptions) /* convert to upper case */
116 |   
117 |   parse value sourceline(1) with . sVersion
118 |   say 'SOAP000I Rexx SOAP client' sVersion
119 |   
120 |   z. = '' /* g. is used by the XML parser */
121 | 
122 |   z.!PROXYHOST = 'proxy.example.org'
123 |   z.!PROXYPORT = '8080'
124 | 
125 |   if pos('://',sURL) > 0
126 |   then parse var sURL sScheme'://'sURL    /* ignore protocol (scheme) */
127 |   parse var sURL sHost'/'sPath
128 |   parse var sHost sHost':'nPort
129 |   if sHost    = '' then sHost    = 'axisserver.example.org'
130 |   if \datatype(nPort,'WHOLE') then nPort  = 80
131 |   if sPath    = '' then sPath    = 'axis/services'
132 |   if sService = '' then sService = 'Version'
133 | 
134 |   say 'SOAP001I Host='sHost
135 |   say 'SOAP002I Port='nPort
136 |   say 'SOAP003I Path='sPath
137 |   say 'SOAP004I Service='sService
138 | 
139 |   call initParser 'NOBLANKS' /* <-- This is in PARSEXML rexx */
140 |   z.!DEBUG   = wordpos('DEBUG',sOptions) <> 0
141 |   z.!TRACE   = wordpos('TRACE',sOptions) <> 0
142 |   z.!XML     = wordpos('XML',sOptions) <> 0
143 |   z.!NOPROXY = wordpos('NOPROXY',sOptions) <> 0
144 | 
145 |   if z.!NOPROXY
146 |   then do
147 |     z.!PROXYHOST = ''
148 |     z.!PROXYPORT = ''
149 |   end
150 | 
151 |   say 'SOAP005I Proxy Host='z.!PROXYHOST
152 |   say 'SOAP006I Proxy Port='z.!PROXYPORT
153 |   call Prolog
154 | 
155 | /*
156 |  *--------------------------------------------------------------------*
157 |  * Contact the SOAP server and retrieve the WSDL for this service
158 |  *--------------------------------------------------------------------*
159 | */
160 |   nSocket = Connect(sHost,nPort)
161 |   say 'SOAP007I Retrieving WSDL for' sService 'service'
162 |   if z.!PROXYHOST <> ''
163 |   then sURL = 'http://'sHost':'nPort'/'sPath'/'sService'?wsdl'
164 |   else sURL = '/'sPath'/'sService'?wsdl'
165 |   say 'SOAP008I GET' sURL
166 |   sHeader =  'GET' sURL 'HTTP/1.1' || z.!CRLFCRLF
167 | 
168 |   sMsg = sHeader
169 |   if z.!DEBUG then call Dump sMsg,'Sending'
170 |   sWrite = write(nSocket,sMsg)
171 | /*
172 |  *--------------------------------------------------------------------*
173 |  * Read the response from the SOAP server
174 |  *--------------------------------------------------------------------*
175 | */
176 |   say 'SOAP009I Reading WSDL response'
177 |   sReply = Slurp(nSocket)
178 |   sDisc = Disconnect(nSocket)
179 |   parse var sReply sHeader (z.!CRLFCRLF) sXML
180 |   if z.!DEBUG then call Dump sHeader,'Header'
181 |   if z.!DEBUG then call Dump sXML,'Payload'
182 |   parse var sHeader . nCode . 0 . sReason (z.!CRLF)
183 |   if nCode <> 200
184 |   then call Abort 'SOAP021E HTTP GET failed:' sReason
185 | /*
186 |  *--------------------------------------------------------------------*
187 |  * Parse the WSDL
188 |  *--------------------------------------------------------------------*
189 | */
190 |   rc = parseString(sXML)
191 |   doc = getDocumentElement()
192 |   if getName(doc) <> 'wsdl:definitions'
193 |   then do
194 |     say 'SOAP010E Could not retrieve WSDL for' sService,
195 |         'service on' sHost
196 |     say 'SOAP011I The reply received was:'
197 |     call showResponse doc
198 |     call Abort
199 |   end
200 |   porttype   = getChildrenByName(doc,'wsdl:portType')
201 |   operations = getChildrenByName(porttype,'wsdl:operation')
202 |   messages   = getChildrenByName(doc,'wsdl:message')
203 |   do i = 1 to words(messages)
204 |     message = word(messages,i)
205 |     sMsgName = getAttribute(message,'name')
206 |     z.!MSG.sMsgName = message
207 |     z.!MSG.message  = sMsgName
208 |   end
209 |   z.!OP.0  = words(operations)          /* number of operations */
210 |   if z.!OP.0 = 0
211 |   then call Abort 'Service' sService 'supports no operations'
212 |   do i = 1 to z.!OP.0  /* for each operation of this service...*/
213 |     operation = word(operations,i)
214 |     input  = getChildrenByName(operation,'wsdl:input')
215 |     output = getChildrenByName(operation,'wsdl:output')
216 |     sInputMsgName = getAttribute(input,'name')
217 |     sOutputMsgName = getAttribute(output,'name')
218 |     z.!OP.i  = operation                /* operation node */
219 |     z.!IN.i  = z.!MSG.sInputMsgName     /* input parms node */
220 |     z.!OUT.i = z.!MSG.sOutputMsgName    /* output parms node */
221 |   end
222 | 
223 |   if z.!OP.0 > 1 /* More than one operation to choose from? */
224 |   then do
225 |     say 'SOAP012A Which' sService 'operation do you want to invoke?'
226 |     do i = 1 to z.!OP.0
227 |       say i'.' getAttribute(z.!OP.i,'name')
228 |     end
229 |     pull n
230 |     if n = '' then call Abort 'Operation cancelled'
231 |     if \datatype(n,'WHOLE') | n < 1 | n > z.!OP.0 then n = 1
232 |   end
233 |   else n = 1
234 | 
235 |   sOperation = getAttribute(z.!OP.n,'name')
236 |   sExpectedResponse = getAttribute(z.!OUT.n,'name')
237 |   say 'SOAP013I About to invoke operation:' sOperation
238 |   parameters = getChildrenByName(z.!IN.n,'wsdl:part')
239 |   z.!PARM.0  = words(parameters) /* number of defined parameters */
240 |   do i = 1 to z.!PARM.0
241 |     parameter = word(parameters,i)
242 |     sParmName = getAttribute(parameter,'name')
243 |     sParmType = getAttribute(parameter,'type')
244 |     say 'SOAP014A Enter value for' sParmName '(type is' sParmType'):'
245 |     parse pull reply
246 |     z.!PARM.i     = reply
247 |     z.!PARMNAME.i = sParmName
248 |   end
249 | 
250 | /*
251 |  *--------------------------------------------------------------------*
252 |  * Create a SOAP request message roughly like:
253 |  *  <soapenv:Envelope>
254 |  *    <soapenv:Body>
255 |  *      <getVersion/>
256 |  *    </soapenv:Body>
257 |  *  </soapenv:Envelope>
258 |  *--------------------------------------------------------------------*
259 | */
260 |   call initParser 'NOBLANKS'
261 |   doc = createDocument('soapenv:Envelope')
262 |   call setAttribute doc,'xmlns:soapenv',,
263 |                         'http://schemas.xmlsoap.org/soap/envelope/'
264 |   call setAttribute doc,'xmlns:xsd',,
265 |                         'http://www.w3.org/2001/XMLSchema'
266 |   call setAttribute doc,'xmlns:xsi',,
267 |                         'http://www.w3.org/2001/XMLSchema-instance'
268 |   body = createElement('soapenv:Body')
269 |   call appendChild body,doc
270 |   op   = createElement(sOperation)
271 |   call appendChild op,body
272 |   do i = 1 to z.!PARM.0
273 |     sParmName  = z.!PARMNAME.i
274 |     sParmValue = z.!PARM.i
275 |     parm = createElement(sParmName)
276 |     call appendChild createTextNode(sParmValue),parm
277 |     call appendChild parm,op
278 |   end
279 |   nSocket = Connect(sHost,nPort)
280 |   sContent = toString(getRoot())
281 |   say 'SOAP015I Sending' sOperation 'message to' sService 'service'
282 |   if z.!XML then say sContent
283 | /*
284 |  *--------------------------------------------------------------------*
285 |  * Build an HTTP header and send the message
286 |  *--------------------------------------------------------------------*
287 | */
288 |   if z.!PROXYHOST <> ''
289 |   then sURL = 'http://'sHost':'nPort'/'sPath'/'sService
290 |   else sURL = '/'sPath'/'sService
291 |   say 'SOAP020I POST' sURL
292 |   sHeader =  'POST' sURL 'HTTP/1.0' || z.!CRLF ||,
293 |     'Content-Type: text/xml; charset=utf-8' || z.!CRLF ||,
294 |     'Accept: application/soap+xml, application/dime,',
295 |             'multipart/related, text/*' || z.!CRLF ||,
296 |     'User-Agent: EpistAxis/1.2' || z.!CRLF ||,
297 |     'Host:' sHost':'nPort || z.!CRLF ||,
298 |     'Cache-Control: no-cache' || z.!CRLF ||,
299 |     'Pragma: no-cache' || z.!CRLF ||,
300 |     'SOAPAction: ""' || z.!CRLF ||,
301 |     'Content-Length:' length(sContent) || z.!CRLF || z.!CRLF
302 | 
303 |   sMsg = sHeader || sContent
304 |   if z.!DEBUG then call Dump sMsg,'Sending'
305 |   sWrite = write(nSocket,sMsg)
306 | /*
307 |  *--------------------------------------------------------------------*
308 |  * Read the response from the SOAP server
309 |  *--------------------------------------------------------------------*
310 | */
311 |   sReply = Slurp(nSocket)
312 |   parse var sReply sHeader (z.!CRLFCRLF) sXML
313 |   if z.!DEBUG then call Dump sHeader,'Header'
314 |   if z.!DEBUG then call Dump sXML,'Payload'
315 |   parse var sHeader . nCode . 0 . sReason (z.!CRLF)
316 |   if nCode <> 200
317 |   then call Abort 'SOAP021E HTTP POST failed:' sReason
318 | 
319 | /*
320 |  *--------------------------------------------------------------------*
321 |  * Now parse the response message.
322 |  * If it worked, the response will look like:
323 |  *
324 |  * <soapenv:Envelope>
325 |  *   <soapenv:Body>
326 |  *     <getVersionResponse>
327 |  *       <getVersionReturn>
328 |  *         version information
329 |  *       </getVersionReturn>
330 |  *     </getVersionResponse>
331 |  *   </soapenv:Body>
332 |  * </soapenv:Envelope>
333 |  *
334 |  * If it failed, the response will look like:
335 |  *
336 |  * <soapenv:Envelope>
337 |  *   <soapenv:Body>
338 |  *     <soapenv:Fault>
339 |  *       <faultcode>code</faultcode>
340 |  *       <faultstring>string</faultstring>
341 |  *       <detail>
342 |  *         <stackTrace>stack trace information</stackTrace>
343 |  *         <hostname>hostname of SOAP server</hostname>
344 |  *       </detail>
345 |  *     </soapenv:Fault>
346 |  *   </soapenv:Body>
347 |  * </soapenv:Envelope>
348 |  *--------------------------------------------------------------------*
349 | */
350 |   call initParser 'NOBLANKS'
351 |   rc = parseString(sXML)
352 |   if z.!XML then call prettyPrinter
353 | 
354 | /*
355 |  *--------------------------------------------------------------------*
356 |  * Extract the payload from the response
357 |  *--------------------------------------------------------------------*
358 | */
359 |   doc  = getDocumentElement() /* SOAP envelope */
360 |   body = getFirstChild(doc)   /* SOAP body */
361 |   resp = getFirstChild(body)  /* SOAP server response */
362 |   select
363 |     when getName(resp) = sExpectedResponse then do
364 |       say 'SOAP016I Received "'sExpectedResponse'" response:'
365 |       call showResponse resp
366 |     end
367 |     when getName(resp) = 'soapenv:Fault'      then do
368 |       say 'SOAP017E Received "'getName(resp)'" response:'
369 |       call showResponse resp
370 |     end
371 |     otherwise do
372 |       say 'SOAP018W Received unexpected response:'
373 |       say toString(resp)
374 |     end
375 |   end
376 | 
377 |   call Epilog
378 | exit
379 | 
380 | showResponse: procedure expose z. g.
381 |   parse arg node,sPad
382 |   if isElementNode(node)
383 |   then do
384 |     if hasAttribute(node,'xsi:type')
385 |     then do
386 |       say sPad || getName(node),
387 |                   getAttribute(node,'xsi:type') ||,
388 |                   '="'getText(getFirstChild(node))'"'
389 |     end
390 |     else do
391 |       say sPad || getName(node)
392 |       if isTextNode(getFirstChild(node))
393 |       then say sPad'  'getText(getFirstChild(node))
394 |     end
395 |   end
396 |   children = getChildren(node)
397 |   do i = 1 to words(children)
398 |     child = word(children,i)
399 |     call showResponse child,sPad'  '
400 |   end
401 | return
402 | 
403 | showParameters: procedure expose z. g.
404 |   parse arg sMsgName
405 |   message = z.!MSG.sMsgName
406 |   parts = getChildrenByName(message,'wsdl:part')
407 |   do k = 1 to words(parts)
408 |     part = word(parts,k)
409 |     say '    parameter:' getAttribute(part,'name'),
410 |                  'type:' getAttribute(part,'type')
411 |   end
412 | return
413 | 
414 | Connect: procedure expose z.
415 |   parse arg sHost,nPort
416 |   say 'SOAP019I Connecting to' sHost 'port' nPort
417 |   if z.!PROXYHOST <> '' then sHost = z.!PROXYHOST
418 |   if z.!PROXYPORT <> '' then nPort = z.!PROXYPORT
419 |   sShutdown = Socket('Shutdown', z.!SOCKET)
420 |   sClose    = Socket('Close', z.!SOCKET)
421 |   nSocket   = Socket('Socket','AF_INET','SOCK_STREAM','TCP')
422 |   sSockOpt  = Socket('SetSockOpt',nSocket,'IPPROTO_TCP','SO_ASCII','ON')
423 |   sConnect  = Socket('Connect',nSocket,'AF_INET' nPort sHost)
424 |   if z.!RC <> 0 then call ABORT sConnect
425 | return nSocket
426 | 
427 | Slurp: procedure expose z.
428 |   parse arg nSocket
429 |   sReply = ''
430 |   sRead  = read(nSocket)
431 |   do while length(sRead) > 0
432 |     sReply = sReply || sRead
433 |     sRead  = read(nSocket)
434 |   end
435 | return sReply
436 | 
437 | Disconnect: procedure expose z.
438 |   parse arg nSocket
439 |   sShutdown= Socket('Shutdown', nSocket)
440 |   sResp = Socket('Close', nSocket)
441 | return sResp
442 | 
443 | Abort: procedure expose z.
444 |   parse arg sMsg
445 |   say sMsg
446 |   call Epilog
447 |   exit
448 | return
449 | 
450 | Write: procedure expose z.
451 |   parse arg nSocket,sMsg
452 |   if z.!TRACE then call Dump sMsg,'-->'
453 |   sWrite    = Socket('Write',nSocket,sMsg)
454 | return sWrite
455 | 
456 | Read: procedure expose z.
457 |   parse arg nSocket
458 |   sRead     = Socket('Read',nSocket)
459 |   parse var sRead nLen sData
460 |   if z.!TRACE then call Dump sData,'<--'
461 | return sData
462 | 
463 | Dump: procedure expose z.
464 |   parse arg sData,sPrefix,nPad
465 |   if \datatype(nPad,'WHOLE') then nPad = 8
466 |   sPrefix = left(sPrefix,nPad)
467 |   lastline = length(sData)%16*16+1
468 |   do i = 1 to length(sData) by 16
469 |     if i = lastline
470 |     then sChunk = substr(sData,i)
471 |     else sChunk = substr(sData,i,16)
472 |     xChunk = left(c2x(sChunk),32)
473 |     say sPrefix,
474 |         substr(xChunk, 1,8),
475 |         substr(xChunk, 9,8),
476 |         substr(xChunk,17,8),
477 |         substr(xChunk,25,8),
478 |         '*'left(sChunk,16)'*'
479 |     sPrefix = right('+'d2x(i+15,6),nPad)
480 |   end
481 | return
482 | 
483 | Prolog:
484 |   z.!CR = '0D'x /* EBCDIC Carriage Return */
485 |   z.!LF = '25'x /* EBCDIC Line Feed */
486 |   z.!CRLF = '0D25'x
487 |   z.!CRLFCRLF = z.!CRLF || z.!CRLF
488 |   sResp = Socket('Terminate') /* Kill any previous socket set */
489 |   sResp = Socket('Initialize', 'MySet')
490 |   if z.!RC <> 0 then exit z.!RC
491 | return
492 | 
493 | Epilog:
494 |   sDisc = Disconnect(nSocket)
495 |   sResp = Socket('Terminate')
496 | return sResp
497 | 
498 | Socket: procedure expose z.
499 |   parse arg a,c,d,e,f,g,h,i,j,k
500 |   if z.!TRACE
501 |   then say 'Socket('strip(a','c','d','e','f','g','h','i','j','k,'T',",")')'
502 | 
503 |   parse value 'SOCKET'(a,c,d,e,f,g,h,i,j,k) with nRC sResp
504 |   z.!RC = nRC
505 | 
506 |   if z.!TRACE
507 |   then do
508 |     say '      Return code <'nRC'>'
509 |     say '      Response    <'sResp'>'
510 |   end
511 | return sResp
512 | 
513 | /*INCLUDE pretty.rex */
514 | 


--------------------------------------------------------------------------------
/test.xml:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0"?>
 2 | <!DOCTYPE signature[
 3 | <!ENTITY copyright "&#169;">
 4 | <!ENTITY tm "&#xAE;">
 5 | ]>
 6 | <!--start of document-->
 7 | <signature>
 8 | <name id='one' xml:lang="en-AU">
 9 | <namepart order="1">Andrew</namepart>
10 | <namepart order="2" test='@order >= 2 &amp; @id > 0'>
11 | Armstrong</namepart>
12 | <alias>Scumbag&tm;</alias>
13 | <alias>Sturm &amp; Drang</alias>
14 | </name>
15 | Some unparsed character data:
16 | <![CDATA[<a href="mailto:geek@example.org">
17 | Andrew Armstrong</a>]]>
18 | <inventory>
19 | Test text: and/or & &amp;&amp; &tm;includes
20 | <item name="$$$doc" desc="Documentation/Installation"/>
21 | <item name="assert" desc="Unit test assertion plumbing"/>
22 | <item name="devisio" desc="Example of removing unwanted XML tags"/>
23 | <item name="gpl" desc="GNU General Public License"/>
24 | <item name="io" desc="Common Rexx I/O routines"/>
25 | <item name="parsexml" desc="A Rexx XML parser" mode="> 1"/>
26 | <item name="pretty" desc="A Rexx XML pretty printer"/>
27 | <item name="rexxpp" desc="A Rexx INCLUDE pre-processor"/>
28 | <item name="soap" desc="A Rexx SOAP client"/>
29 | <item name="testmod" desc="Unit tests for XML modification"/>
30 | <item name="testnew" desc="Unit tests for XML creation"/>
31 | <item name="testxml" desc="A test XML file"/>
32 | </inventory>
33 | </signature>
34 | <!--end of document-->
35 | 


--------------------------------------------------------------------------------
/testmod.rex:
--------------------------------------------------------------------------------
  1 | /*REXX 2.0.0
  2 | Copyright (c) 2009-2020, Andrew J. Armstrong
  3 | All rights reserved.
  4 | 
  5 | Redistribution and use in source and binary forms, with or without 
  6 | modification, are permitted provided that the following conditions are 
  7 | met:
  8 | 
  9 |     * Redistributions of source code must retain the above copyright 
 10 |       notice, this list of conditions and the following disclaimer.
 11 |     * Redistributions in binary form must reproduce the above copyright 
 12 |       notice, this list of conditions and the following disclaimer in 
 13 |       the documentation and/or other materials provided with the
 14 |       distribution.
 15 | 
 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
 19 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
 22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 27 | 
 28 | */
 29 | 
 30 | /*REXX*****************************************************************
 31 | **                                                                   **
 32 | ** NAME     - TESTMOD                                                **
 33 | **                                                                   **
 34 | ** FUNCTION - Tests modification of an existing XML file.            **
 35 | **                                                                   **
 36 | **                                                                   **
 37 | ** SYNTAX   - testmod infile [outfile]                               **
 38 | **                                                                   **
 39 | **            Where,                                                 **
 40 | **            infile   = Name of XML file to be modified.            **
 41 | **            outfile  = Name of file to store the output in.        **
 42 | **                       The default is the console.                 **
 43 | **                                                                   **
 44 | **                                                                   **
 45 | ** NOTES    - 1. You will have to either append the PRETTY rexx code **
 46 | **               manually to this demo source, or run this demo      **
 47 | **               source through the REXXPP rexx pre-processor.       **
 48 | **                                                                   **
 49 | **               To use the pre-processor, run:                      **
 50 | **                                                                   **
 51 | **               rexxpp testmod testmodp                             **
 52 | **                                                                   **
 53 | **               ...and then run the resulting rexx procedure over   **
 54 | **               an XML file of your choice:                         **
 55 | **                                                                   **
 56 | **               testmodp infile                                     **
 57 | **                ...or...                                           **
 58 | **               testmodp infile outfile                             **
 59 | **                                                                   **
 60 | **                                                                   **
 61 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com>    **
 62 | **                                                                   **
 63 | ** HISTORY  - Date     By  Reason (most recent at the top pls)       **
 64 | **            -------- --- ----------------------------------------- **
 65 | **            20090822 AJA Changed from GPL to BSD license.          **
 66 | **            20040707 AJA Initial version.                          **
 67 | **                                                                   **
 68 | **********************************************************************/
 69 | 
 70 | 
 71 |   parse arg sFileIn sFileOut' ('sOptions')'
 72 | 
 73 |   parse value sourceline(1) with . sVersion
 74 |   say 'Unit Test Suite 1 - ' sVersion
 75 |   
 76 |   if sFileIn = ''
 77 |   then do
 78 |     parse source sSystem sInvocation sSourceFile .
 79 |     say 'Syntax:' sSourceFile 'filein fileout (options...'
 80 |     exit
 81 |   end
 82 | 
 83 | 
 84 |   sOptions = 'NOBLANKS' sOptions
 85 |   call initParser sOptions /* <-- This is in PARSEXML rexx */
 86 | 
 87 |   parse source g.!ENV .
 88 |   if g.!ENV = 'TSO'
 89 |   then do
 90 |     address ISPEXEC
 91 |     'CONTROL ERRORS RETURN'
 92 |     g.!LINES = 0
 93 |   end
 94 | 
 95 |   /* Open the specified file and parse it */
 96 |   nParseRC = parseFile(sFileIn)
 97 |   doc = getDocumentElement()
 98 | 
 99 |   /* Create a new tag */
100 |   prologNode = createElement('prolog')
101 |   faqNode = createElement('faq')
102 |   call setAttribute faqNode,'question','What is your name?'
103 |   textNode = createTextNode('Sir Gawain of Camelot')
104 |   call appendChild textNode,faqNode
105 |   call appendChild faqNode,prologNode
106 |   /* We now have the following structure in memory:
107 |      <prolog>
108 |        <faq question="What is your name?">
109 |          Sir Gawain of Camelot
110 |        </faq>
111 |      </prolog>
112 |   */
113 | 
114 |   call Log 'Inserting a <prolog> tag at the start of the document'
115 |   firstChild = getFirstChild(doc)
116 |   if firstChild <> '' /* If document has a first child */
117 |   then call insertBefore prologNode,firstChild
118 |   else call appendChild prologNode,doc
119 | 
120 |   /* Verify that the first child is now indeed the <prolog> node */
121 |   call assertEquals getFirstChild(doc),prologNode,,
122 |               'Failed to insert <prolog> as the first child'
123 | 
124 |   call Log 'Appending an empty <epilog> at the end of the document'
125 |   call appendChild createElement('epilog'),doc
126 | 
127 |   /* Save the document to a file (or display on console) */
128 |   call prettyPrinter sFileOut
129 | exit
130 | 
131 | Log: procedure expose g.
132 |   parse arg sMessage
133 |   g.!TEST = g.!TEST + 1 /* increment test number */
134 |   say
135 |   say 'Test' right(g.!TEST,3,'0') left(sMessage,68,'-')
136 | return
137 | 
138 | /*INCLUDE pretty.rex */
139 | /*INCLUDE assert.rex */
140 | 


--------------------------------------------------------------------------------
/testnew.rex:
--------------------------------------------------------------------------------
  1 | /*REXX 2.0.0
  2 | Copyright (c) 2009-2020, Andrew J. Armstrong
  3 | All rights reserved.
  4 | 
  5 | Redistribution and use in source and binary forms, with or without 
  6 | modification, are permitted provided that the following conditions are 
  7 | met:
  8 | 
  9 |     * Redistributions of source code must retain the above copyright 
 10 |       notice, this list of conditions and the following disclaimer.
 11 |     * Redistributions in binary form must reproduce the above copyright 
 12 |       notice, this list of conditions and the following disclaimer in 
 13 |       the documentation and/or other materials provided with the
 14 |       distribution.
 15 | 
 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
 19 | PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 20 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
 22 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 24 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 27 | 
 28 | */
 29 | 
 30 | /*REXX*****************************************************************
 31 | **                                                                   **
 32 | ** NAME     - TESTNEW                                                **
 33 | **                                                                   **
 34 | ** FUNCTION - Tests creation and modification of XML.                **
 35 | **                                                                   **
 36 | **                                                                   **
 37 | ** SYNTAX   - testnew outfile                                        **
 38 | **                                                                   **
 39 | **            Where,                                                 **
 40 | **            outfile  = Name of file to store the output in.        **
 41 | **                       The default is the console.                 **
 42 | **                                                                   **
 43 | **                                                                   **
 44 | ** NOTES    - 1. You will have to either append the PRETTY rexx code **
 45 | **               manually to this demo source, or run this demo      **
 46 | **               source through the REXXPP rexx pre-processor.       **
 47 | **                                                                   **
 48 | **               To use the pre-processor, run:                      **
 49 | **                                                                   **
 50 | **               rexxpp testnew testnewp                             **
 51 | **                                                                   **
 52 | **               ...and then run the resulting rexx procedure:       **
 53 | **                                                                   **
 54 | **               testnewp                                            **
 55 | **                ...or...                                           **
 56 | **               testnewp outfile                                    **
 57 | **                                                                   **
 58 | **                                                                   **
 59 | ** AUTHOR   - Andrew J. Armstrong <androidarmstrong+sf@gmail.com>    **
 60 | **                                                                   **
 61 | ** HISTORY  - Date     By  Reason (most recent at the top please)    **
 62 | **            -------- --- ----------------------------------------- **
 63 | **            20090822 AJA Changed from GPL to BSD license.          **
 64 | **            20060803 AJA Added unit tests for getAttributeMap.     **
 65 | **            20040707 AJA Initial version.                          **
 66 | **                                                                   **
 67 | **********************************************************************/
 68 | 
 69 | 
 70 |   parse arg sFileOut' ('sOptions
 71 | 
 72 |   parse value sourceline(1) with . sVersion
 73 |   say 'Unit Test Suite 2 - ' sVersion
 74 | 
 75 |   sOptions = 'NOBLANKS' sOptions
 76 |   call initParser /* <-- This is in PARSEXML rexx */
 77 | 
 78 |   parse source g.!ENV .
 79 |   if g.!ENV = 'TSO'
 80 |   then do
 81 |     address ISPEXEC
 82 |     'CONTROL ERRORS RETURN'
 83 |     g.!LINES = 0
 84 |   end
 85 | 
 86 |   g.!TEST = 0
 87 | 
 88 |   call Log 'Create a new document'
 89 |   doc = createDocument('bridgekeeper')
 90 |   call prettyPrinter
 91 | 
 92 |   call Log 'Create a faq tag and append it to the document'
 93 |   q1 = createElement('faq')
 94 |   call appendChild q1,doc
 95 |   count = words(getChildren(doc))
 96 |   call assertEquals 1,count,'001 <bridgekeeper> has wrong child count'
 97 |   call setAttribute q1,'question','What is your name?'
 98 |   count = getAttributeCount(q1)
 99 |   call assertEquals 1,count,'002 <faq> element has wrong attr count'
100 |   textNode = createTextNode('Sir Gawain of Camelot')
101 |   call appendChild textNode,q1
102 |   count = words(getChildren(q1))
103 |   call assertEquals 1,count,'003 <faq> element has wrong child count'
104 |   call prettyPrinter
105 | 
106 |   call Log 'Create another faq tag and append it to the document'
107 |   q2 = createElement('faq')
108 |   call setAttribute q2,'question','What is your quest?'
109 |   count = getAttributeCount(q2)
110 |   call assertEquals 1,count,'004 <faq> element has wrong attr count'
111 |   call setAttribute q2,'answer','To seek the Holy Grail'
112 |   count = getAttributeCount(q2)
113 |   call assertEquals 2,count,'005 <faq> element has wrong attr count'
114 |   call appendChild q2,doc
115 |   count = words(getChildren(doc))
116 |   call assertEquals 2,count,'006 <bridgekeeper> has wrong child count'
117 |   call prettyPrinter
118 | 
119 |   call Log 'Create yet another faq tag and append it to the document'
120 |   q3 = createElement('faq')
121 |   call setAttribute q3,'question','What is your favourite color?'
122 |   call setAttribute q3,'answer','Blue'
123 |   call appendChild q3,doc
124 |   count = words(getChildren(doc))
125 |   call assertEquals 3,count,'007 <bridgekeeper> has wrong child count'
126 |   call prettyPrinter
127 | 
128 |   call Log 'Modify the answer attribute on the third faq tag'
129 |   call setAttribute q3,'answer','No yelloooooww'
130 |   call assertEquals 'No yelloooooww',getAttribute(q3,'answer'),,
131 |           '008 "answer" attribute of <faq> is not correct'
132 |   call prettyPrinter
133 | 
134 |   call Log 'Remove a text node and some attributes'
135 |   count = words(getChildren(q1))
136 |   call assertEquals 1,count,'009 <faq> has wrong child count'
137 |   call removeChild textNode /* give Sir Gawain the flick */
138 |   count = words(getChildren(q1))
139 |   call assertEquals 0,count,'010 <faq> has wrong child count'
140 | 
141 |   count = getAttributeCount(q3)
142 |   call assertEquals 2,count,'011 <faq> element has wrong attr count'
143 |   call removeAttribute q3,'question'
144 |   count = getAttributeCount(q3)
145 |   call assertEquals 1,count,'012 <faq> element has wrong attr count'
146 |   call removeAttribute q3,'answer'
147 |   count = getAttributeCount(q3)
148 |   call assertEquals 0,count,'013 <faq> element has wrong attr count'
149 |   call prettyPrinter
150 | 
151 |   call Log 'Insert a new text node in the first faq tag'
152 |   textNode = createTextNode('King of the Britons')
153 |   call appendChild textNode,q1
154 |   call insertBefore createTextNode('It is Arthur, '),textNode
155 |   call setAttribute q3,'question','What is the air-speed velocity',
156 |                                   'of an unladen swallow?'
157 |   call setAttribute q3,'answer','What do you mean?  An African or',
158 |                                   'European swallow?'
159 |   call prettyPrinter
160 | 
161 |   call Log 'Exercise getAttributeMap'
162 |   call prettyPrinter ,,q3
163 |   call getAttributeMap q3
164 |   count = g.!ATTRIBUTE.0
165 |   call assertEquals 2,count,'014 <faq> element has wrong attr count'
166 |   s = g.!ATTRIBUTE.1
167 |   call assertEquals 'question',s,,
168 |                             '015 Attribute 1 of <faq> has wrong name'
169 |   s = g.!ATTRIBUTE.2
170 |   call assertEquals 'answer',s,,
171 |                             '016 Attribute 2 of <faq> has wrong name'
172 | 
173 |   call Log 'Write the document to a file (or console)'
174 |   call prettyPrinter sFileOut
175 | exit
176 | 
177 | Log: procedure expose g.
178 |   parse arg sMessage
179 |   g.!TEST = g.!TEST + 1 /* increment test number */
180 |   say
181 |   say 'Test' right(g.!TEST,3,'0') left(sMessage,68,'-')
182 | return
183 | 
184 | /*INCLUDE pretty.rex */
185 | /*INCLUDE assert.rex */
186 | 


--------------------------------------------------------------------------------