--This is the XML-RPC client library for macromedia's director
--

--XML-RPC is a way of doing Remote Procedure Calls (RPCs) using
--(you guessed it) XML!!  A remote procedure call is where
--you initiate a procedure on another machine and get a
--response from that procedure.  In that sense, the web
--is just a bunch of RPCs!  But the cool thing that's happened
--lately is that protocols have been established so that when
--you do a remote procedure call, you may pass parameters to that
--procedure and those parameters are translated from their
--native format into a format that can be sent accross the web
--by some middleware type software.  When you get a reply, it is
--translated the other way, so that what you end up with are
--native data structures.  XML-RPC is the protocol for translating
--procedure calls and their parameters and results into XML and back.

--Obviously you need software to translate into XML-RPC for any
--platform that wishes to communicate with others using the protocol.
--This library is a working implementation that allows a director
--movie to talk to an RPC server.  RPC servers are quite easy to set up,
--since software already exists for perl, java servlets, active
--server pages, PHP, etc.

--To use this library to do XML-RPC in director, you must do
--two things. First, initiate a connection with an RPC server
--using the xmlRpc handler.  Specify the name of the remote 
--procedure, the parameters, and the URL of the RPC server.
--This handler encodes your parameters into XML and sends the request.

--Second, call the finishRpcCall handler.  This parses the results
--that the server responded with, and puts them into the global
--lastRpcCall variable.

--XML-RPC supports strings, booleans, integers, doubles (floats), 
--date/time (yyyymmddThh:mm:ss), base 64 binary,
--structs (lingo property lists) and arrays (lingo lists).  This
--library only supports strings, integers, floats, arrays and structs.
--XML-RPC allows for nesting arrays and structs within other arrays
--and structs to any level, and this library is capable of handling
--that as well.


on startmovie
  global checkRPC
  global flDebugXMLRPC
  
  checkRPC = false
  flDebugXMLRPC = true
  
end

on exitFrame
  
  --finishRpcCall only functions when an XML request has been sent
  --and the response has been receied but not processed.
  finishRpcCall()
  go to frame 1
end

on xmlRpc (procName, paramList, xmlRpcURL)
  global flDebugXMLRPC
  global checkRPC
  global currentRpcId
  
  xmlPOST = "<?xml version="&QUOTE&"1.0"&QUOTE&"?> " & RETURN
  xmlPOST = xmlPOST & " <methodCall>  " & RETURN
  xmlPOST = xmlPOST & " <methodName>"& procName &"</methodName>  " & RETURN
  xmlPOST = xmlPOST & "" & RETURN
  xmlPOST = xmlPOST & xmlParams(paramList)
  xmlPOST = xmlPOST & " " & RETURN
  xmlPOST = xmlPOST & " </methodCall>" & RETURN
  
  currentRpcId = postNetText(xmlRpcURL, xmlPOST)
  
  checkRPC = true
  
  if ( flDebugXMLRPC = TRUE ) then
    member("debugPOST").text = xmlPOST
  end if
  
  return true
  
end



on finishRpcCall
  
  global currentRpcId
  global checkRPC
  global lastRpcCall
  global flDebugXMLRPC
  
  if (checkRPC = true )then
    if (netDone(currentRpcId) = TRUE) then
      lastRpcCall = xmlRpcFetch()
      if ( flDebugXMLRPC = TRUE ) then
        put printLingoStruct(lastRpcCall) into member "disResult"
      end if
      checkRPC = false
      return lastRpcCall
    else
      --put "not ready yet"
    end if
  end if
  
end

on xmlRpcFetch
  
  global currentRpcId
  global flDebugXMLRPC
  
  xmlParseObj= new(xtra "xmlparser")
  ServerResponse = netTextResult(currentRpcId)
  node = parseString (xmlParseObj,ServerResponse )
  
  
  nodelist = makelist (xmlParseObj)
  
  if ( flDebugXMLRPC = TRUE ) then
    member("debugRESP").text = ServerResponse
  end if
  
  
  return xmlrpcDecodeResult (nodelist)
  
end




on xmlrpcDecodeResult (xmlList)
  
  myStatus = getPropAt(xmlList[1][2],2)
  
  if myStatus = "fault" then
    
    put "XML-RPC server error"
    
    global rpcError
    rpcError = xmlList[1][2][2][2][2][2][3][2][2]
    
    return false
    
  end if
  
  currentNode = xmlList[1][2][2][2][2]
  put printLingoStruct(xmlList) into member("debugWindow")
  ret = xmlToLingo(currentNode)
  
  return ret
  
end

-----------------------------------------------------
-----------------------------------------------------
--XML to lingo conversion functions

on xmlToLingo(currentNode)
  
  myType = getPropAt(currentNode,2)
  
  --put "type is: " & myType
  
  if myType = "array" then
    return xmlArrayToLingo(currentNode)
  end if
  
  if myType = "struct" then
    return xmlStructToLingo(currentNode)
  end if
  
  
  
  if (myType = "string") then
    if count(currentNode[2]) > 1 then
      return currentNode[2][2]
    else
      return ""
    end if
    
  end if
  
  if (myType = "i4") then
    return integer (currentNode[2][2])
  end if
  
  if (myType = "int") then
    return integer (currentNode[2][2])
  end if
  
  if (myType = "double") then
    return float (currentNode[2][2])
  end if
  
  return "not implemented"
  
end

on xmlArrayToLingo (currentNode)
  ret = []
  repeat with i = 2 to count(currentNode[2][2])
    
    ret[i-1] = xmlToLingo(currentNode[2][2][i])
  end repeat
  
  return ret
  
end

on xmlStructToLingo(currentNode)
  
  ret = [:]
  repeat with i = 2 to count(currentNode[2])
    
    --put currentNode[2][i][2][2] & " is " & currentNode[2][i][3][2][2]
    --put currentNode[2][i][3][2][2]
    addProp(ret,currentNode[2][i][2][2],xmlToLingo(currentNode[2][i][3]))
  end repeat
  
  return ret
  
end

------------------------------------------------
------------------------------------------------
--lingo pretty printing functions for debugging

on printLingoStruct (var,level)
  
  indent = makeIndent(level)
  
  ret = ilk(var) & ": "
  
  if ilk(var, #propList) then
    
    ret = ret & Return & printLingoPropList(var,(level+1))
  else if ilk(var,#list) then
    ret = ret & Return & printLingoList(var,(level + 1))
  else
    ret = ret & var
  end if
  
  ret = ret & Return
  
  return ret
  
end

on printLingoList (myList,level)
  
  indent = makeIndent(level)
  
  repeat with i=1 to count(myList)
    ret = ret & indent & "[" & i & "]: "
    ret = ret & printLingoStruct(myList[i],(level+1))
  end repeat
  
  return ret
  
  
end

on printLingoPropList (myPropList,level)
  
  indent = makeIndent(level)
  
  repeat with entry in myPropList
    i = i +1
    ret = ret & indent & "[" & i & "]#" & getPropAt(myPropList,i) & ": "
    ret = ret & printLingoStruct(entry,(level+1))
  end repeat
  
  return ret
  
end

on makeIndent (level)
  
  indentChar = "--"
  
  repeat with i = 1 to level
    indent = indent & indentChar
  end repeat
  
  return indent
  
end

----------------------------------------------------
----------------------------------------------------
--lingo to XML formatting

on xmlParams (paramList)
  
  xmlPOST = xmlPOST & "<params>" & Return
  
  repeat with currentVar in paramList
    xmlPOST = xmlPOST & "<param>" & Return
    xmlPOST = xmlPOST & lingoToXml(currentVar)
    xmlPOST = xmlPOST & "</param>" & Return
  end repeat
  
  xmlPOST = xmlPOST & "</params>" & Return
  
  return xmlPOST
  
end


on lingoToXml (currentVar)  
  
  xmlPOST = xmlPOST & "<value>"
  
  if ilk(currentVar) = #propList then
    
    xmlPOST = xmlPOST & propListToXml(currentVar)  
    
  else if ilk(currentVar) = #list then
    
    xmlPOST = XMLPOST & listToXml(currentVar)
    
  else if (stringP(currentVar) = true) then
    xmlPOST = xmlPOST & "<string>"&currentVar&"</string>"& RETURN
  else if (integerP(currentVar) = true) then
    xmlPOST = xmlPOST & "<i4>"&currentVar&"</i4>"& RETURN
  else if (floatP(currentVar) = true) then
    xmlPOST = xmlPOST & "<double>"&currentVar&"</double>"& RETURN
  end if
  
  
  xmlPOST = xmlPOST & "</value>" & RETURN
  
  
  
  return xmlPOST
  
end

on propListToXml (currentList)
  
  xmlPOST = xmlPOST & "<struct>" & Return
  
  repeat with i = 1 to count(currentList)
    xmlPOST = xmlPOST & "<member>" & Return & "<name>"
    xmlPOST = xmlPOST & getPropAt(currentList,i) & "</name>"
    xmlPOST = xmlPOST &  lingoToXml(currentList[i]) & Return &¬
       "</member>" & Return
  end repeat
  
  xmlPOST = xmlPOST & "</struct>" & Return
  
  return xmlPOST
  
end

on listToXml(currentList)
  
  xmlPOST = xmlPOST & "<array>" & Return & "<data>"
  repeat with currentVar in currentList
    
    xmlPOST = xmlPOST & lingoToXml(currentVar)
    
  end repeat
  
  xmlPOST = xmlPOST & "</data>" & Return & "</array>" & Return
  
  return xmlPOST
  
end