This has taken a while because I've been busy with some other things lately (like installing Kubuntu!), but belatedly, here is an incomplete version of VBscript-PPI that I'm still working on. It supports translation of numbers, strings, booleans, and arrays/lists, but not yet methods (which won't be that hard now that I have the infrastructure in). I've never used VBscript before, either, so I'm sure I could have done some things a lot better. Still, the point is that it does work, and I've used it to communicate non-method types values between a VBscript plugin and a Lua plugin (both ways).
It should be noted that it's wrapped in XML, as VBscript has no facility to load other files. (That said, will ImportXML() work correctly with <script> correctly? I haven't had a chance to check.) There is also no support yet for PPI_INVOKE messages, since I'm still working on method support. (You can see a PPI_Method_Class type early in the file, though.)
I'm open to any and all suggestions for improving this implementation. Again, I've never before used VBscript, so I'm probably not doing things idiomatically.
ppi.vbs.xml<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script>
<script><![CDATA[
' used in the PPI base class
Class PPI_Error
Public Error
End Class
' in progress
Class PPI_Method_Class
Public Default Function Invoke(aParams)
Note(Join(aParams))
Invoke = array()
End Function
End Class
Class PPI_List_Item
Public Key
Public Value
End Class
Class PPI_List
Private aEntries()
Private numEntries
Private Sub Class_Initialize()
numEntries = 0
End Sub
Public Function GetEntry(vKey)
Set GetEntry = Nothing
' Array keys should not be compared
If IsArray(vKey) Then
Exit Function
End If
If numEntries < 1 Then
Exit Function
End If
Dim i, entry
For i = 0 To numEntries - 1
Set entry = aEntries(i)
If Not entry Is Nothing Then
If (IsObject(vKey) And IsObject(entry.Key)) Then
If vKey Is entry.Key Then
Set GetEntry = entry
Exit Function
End If
ElseIf (Not IsObject(vKey)) And (Not IsObject(entry.Key)) Then
If entry.Key = vKey Then
Set GetEntry = entry
Exit Function
End If
End If
End If
Next
End Function
Public Sub SetEntry(vKey, vValue)
' Get the element by key
Dim entry
Set entry = GetEntry(vKey)
' If it doesn't exist yet, insert a new one
If entry Is Nothing And Not IsEmpty(vValue) Then
Set entry = New PPI_List_Item
' Check if there are any Empty elements
Dim i
For i = 0 To numEntries - 1
If IsEmpty(aEntries(i)) Then
Set aEntries(i) = entry
Exit For
End If
Next
' As a last resort, resize the array and add a new entry.
If i = numEntries Then
ReDim Preserve aEntries(numEntries)
Set aEntries(numEntries) = entry
numEntries = numEntries + 1
End If
End If
' If there was one, modify it and return
If Not entry Is Nothing Then
' If the value is Empty, just remove the entry
If IsEmpty(vValue) Then
Set aEntries(vKey) = Nothing
Else
If IsObject(vKey) Then
Set entry.Key = vKey
Else
entry.Key = vKey
End If
If IsObject(vValue) Then
Set entry.Value = vValue
Else
entry.Value = vValue
End If
End If
End If
End Sub
Public Property Get At(vKey)
Dim entry
Set entry = GetEntry(vKey)
If Not entry Is Nothing Then
If IsObject(entry.Value) Then
Set At = entry.Value
Else
At = entry.Value
End If
End If
End Property
Public Property Let At(vKey, vValue)
SetEntry vKey, vValue
End Property
Public Property Set At(vKey, vValue)
SetEntry vKey, vValue
End Property
Public Property Get Count
Count = numEntries
End Property
Public Function ToArray()
Dim aList(), entry
ReDim aList(0)
Dim i
For i = 0 To numEntries
Set entry = GetEntry(i)
If entry Is Nothing Then
Exit For
End If
If IsObject(entry.Value) Then
Set aList(i) = entry.Value
Else
aList(i) = entry.Value
End If
ReDim Preserve aList(i+1)
Next
If i = 0 Then
ToArray = array()
Else
ReDim Preserve aList(i-1)
ToArray = aList
End If
End Function
Public Function ToMap()
If numEntries < 0 Then
ToMap = array()
Else
ToMap = aEntries
End If
End Function
Public Sub MergeArray(aItems)
Dim i
For i = 0 To UBound(aItems)
SetEntry i, aItems(i)
Next
End Sub
End Class
Class PPI_Translate_Class
Private listCache
' Takes a PPI_List of items and serializes them.
Private Function Serialize_Inner(listItems, listSerialized)
' If we already serialized it, don't do it again
Set Serialize_Inner = listCache.GetEntry(listItems)
If Not Serialize_Inner Is Nothing Then
Serialize_Inner = Serialize_Inner.Value
Exit Function
End If
Serialize_Inner = listCache.Count + 1
listCache.At(listItems) = Serialize_Inner
Dim ary_id
ary_id = "PPIarray" & Serialize_Inner
ArrayCreate ary_id
' Convert arrays to PPI_List-style maps
If IsArray(listItems) Then
Dim tempList
Set tempList = New PPI_List
tempList.MergeArray(listItems)
Set listItems = tempList
Set tempList = Nothing
End If
listItems = listItems.ToMap()
' Go over every entry
Dim sKey, sValue, entry
For Each entry In listItems
sKey = Null
' Skip invalid keys
If Not IsObject(entry.Key) Then
sKey = entry.Key
If TypeName(sKey) = "String" Then
sKey = "s:" & sKey
ElseIf IsNumeric(sKey) Then
sKey = "n:" & CStr(sKey + 1)
Else
sKey = Null
End If
End If
If Not IsNull(sKey) Then
sValue = "z:~"
' Default to PPI-nil on invalid values
If Not IsObject(entry.Value) Then
sValue = entry.Value
If TypeName(sValue) = "String" Then
sValue = "s:" & sValue
ElseIf TypeName(sValue) = "Boolean" Then
If sValue Then
sValue = "b:1"
Else
sValue = "b:0"
End If
ElseIf IsNumeric(sValue) Then
sValue = "n:" & CStr(sValue)
ElseIf IsArray(sValue) Then
sValue = "t:" & Serialize_Inner(sValue, listSerialized)
End If
ElseIf TypeName(entry.Value) = "PPI_List" Then
sValue = "t:" & Serialize_Inner(entry.Value, listSerialized)
End If
ArraySet ary_id, sKey, sValue
End If
Next
listSerialized.At(Serialize_Inner - 1) = ArrayExport(ary_id, "|")
ArrayDelete ary_id
End Function
Private Function Deserialize_Inner(aItems, iIndex)
' If we already deserialized it, don't do it again!
Set Deserialize_Inner = listCache.GetEntry(iIndex)
If Not Deserialize_Inner Is Nothing Then
If IsObject(Deserialize_Inner.Value) Then
Set Deserialize_Inner = Deserialize_Inner.Value
Else
Deserialize_Inner = Deserialize_Inner.Value
End If
Exit Function
End If
Deserialize_Inner = Empty
' Used to break apart each entry
Dim sType, sValue
' Stores the deserialized results
Dim listResults
Set listResults = New PPI_List
' Cache the result list
Set listCache.At(iIndex) = listResults
' Import the line into an array
ArrayCreate "PPIarray" & iIndex
ArrayImport "PPIarray" & iIndex, aItems(iIndex), "|"
Dim aKeys
aKeys = ArrayListKeys("PPIarray" & iIndex)
If Not IsEmpty(aKeys) Then
' Deserialize each item one by one
Dim key, val
For Each key In aKeys
' Keep the value for later
val = ArrayGet("PPIarray" & iIndex, key)
' Check the keytype first
sType = Left(key, 1)
sValue = Right(key, Len(key) - 2)
If sType = "n" Then
key = CDbl(sValue) - 1
ElseIf sType = "s" Then
key = sValue
Else
key = Null
End If
' If the keytype is valid, check the value
If Not IsNull(key) Then
' Split into type and value
sType = Left(val, 1)
sValue = Right(val, Len(val) - 2)
' Deserialize by type identifier
If sType = "s" Then
listResults.At(key) = sValue
ElseIf sType = "n" Then
listResults.At(key) = CDbl(sValue)
ElseIf sType = "b" Then
If vValue = "1" Then
listResults.At(key) = True
Else
listResults.At(key) = False
End If
ElseIf sType = "t" Then
Set listResults.At(key) = Deserialize_Inner(aItems, CInt(sValue) - 1)
Else
listResults.At(key) = Empty
End If
End If
Next
End If
ArrayDelete "PPIarray" & iIndex
Set Deserialize_Inner = listResults
End Function
Public Function Serialize(listItems)
Set listCache = New PPI_List
Dim listSerialized
Set listSerialized = New PPI_List
Serialize_Inner listItems, listSerialized
Serialize = listSerialized.ToArray()
Set listCache = Nothing
Set listSerialized = Nothing
End Function
Public Function Deserialize(aItems)
Set listCache = New PPI_List
Set Deserialize = Deserialize_Inner(aItems, 0)
Set listCache = Nothing
End Function
Public Function GetParams(sPlugin)
Dim aParams()
Dim length
length = 0
Dim i
Do While Not IsEmpty(GetPluginVariable(sPlugin, "PPIparams_" & length + 1))
ReDim Preserve aParams(length)
aParams(length) = GetPluginVariable(sPlugin, "PPIparams_" & length + 1)
length = length + 1
Loop
If length = 0 Then
ReDim aParams(0)
aParams(0) = ""
End If
Set GetParams = PPI.Translate.Deserialize(aParams)
End Function
Public Sub SetParams(aParams)
aParams = PPI.Translate.Serialize(aParams)
Dim i
For i = 0 To UBound(aParams)
SetVariable "PPIparams_" & (i + 1), "" & aParams(i)
Next
End Sub
End Class
Class PPI_Accessor
Public PluginID
Public Reloaded
Public Default Function Access(sKey)
If Not PluginSupports(PluginID, "PPI_ACCESS") = 0 Then
Access = Empty
Exit Function
End If
PPI.Translate.SetParams array(sKey)
CallPlugin PluginID, "PPI_ACCESS", GetPluginID()
Set Access = PPI.Translate.GetParams(PluginID).GetEntry(0)
If Access Is Nothing Then
Access = Empty
ElseIf IsObject(Access.Value) Then
Set Access = Access.Value
Else
Access = Access.Value
End If
CallPlugin PluginID, "PPI_CLEANUP", ""
End Function
End Class
Class PPI_Base
Private aAccessors()
Private listExposed
Private myTranslate
Private Sub Class_Initialize()
Set myTranslate = New PPI_Translate_Class
Set listExposed = New PPI_List
ReDim aAccessors(0)
aAccessors(0) = Null
End Sub
Public Property Get Translate()
Set Translate = myTranslate
End Property
Private Sub AddAccessor(sPlugin, accessor)
Dim length
length = UBound(aAccessors) + 1
ReDim Preserve aAccessors(length)
aAccessors(length) = array(GetPluginID(), New PPI_Accessor)
End Sub
Private Function GetAccessor(sPlugin)
Dim entry
entry = Null
Dim i
For i = 1 to UBound(aAccessors)
entry = aAccessors(i)
If entry(0) = sPlugin Then
Set GetAccessor = entry(1)
Exit Function
End If
Next
Set GetAccessor = Nothing
End Function
' Load the PPI interface for a given plugin
Public Function Load(sPlugin)
' Make sure the plugin is accessible
If Not IsPluginInstalled(sPlugin) Then
Set Load = New PPI_Error
Load.Error = "not_installed"
Exit Function
ElseIf Not GetPluginInfo(sPlugin, 17) Then
Set Load = New PPI_Error
Load.Error = "not_enabled"
Exit Function
End If
Dim accessor
Set accessor = GetAccessor(sPlugin)
' Only create a new one if we haven't made one for it before
If accessor Is Nothing Then
Set accessor = New PPI_Accessor
accessor.PluginID = sPlugin
accessor.Reloaded = True
AddAccessor sPlugin, accessor
End If
Set Load = accessor
End Function
Public Sub Expose(sName, vValue)
If IsObject(vValue) Then
Set listExposed.At(sName) = vValue
Else
listExposed.At(sName) = vValue
End If
End Sub
Public Sub PPI_ACCESS(sPlugin)
Dim item
Set item = PPI.Translate.GetParams(sPlugin).GetEntry(0)
Set item = listExposed.GetEntry(item.Value)
CallPlugin PluginID, "PPI_CLEANUP", ""
PPI.Translate.SetParams(array(item.Value))
End Sub
Public Sub PPI_INVOKE(sPlugin)
' To-do
End Sub
Public Sub PPI_CLEANUP(sPlugin)
Dim i
i = 1
Do Until IsEmpty(GetVariable("PPIparams_" & i))
DeleteVariable("PPIparams_" & i)
i = i + 1
Loop
End Sub
End Class
' Create the incoming PPI message receivers
Sub PPI_INVOKE(sPlugin)
PPI.PPI_INVOKE(sPlugin)
End Sub
Sub PPI_ACCESS(sPlugin)
PPI.PPI_ACCESS sPlugin
End Sub
Sub PPI_CLEANUP(sPlugin)
PPI.PPI_CLEANUP(sPlugin)
End Sub
' The global PPI object
Dim PPI
Set PPI = New PPI_Base
]]></script>
|