Code archives/File Utilities/XML (Load\Save)
This code has been declared by its author to be Public Domain code.
Download source code
| XML.bmx |
Import "bbtype.bmx"
Global sdXMLattr_list:TList=New TList
Global sdXMLnode_list:TList=New TList
Global sdXMLworklist_list:TList=New TList
Global sdXMLnodelist_list:TList=New TList
' XML load / parse / save functions
' XML code by Blitztastic
Type sdXMLnodelist Extends TBBType
Method New()
Add(sdXMLnodelist_list)
End Method
Method After:sdXMLnodelist()
Local t:TLink
t=_link.NextLink()
If t Return sdXMLnodelist(t.Value())
End Method
Method Before:sdXMLnodelist()
Local t:TLink
t=_link.PrevLink()
If t Return sdXMLnodelist(t.Value())
End Method
Field node:sdXMLnode
Field nextnode:sdXMLnodelist
Field prevnode:sdXMLnodelist
End Type
' for internal use, do not use in code outside of this file
Type sdXMLworklist Extends TBBType
Method New()
Add(sdXMLworklist_list)
End Method
Method After:sdXMLworklist()
Local t:TLink
t=_link.NextLink()
If t Return sdXMLworklist(t.Value())
End Method
Method Before:sdXMLworklist()
Local t:TLink
t=_link.PrevLink()
If t Return sdXMLworklist(t.Value())
End Method
Field node:sdXMLnode
End Type
Type sdXMLnode Extends TBBType
Method New()
Add(sdXMLnode_list)
End Method
Method After:sdXMLnode()
Local t:TLink
t=_link.NextLink()
If t Return sdXMLnode(t.Value())
End Method
Method Before:sdXMLnode()
Local t:TLink
t=_link.PrevLink()
If t Return sdXMLnode(t.Value())
End Method
Field tag$,value$,path$
Field firstattr:sdXMLattr
Field lastattr:sdXMLattr
Field attrcount,fileid
Field endtag$
' linkage functionality
Field firstchild:sdXMLnode
Field lastchild:sdXMLnode
Field childcount
Field nextnode:sdXMLnode
Field prevnode:sdXMLnode
Field parent:sdXMLnode
End Type
Type sdXMLattr Extends TBBType
Method New()
Add(sdXMLattr_list)
End Method
Method After:sdXMLattr()
Local t:TLink
t=_link.NextLink()
If t Return sdXMLattr(t.Value())
End Method
Method Before:sdXMLattr()
Local t:TLink
t=_link.PrevLink()
If t Return sdXMLattr(t.Value())
End Method
Field name$,value$
Field sibattr:sdXMLattr
Field parent:sdXMLnode
End Type
Global SDXMLFILEID
Function sdReadXML:sdXMLnode(FileName$)
infile = ReadFile(FileName$)
SDXMLFILEID=MilliSecs()
x:sdXMLnode = sdXMLReadNode(infile,Null)
CloseFile infile
Return x
End Function
Function sdWriteXML(FileName$,node:sdXMLnode,writeroot=False)
outfile = WriteFile(FileName$)
WriteLine outfile,"<?xml version="+Chr$(34)+"1.0"+Chr$(34)+" ?>"
sdXMLwriteNode(outfile,node)
CloseFile outfile
End Function
Function sdXMLOpenNode:sdXMLnode(parent:sdXMLnode,tag$="")
'DebugLog "Opening new node"
x:sdXMLnode = New sdXMLnode
x.tag$=tag$
x.fileid = SDXMLFILEID' global indicator to group type entries (allows multiple XML files to be used)
sdXMLaddNode(parent,x)
Return x
End Function
Function sdXMLCloseNode:sdXMLnode(node:sdXMLnode)
'DebugLog "Closing node ["+node\tag$+"]"
If node.parent <> Null Then
'DebugLog "Returning to parent ["+node\parent\tag$+"]"
Else
'DebugLog "No Parent found"
End If
Return node.parent
End Function
' adds node to end of list (need separate function for insert, or mod this on)
Function sdXMLAddNode(parent:sdXMLnode,node:sdXMLnode)
If parent <> Null
'DebugLog "Parent of node = ["+parent\tag$+"]"
If parent.childcount = 0 Then
parent.firstchild = node
Else
parent.lastchild.nextnode = node
End If
node.prevnode = parent.lastchild
parent.lastchild = node
parent.childcount = parent.childcount +1
node.path$ = parent.path$+parent.tag$
End If
node.parent = parent
node.path$=node.path$+"/"
'DebugLog "path to ["+node\tag$+"]={"+node\path$+"}"
End Function
Function sdXMLDeleteNode(node:sdXMLnode)
n:sdXMLnode = node.firstchild
' delete any children recursively
While n <> Null
nn:sdXMLnode= n.nextnode
sdXMLdeletenode(n)
n = nn
Wend
' delete attributes for this node
a:sdXMLattr = node.firstattr
While a <> Null
na:sdXMLattr = a.sibattr
a.Remove()
a = na
Wend
' dec parents child count
If node.parent <> Null
node.parent.childcount = node.parent.childcount -1
' heal linkages
If node.prevnode <> Null Then node.prevnode.nextnode = node.nextnode
If node.nextnode <> Null Then node.nextnode.prevnode = node.prevnode
If node.parent.firstchild = node Then node.parent.firstchild = node.nextnode
If node.parent.lastchild = node Then node.parent.lastchild = node.prevnode
End If
' delete this node
' ;Debuglog "DELETING:"+node\tag$
node.Remove()
End Function
' node functions
Function sdXMLfindNode:sdXMLnode(node:sdXMLnode,path$)
'DebugLog "------------- Perfoming Find ("+path$+")------------"
ret:sdXMLnode = Null
p=Instr(path$,"/")
If p > 0 Then
tag$=Left$(path$,p-1)
';DebugLog "Looking for ["+tag$+"]"
a:sdXMLnode = node
While ret=Null And a<>Null
';DebugLog "Checking...["+a\tag$+"]"
If Lower(tag$)=Lower(a.tag$) Then
If p=Len(path$) Then
';Debuglog "Found..."
ret = a
Else
If a.firstchild <> Null Then
ret = sdxmlfindnode(a.firstchild,Mid$(path$,p+1))
End If
End If
End If
a = a.nextnode
Wend
End If
Return ret
End Function
Function sdXMLDeleteList(nl:sdXMLnodelist)
While nl <> Null
na:sdXMLnodelist = nl.nextnode
nl.Remove()
nl = na
Wend
End Function
Function sdXMLSelectNodes:sdXMLnodelist(node:sdXMLnode,path$,recurse=True)
root:sdXMLnodelist=Null
sdxmlselectnodesi(node,path$,recurse)
prev:sdXMLnodelist=Null
c = 0
For wl:sdXMLworklist = EachIn sdxmlworklist_list
c = c + 1
nl:sdXMLnodelist = New sdXMLnodelist
nl.node = wl.node
If prev = Null Then
root = nl
prev = nl
Else
prev.nextnode = nl
nl.prevnode = prev
End If
prev = nl
wl.Remove()
Next
'DebugLog "XML: "+c+" nodes selected"
Return root
End Function
' internal selection function, do not use outside this file
Function sdXMLSelectNodesI(node:sdXMLnode,path$,recurse=True)
wl:sdXMLworklist=Null
'DebugLog "------------- Perfoming Select ("+path$+")------------"
If node = Null Then
'DebugLog "Search node is null!!!"
End If
ret:sdXMLnode = Null
p=Instr(path$,"/")
If p > 0 Then
tag$=Left$(path$,p-1)
a:sdXMLnode = node
While a<>Null
'DebugLog "Looking for {"+path$+"} in {"+a\path$+a\tag$+"/} {"+Lower(Right$(a\path$+a\tag$+"/",Len(path$)))+"} @"
If Lower(path$)=Lower(Right$(a.path$+a.tag$+"/",Len(path$))) Then
wl = New sdXMLworklist
wl.node = a
'DebugLog ">>FOUND"
End If
If a.firstchild <> Null And (recurse) Then
sdXMLSelectNodesI(a.firstchild,path$)
End If
a = a.nextnode
Wend
End If
End Function
Function sdXMLNextNode:sdXMLnode(node:sdXMLnode)
Return node.nextnode
End Function
Function sdXMLPrevNode:sdXMLnode(node:sdXMLnode)
Return node.prevnode
End Function
Function sdXMLAddAttr(node:sdXMLnode,name$,value$)
'DebugLog "XML:adding attribute "+name$+"="+value$+" ("+Len(value$)+")"
a:sdXMLattr = New sdXMLattr
a.name$ = name$
a.value$ = value$
If node.attrcount = 0 Then
node.firstattr = a
Else
node.lastattr.sibattr = a
End If
node.lastattr=a
node.attrcount = node.attrcount + 1
a.parent = node
End Function
Function sdXMLReadNode:sdXMLnode(infile,parent:sdXMLnode,pushed=False)
mode = 0
root:sdXMLnode = Null
cnode:sdXMLnode = Null
x:sdXMLnode = Null
ispushed = False
done = False
While (Not done) & (Not Eof(infile))
c = ReadByte(infile)
If c<32 Then c=32
ch$=Chr$(c)
' ;Debuglog "{"+ch$+"} "+c+" mode="+mode
Select mode
Case 0 ' looking for the start of a tag, ignore everything else
If ch$ = "<" Then
mode = 1' start collecting the tag
End If
Case 1 ' check first byte of tag, ? special tag
If ch$ = "?" Or ch$ = "!" Then
mode = 0' class special nodes as garbage & consume
Else
If ch$ = "/" Then
mode = 2 ' move to collecting end tag
x.endtag$=ch$
'DebugLog "** found end tag"
Else
cnode=x
x:sdXMLnode = sdXMLOpennode(cnode)
If cnode=Null Then root=x
x.tag$=ch$
mode = 3 ' move to collecting start tag
End If
End If
Case 2 ' collect the tag name (close tag)
If ch$=">" Then
mode = 0 ' end of the close tag so jump out of loop
'done = True
x = sdXMLclosenode(x)
Else
x.endtag$ = x.endtag$ + ch$
End If
Case 3 ' collect the tag name
If ch$=" " Then
'DebugLog "TAG:"+x\tag$
mode = 4 ' tag name collected, move to collecting attributes
Else
If ch$="/" Then
'DebugLog "TAG:"+x\tag$
x.endtag$=x.tag$
mode = 2' start/end tag combined, move to close
Else
If ch$=">" Then
'DebugLog "TAG:"+x\tag$
mode = 20' tag closed, move to collecting value
Else
x.tag$ = x.tag$ + ch$
End If
End If
End If
Case 4 ' start to collect attributes
If Lower(ch$)>="a" And Lower(ch$)<="z" Then
aname$=ch$'
mode = 5' move to collect attribute name
Else
If ch$=">" Then
x.value$=""
mode = 20' tag closed, move to collecting value
Else
If ch$="/" Then
mode = 2 ' move to collecting end tag
x.endtag$=ch$
'DebugLog "** found end tag"
End If
End If
End If
Case 5 ' collect attribute name
If ch$="=" Then
'DebugLog "ATT:"+aname$
aval$=""
mode = 6' move to collect attribute value
Else
aname$=aname$+ch$
End If
Case 6 ' collect attribute value
If c=34 Then
mode = 7' move to collect string value
Else
If c <= 32 Then
'DebugLog "ATV:"+aname$+"="+aval$
sdXMLAddAttr(x,aname$,aval$)
mode = 4' start collecting a new attribute
Else
aval$=aval$+ch$
End If
End If
Case 7 ' collect string value
If c=34 Then
'DebugLog "ATV:"+aname$+"="+aval$
sdxmlADDattr(x,aname$,aval$)
mode = 4' go and collect next attribute
Else
aval$=aval$+ch$
End If
Case 20 ' COLLECT THE VALUE PORTION
If ch$="<" Then
'DebugLog "VAL:"+x\tag$+"="+x\value$
mode=1' go to tag checking
Else
x.value$=x.value$+ch$
End If
End Select
If Eof(infile) Then done=True
Wend
Return root
End Function
' write out an XML node (and children)
Function sdXMLWriteNode(outfile,node:sdXMLnode,tab$="")
' ;Debuglog "Writing...."+node\tag$+".."
s$="<"+node.tag$
a:sdXMLattr = node.firstattr
While a<>Null
' ;Debuglog "Writing attr ["+a\name$+"]=["+a\value$+"]"
s$ = s$+" "+Lower(a.name$)+"="+Chr$(34)+a.value$+Chr$(34)
a = a.sibattr
Wend
If node.value$="" And node.childcount = 0 Then
s$=s$+"/>"
et$=""
Else
s$=s$+">"+node.value$
et$="</"+node.tag$+">"
End If
WriteLine outfile,sdXMLcleanStr$(tab$+s$)
n:sdXMLnode = node.firstchild
While n <> Null
sdXMLwriteNode(outfile,n,tab$+" ")
n = n.nextnode
Wend
If et$<> "" Then WriteLine outfile,sdXMLcleanStr$(tab$+et$)
End Function
' remove non-visible chars from the output stream
Function sdXMLCleanStr$(s$)
a$=""
For i = 1 To Len(s$)
If Asc(Mid$(s$,i,1))>=32 Then a$ = a$ +Mid$(s$,i,1)
Next
Return a$
End Function
' attribute functions
' return an attribute of a given name
Function sdXMLFindAttr:sdXMLattr(node:sdXMLnode,name$)
ret:sdXMLattr = Null
If node <> Null Then
a:sdXMLattr = node.firstattr
done = False
While ret=Null And a<>Null
If Lower(name$)=Lower(a.name$) Then
ret = a
End If
a = a.sibattr
Wend
End If
Return ret
End Function
' return an attribute value as a string
Function sdXMLAttrValueStr$(node:sdXMLnode,name$,dflt$="")
ret$=dflt$
a:sdXMLattr = sdXMLfindattr(node,name$)
If a <> Null Then ret$=a.value$
Return ret$
End Function
' return an attribute value as an integer
Function sdXMLAttrValueInt(node:sdXMLnode,name$,dflt=0)
ret=dflt
a:sdXMLattr = sdXMLfindattr(node,name$)
If a <> Null Then ret=Int(a.value)
Return ret
End Function
' return an attribute value as a float
Function sdXMLAttrValueFloat#(node:sdXMLnode,name$,dflt#=0)
ret#=dflt#
a:sdXMLattr = sdXMLfindattr(node,name$)
If a <> Null Then ret#=Float(a.value)
Return ret
End Function
Function XMLValue$(node:sdXMLnode,path$)
Local t:sdXMLnode=XMLFindNode2(node,path$)
If t<>Null Then Return t.value$
End Function
Function XMLValueInt(node:sdXMLnode,path$)
Local t:sdXMLnode=XMLFindNode2(node,path$)
If t<>Null Then Return Int(t.value$)
End Function
Function XMLValueFloat(node:sdXMLnode,path$)
Local t:sdXMLnode=XMLFindNode2(node,path$)
If t<>Null Then Return Float(t.value$)
End Function
Function XMLParam$(node:sdXMLnode,param$)
Return sdXMLAttrValueStr(node,param$)
End Function
Function XMLParamStr$(node:sdXMLnode,path$,param$)
Local t:sdXMLnode=XMLFindNode2(node,path$)
If t<>Null Then Return sdXMLAttrValueStr(t,param$)
End Function
Function XMLParamInt(node:sdXMLnode,path$,param$)
Local t:sdXMLnode=XMLFindNode2(node,path$)
If t<>Null Then Return sdXMLAttrValueInt(t,param$)
End Function
Function XMLParamFloat#(node:sdXMLnode,path$,param$)
Local t:sdXMLnode=XMLFindNode2(node,path$)
If t<>Null Then Return sdXMLAttrValueFloat(t,param$)
End Function
Function XMLfindNode2:sdXMLnode(node:sdXMLnode,path$)
Return sdXMLFindNode(node,node.tag$+"/"+path$)
End Function
'x.sdxmlnode = sdReadXML("test.xml")
'sdwritexml("test2.xml",x)
'f.sdxmlnode = sdxmlfindnode(x,"BB3D/NODE/MESH/")
'If f <> Null Then
' ;Debuglog "FOUND!!!"
' sdxmldeletenode(f)
'End If
'sdwritexml("test3.xml",x)
'nl.sdxmlnodelist = sdxmlselectnodes(x,"/VERTEX/POS/")
'While nl <> Null;
' ;Debuglog "Found....."+nl\node\tag$
' nl=nl\nextnode
'Wend
'sdxmldeleteList(nl);
'sdxmldeletenode(x) |