<%
' wxml.inc (C) 2010 Walter Bislin
' http://walter.bislins.ch/doku/wxml
'
' Dependencies:
' - perf.inc (CStream)
' - pattern.inc
'

class CXmlTag
  public Name      ' as string
  public TagList   ' as array of CXmlTag 
  public Value     ' as string
  private mLastName
  private mLastIx

  private sub Class_Initialize()
    Name = ""
    TagList = Array()
    Value   = ""
    mLastName = ""
    mLastIx = -1
  end sub

  function TagsCount()
    TagsCount = UBound(TagList) + 1
  end function

  function FindTag( aName )
    dim i
    ' check cache first
    if aName = mLastName then
      FindTag = mLastIx
      exit function
    end if
    ' try next entry second
    if mLastIx < UBound(TagList) then
      if TagList(mLastIx+1).Name = aName then
        FindTag = mLastIx + 1
        mLastIx = FindTag
        mLastName = aName
        exit function
      end if
    end if
    ' finally we must search the list from start
    for i = 0 to UBound(TagList)
      if TagList(i).Name = aName then
        FindTag = i
        mLastIx = i
        mLastName = aName
        exit function
      end if
    next
    FindTag = -1
  end function

  function GetTagByName( aName )
    dim i
    i = FindTag( aName )
    if i >= 0 then
      set GetTagByName = TagList(i)
    else
      set GetTagByName = Nothing
    end if
  end function

  function NewTag( aName )
    ' creates and adds a new tag with name aName and returns it
    ' return as CXmlTag
    set NewTag = NewXmlTag( aName )
    AddTag NewTag
  end function

  sub AddValueTag( aName, aValue )
    dim tag
    set tag = NewTag( aName )
    tag.Value = aValue
  end sub

  sub Parse( aString )
    dim p, s
    p = 1
    ' remove comments
    s = ReplacePattern( aString, "<!--[^\x00]*-->", "", false )
    ParseTagValue s, Len(s), p
  end sub

  sub ParseTagValue( aString, aLen, byRef aPos )
    ' aPos points behind ">" of tag start or is 1
    ' at aPos starts eather a list of tags or a string value (if next "<" is a tag end)
    dim pts, tag, p

    if aPos > aLen then exit sub
    pts = InStr( aPos, aString, "<" )
    if pts = 0 or pts = aLen then
      ' unexpected end of data
      Value = UnmaskValue( Mid( aString, aPos, aLen-aPos+1 ) )
      aPos = aLen + 1
      exit sub
    end if

    ' pts points to "<" or "</"
    if Mid(aString,pts+1,1) = "/" then
      ' end of tag value
      Value = UnmaskValue( Mid( aString, aPos, pts-aPos ) )
      aPos = pts
      exit sub
    end if

    ' loop over tag list
    p = pts
    do while p <= aLen
      set tag = new CXmlTag
      tag.ParseTag aString, aLen, p
      AddTag tag

      pts = InStr( p, aString, "<" )
      if pts = 0 or pts = aLen then
        ' end of data
        aPos = aLen + 1
        exit sub
      end if

      if Mid(aString,pts+1,1) = "/" then
        ' end of tag list
        aPos = pts
        exit sub
      end if

      ' one more tag
      p = pts
    loop
    aPos = p

  end sub

  sub ParseTag( aString, aLen, byRef aPos )
    ' aPos must point to start of tag "<"
    ' sets aPos behind end of corr. tag ">" + 1
    dim p, pte

    ' parse tag name
    p = aPos + 1
    aPos = aLen+1
    if p >= aLen then exit sub
    pte = InStr( p, aString, ">" )
    if pte = 0 then exit sub
    Name = Mid( aString, p, pte-p )
    aPos = pte + 1

    ' parse tag value; aPos points behind ">"
    ParseTagValue aString, aLen, aPos

    ' skip tag end "</Name>"; aPos points to "<" of tag end
    if aPos > aLen then exit sub
    if InStr( aPos, aString, "</" ) <> aPos then exit sub
    p = InStr( aPos, aString, ">" )
    if p = 0 then exit sub
    aPos = p + 1
  end sub

  function Serialize()
    dim s
    set s = NewStream(0)
    SerializeToStream s, ""
    Serialize = s.GetString(false)
  end function

  sub SerializeToStream( aStream, aIndentStr )
    ' aStream as CStrStream
    dim i
    if UBound(TagList) >= 0 then
      for i = 0 to UBound(TagList)
        aStream.Add vbCRLF
        TagList(i).SerializeTag aStream, aIndentStr
      next
      aStream.Add vbCRLF
    else
      aStream.Add MaskValue( Value )
    end if
  end sub

  sub SerializeTag( aStream, aIndentStr )
    ' aStream as CStrStream
    aStream.Add4 aIndentStr, "<", Name, ">"
    SerializeToStream aStream, aIndentStr & "  "
    if UBound(TagList) >= 0 then
      aStream.Add4 aIndentStr, "</", Name, ">"
    else
      aStream.Add "</>"
    end if
  end sub

  sub AddTag( aTag )
    ' aTag as CXmlTag
    dim sz
    sz = UBound(TagList) + 1
    redim preserve TagList(sz)
    set TagList(sz) = aTag
  end sub

  private function MaskValue( aValue )
    MaskValue = Replace( aValue, "&", "&amp;" )
    MaskValue = Replace( MaskValue, "<", "&lt;" )
    MaskValue = Replace( MaskValue, ">", "&gt;" )
  end function

  private function UnmaskValue( aString )
    UnmaskValue = Replace( aString, "&gt;", ">" )
    UnmaskValue = Replace( UnmaskValue, "&lt;", "<" )
    UnmaskValue = Replace( UnmaskValue, "&amp;", "&" )
  end function

  ' some useful functions

  sub AddBool( aName, aBool )
    dim name, val
    name = aName
    if name = "" then name = "bool"
    if aBool then
      val = "true"
    else
      val = "false"
    end if
    AddValueTag name, val
  end sub

  sub AddInt( aName, aInt )
    dim name
    name = aName
    if name = "" then name = "int"
    AddValueTag name, CStr(aInt)
  end sub

  sub AddDate( aName, aDate )
    dim name
    name = aName
    if name = "" then name = "date"
    AddValueTag name, CStr(aDate)
  end sub

  sub AddStr( aName, aStr )
    dim name
    name = aName
    if name = "" then name = "str"
    AddValueTag name, aStr
  end sub

  function AddArray( aName, aSize )
    ' returns CXmlTag
    dim name
    name = aName
    if name = "" then name = "array"
    set AddArray = NewXmlArrayTag( name, aSize )
    AddTag AddArray
  end function

  sub AddStrArray( aName, aStrArray )
    dim sz, arrayTag, i
    sz = UBound(aStrArray)
    set arrayTag = AddArray( aName, sz+1 )
    for i = 0 to sz
      set arrayTag.TagList(i) = NewXmlValueTag( "str", aStrArray(i) )
    next
  end sub

  function GetBool()
    GetBool = (Value = "true")
  end function

  function GetBoolByIx( aIx )
    GetBoolByIx = TagList(aIx).GetBool()
  end function

  function GetBoolByName( aName, aDefVal )
    dim tag
    GetBoolByName = aDefVal
    set tag = GetTagByName(aName)
    if not tag is Nothing then GetBoolByName = tag.GetBool()
  end function

  function GetInt()
    if IsNumeric(Value) then
      GetInt = CLng(Value)
    else
      GetInt = 0
    end if
  end function

  function GetIntByIx( aIx )
    GetIntByIx = TagList(aIx).GetInt()
  end function

  function GetIntByName( aName, aDefVal )
    dim tag
    GetIntByName = aDefVal
    set tag = GetTagByName(aName)
    if not tag is Nothing then GetIntByName = tag.GetInt()
  end function

  function GetDate()
    if IsDate(Value) then
      GetDate = CDate(Value)
    else
      GetDate = CDate(0)
    end if
  end function

  function GetDateByIx( aIx )
    GetDateByIx = TagList(aIx).GetDate()
  end function

  function GetDateByName( aName, aDefVal )
    dim tag
    GetDateByName = aDefVal
    set tag = GetTagByName(aName)
    if not tag is Nothing then GetDateByName = tag.GetDate()
  end function

  function GetStr()
    GetStr = Value
  end function

  function GetStrByIx( aIx )
    GetStrByIx = TagList(aIx).GetStr()
  end function

  function GetStrByName( aName, aDefVal )
    dim tag
    GetStrByName = aDefVal
    set tag = GetTagByName(aName)
    if not tag is Nothing then GetStrByName = tag.GetStr()
  end function

  function GetArray()
    dim arrRet
    arrRet = Array()
    if UBound(TagList) >= 0 then
      redim arrRet( UBound(TagList) )
    end if
    GetArray = arrRet
  end function

  function GetArrayByIx( aIx )
    GetArrayByIx = TagList(aIx).GetArray()
  end function

  function GetArrayByName( aName )
    dim tag
    set tag = GetTagByName(aName)
    if not tag is Nothing then
      GetArrayByName = tag.GetArray()
    else
      GetArrayByName = Array()
    end if
  end function

  function GetStrArray()
    dim arrRet, i
    arrRet = GetArray()
    for i = 0 to UBound(arrRet)
      arrRet(i) = GetStrByIx(i)
    next
    GetStrArray = arrRet
  end function

  function GetStrArrayByIx( aIx )
    GetStrArrayByIx = TagList(aIx).GetStrArray()
  end function

  function GetStrArrayByName( aName )
    dim tag
    set tag = GetTagByName(aName)
    if not tag is Nothing then
      GetStrArrayByName = tag.GetStrArray()
    else
      GetStrArrayByName = Array()
    end if
  end function

end class

function NewXmlTag( aName )
  set NewXmlTag = new CXmlTag
  NewXmlTag.Name = aName
end function

function NewXmlValueTag( aName, aValue )
  set NewXmlValueTag = new CXmlTag
  NewXmlValueTag.Name = aName
  NewXmlValueTag.Value = aValue
end function

function NewXmlArrayTag( aName, aSize )
  dim tl
  set NewXmlArrayTag = new CXmlTag
  NewXmlArrayTag.Name = aName
  if aSize > 0 then
    redim tl( aSize-1 )
    NewXmlArrayTag.TagList = tl
  end if
end function

%>