[REBOL] Re: Simple XML
From: doug:vos:eds at: 9-Mar-2004 16:37
I think this does what you want.
Purpose: "Library analogous to perl XML::Simple."
Only works with simple XML.
Does not handle namespaces="values" inside tags.
REBOL [
Title: {xml-test13.r}
File: %xml-test13.r
Date: 21-Oct-2003
Requires: {rebol version 2.5.6 or higher}
]
do %/d/xml/xml-simple-v0.1.2.r
bklist: XMLin %/d/xml/booklist3.xml
probe bklist
XMLout %/d/xml/booklist4.xml bklist
;=====================================
REBOL [
Title: "XML-Simple (Library)"
Date: 20-Oct-2003
Version: 0.1.2
File: %xml-simple.r
Author: "Doug Vos"
Email: [doug--vvn--net]
Purpose: "Library analogous to perl XML::Simple."
History: [
0.1.0 [18-Oct-2003 {Began script.} "DJV"]
0.1.2 [20-Oct-2003 {Added XMLin function, added XMLout.} "DJV"]
]
]
;--------------------------------------------------------------------
end-tag?: func [
{Test for an ending xml or html style tag. eg. </thing>}
item [any-type!] {The item to examine}
][
either (tag? item) [
either (find item "/") [true][false]
][
false
]
]
;--------------------------------------------------------------------
begin-tag?: func [
{Test for a begining xml or html style tag. eg. </thing>}
item [any-type!] {The item to examine}
][
either (tag? item) [
either (find item "/") [false][true]
][
false
]
]
;--------------------------------------------------------------------
tag-to-string: func [
{Convert a simple html or xml tag to a string.}
xtag [tag!] {The tag to convert.}
][
trim/all replace/all to-string xtag "/" ""
]
;-------------------------------------------------------------------
simple-tag?: func [
{Test for tag with simple structure like <tag>a few words</tag>}
item [any-type!] {The item to examine.}
xml [block!] {The whole block we are examining.}
/local atag ztag xs
][
either (tag? item) [
atag: to-tag (tag-to-string item)
ztag: to-tag rejoin ["/" (tag-to-string item)]
xs: find xml atag
either ( all [
(tag? pick xs 1)
(string? pick xs 2)
(ztag = (pick xs 3))] ) [true][false]
][
false
]
]
;-------------------------------------------------------------------
multi-tags?: func [
{Test for multiple occurences of tag like <book>...</book> as found in
something like <booklist><book>...</book><book>...</book></booklist>}
item [any-type!] {The item to examine.}
xml [block!] {The whole block we are examining.}
/local atag ztag xs
][
either (tag? item) [
atag: to-tag (tag-to-string item)
ztag: to-tag rejoin ["/" (tag-to-string item)]
xs: find xml ztag
either ( all [
(tag? pick xs 1)
(atag = (pick xs 2))] ) [true][false]
][
false
]
]
;--------------------------------------------------------------------
XMLin: func [
{Provide a XMLin function analogous to perl XML::Simple XMLin().}
xmli [url! file! string!] {The xml url, file or xml-text.}
/local xstr xml item
][
xstr: make string! 1000
xml: load/markup xmli
; remove the strings that are only 'newline and empty space
remove-each x xml [empty? trim x]
; Ignore the first tag,
; which is always something like <?xml version="1.0"?>
xml: copy at xml 2
append xstr "["
foreach item xml [
append xstr " "
if (begin-tag? item) [
if (multi-tags? item xml) [append xstr " [ "]
append xstr tag-to-string item
if (not simple-tag? item xml) [append xstr " [ "]
]
if (string? item) [
append xstr mold item
]
if (end-tag? item) [
if (not simple-tag? item xml) [append xstr " ]"]
if (multi-tags? item xml) [append xstr " ] "]
]
]
append xstr "]"
load xstr
]
;--------------------------------------------------------------------
XMLout: func [
{Provide a XMLout function analogous to perl XML::Simple XMLout().}
xmlf [file!] {The xml file to create.}
xblock [block!] {The data to populate xml file.}
/local xstr item
][
xstr: make string! 1000
append xstr {<?xml version="1.0"?>^/}
XMLout.block xstr xblock
print xstr
write xmlf xstr
]
;--------------------------------------------------------------
XMLout.block: func [
{Process the block according to rules.}
xml.tree [string!] {The xml-tree we are creating.}
item [block!] {The pre xml-block.}
][
either (multi-block? item) [
foreach x item [
XMLOut.block xml.tree x
]
][
either (multi-word-pair? item) [
foreach [w v] item [
XMLOut.block xml.tree (reduce [w v])
]
][
if (simple-word-value-pair? item) [
append xml.tree rejoin ["<" item/1 ">" item/2 "</" item/1 ">"
newline]
]
if (complex-block-pair? item) [
append xml.tree rejoin [ "<" item/1 ">"]
XMLOut.block xml.tree item/2
append xml.tree rejoin [ "</" item/1 ">" newline]
]
]
]
]
;--------------------------------------------------------------------
multi-word-pair?: func [
{Examine block to see if it contains a block with multiple word pairs.
Return TRUE if item is pattern [word "value" word "value"] or
TRUE if item is pattern [word "value" word [block]]
}
item [any-type!] {Item to examine.}
][
either block? item [
either ((length? item) >= 4) [
all [(word? item/1) (word? item/3)]
][
false
]
][
false
]
]
;--------------------------------------------------------------------
multi-block?: func [
{Examine block to if it contains 2 or more blocks}
item [any-type!] {Examine item and return TRUE if multi-block.}
][
either block? item [
either ((length? item) >= 2) [
all [(block? item/1) (block? item/2)]
][
false
]
][
false
]
]
;--------------------------------------------------------------------
simple-word-value-pair?: func [
{Examine block to see if simple pair like [word! single-value] }
item [any-type!] {Examine item and return TRUE if simple pair.}
][
either block? item [
either ((length? item) = 2) [
all [(word? item/1) (not block? item/2)]
][
false
]
][
false
]
]
;--------------------------------------------------------------------
complex-block-pair?: func [
{Examine block to see if complex pair [word! [block]] }
item [any-type!] {Examine item and return TRUE if complex pair.}
][
either block? item [
either ((length? item) = 2) [
all [(word? item/1) (block? item/2)]
][
false
]
][
false
]
]
;--------------------------------------------------------------------
