DBusProxy._GetSymbols() is a new undocumented method for decoding introspection.

[GB.DBUS]
* NEW: DBusProxy._GetSymbols() is a new undocumented method for decoding introspection.
* NEW: DBusConnection[Application] now returns the DBusApplication object registered on the specific bus.

gb.dbus/src/gb.dbus/.src/CIntrospection.class

@@ -0,0 +1,194 @@
+' Gambas class file
+
+Private $sText As String
+Private $iPos As Integer
+
+Property Read Text As String Use $sBefore
+Property Read Open As Boolean Use $bOpen
+Property Read Close As Boolean Use $bClose
+Property Read Node As String Use $sNode
+Property Read Level As Integer Use $iLevel
+
+Private $cAttr As Collection
+
+Public Sub _new(sText As String)
+  
+  $sText = sText
+  
+End
+
+Public Sub MoveNext() As Boolean
+  
+  Dim sCar As String
+  Dim iStart As Integer
+  Dim sEnd As String
+  
+  If $bClose Then Dec $iLevel
+  
+  $bOpen = False
+  $bClose = False
+  $sNode = ""
+  
+  iStart = $iPos
+  Do
+    GoSub READ_CHAR
+    If Not sCar Then Return True
+    If sCar = "<" Then 
+      If Mid$($sText, $iPos) Begins "<!--" Then
+        $iPos = InStr($sText, "-->", $iPos + 4)
+        If $iPos = 0 Then Return True
+        $iPos += 3
+        Continue
+      Endif
+      Goto READ_MARKUP
+    Endif
+  Loop
+
+READ_MARKUP:
+
+  $sBefore = Mid$($sText, iStart + 1, $iPos - 1)
+  iStart = $iPos
+
+  Do
+
+    GoSub READ_CHAR
+    If sCar = "\"" Or If sCar = "'" Then
+      GoSub READ_STRING
+    Else If sCar = ">" Then
+      AnalyzeMarkup(Mid$($sText, iStart, $iPos - iStart + 1))
+      If $bOpen Then Inc $iLevel
+      Return
+    Else If Not sCar Then 
+      Return True
+    Endif
+    
+  Loop
+  
+READ_STRING:
+
+  sEnd = sCar
+  Do
+    GoSub READ_CHAR
+    If Not sCar Then Return True
+    If sCar = sEnd Then Return
+  Loop
+  
+READ_CHAR:
+
+  Inc $iPos
+  If $iPos <= Len($sText) Then 
+    sCar = Mid$($sText, $iPos, 1)
+  Else 
+    sCar = ""
+  Endif
+  Return
+  
+End
+
+Private Sub AnalyzeMarkup(sMarkup As String)
+
+  Dim iPos As Integer
+  Dim sCar As String
+  Dim sEnd As String
+  Dim sAttr As String
+  Dim iPosAttr As Integer
+  Dim sValue As String
+  Dim iStart As Integer
+  
+  $cAttr = New Collection
+
+  sMarkup = Mid$(sMarkup, 2, -1)
+
+  If sMarkup Begins "!DOCTYPE" Then
+    Return
+  Endif
+  
+  If sMarkup Begins "/" Then
+    sMarkup = Mid$(sMarkup, 2)
+    $bClose = True
+  Else 
+    $bOpen = True
+    If sMarkup Ends "/" Then 
+      sMarkup = Left(sMarkup, -1)
+      $bClose = True
+    Endif
+  Endif 
+  
+  iPos = InStr(sMarkup, " ")
+  If iPos = 0 Then
+    $sNode = sMarkup
+    Return 
+  Endif
+  
+  $sNode = Left(sMarkup, iPos - 1)
+  sMarkup = Mid(sMarkup, iPos + 1)
+  
+  iPos = 0
+  iStart = 1
+  
+  Do
+    
+    GoSub READ_CHAR
+    
+    If sCar = "\"" Or If sCar = "'" Then 
+      GoSub READ_STRING
+    Else If sCar = " " Or If Not sCar Then 
+      sAttr = Mid$(sMarkup, iStart, iPos - iStart)
+      If sAttr Then
+        iPosAttr = InStr(sAttr, "=")
+        If iPosAttr > 1 Then 
+          sValue = Mid$(sAttr, iPosAttr + 1)
+          If sValue Begins "\"" And If sValue Ends "\"" Then
+            sValue = Mid$(sValue, 2, -1)
+          Else If sValue Begins "'" And If sValue Ends "'" Then
+            sValue = Mid$(sValue, 2, -1)
+          Endif
+          $cAttr[Left(sAttr, iPosAttr - 1)] = sValue
+        Else
+          If sAttr Ends "=" Then sAttr = Left(sAttr, -1)
+          $cAttr[sAttr] = ""
+        Endif
+      Endif
+      iStart = iPos + 1
+      If Not sCar Then Break
+    Endif
+    
+  Loop
+  
+  Return
+
+READ_STRING:
+
+  sEnd = sCar
+  Do
+    GoSub READ_CHAR
+    If sCar = sEnd Or If Not sCar Then Return
+  Loop
+  
+READ_CHAR:
+
+  Inc iPos
+  If iPos <= Len(sMarkup) Then
+    sCar = Mid$(sMarkup, iPos, 1)
+  Else 
+    sCar = ""
+  Endif
+  Return
+  
+End
+
+Public Sub HasAttribute(sName As String) As Boolean
+  
+  Return $cAttr.Exist(sName)
+  
+End
+
+Public Sub GetAttribute(sName As String) As String
+
+  Dim vVal As Variant
+  
+  vVal = $cAttr[sName]
+  If TypeOf(vVal) = gb.Boolean Then Return
+  Return vVal
+  
+End

gb.dbus/src/gb.dbus/.src/DBus.class

@@ -21,25 +21,18 @@ Static Private $hSession As DBusConnection
 Static Public Sub _get((Application) As String) As DBusApplication
   
   Dim hConn As DBusConnection
-  Dim hApp As DBusApplication
-  Dim sKey As String
   
   If Application Like "system://*" Then
-    sKey = Application
     Application = Mid$(Application, 10)
     hConn = DBus.System
   Else If Application Like "session://*" Then
-    sKey = Application
     Application = Mid$(Application, 11)
     hConn = DBus.Session
   Else
-    sKey = "session://" & Application
     hConn = DBus.Session
   Endif
   
-  hApp = _ApplicationCache[sKey]
+  Return hConn[Application]
-  If Not hApp Then hApp = New DBusApplication(hConn, Application)
-  Return hApp
   
 End
 

gb.dbus/src/gb.dbus/.src/DBusConnection.class

@@ -37,3 +37,22 @@ Public Sub Close()
   
 End
 
+Public Sub _get((Application) As String) As DBusApplication
+  
+  Dim hApp As DBusApplication
+  Dim sKey As String
+  
+  If Me = DBus.System Then
+    sKey = "system://" & Application
+  Else If Me = DBus.Session Then
+    sKey = "session://" & Application
+  Else 
+    sKey = "unknown://" & Application
+  Endif
+  
+  hApp = DBus._ApplicationCache[sKey]
+  If Not hApp Then hApp = New DBusApplication(Me, Application)
+  Return hApp
+  
+End
+

gb.dbus/src/gb.dbus/.src/DBusProxy.class

@@ -259,46 +259,11 @@ End
 
 Private Function Children_Read() As String[]
 
-  Dim sIntr As String
-  Dim aChildren As New String[]
-  Dim iPos, iPos2, iLevel As Integer
-  Dim sNode, sChild As String
   Dim hApp As DBusApplication
   
   hApp = DBus._ApplicationCache[$hAppIndex]
-  sIntr = hApp._Introspect($sObjectPath)
+  $sIntrospection = hApp._Introspect($sObjectPath)
-  
+  Return _GetSymbols("node")
-  Do
-    iPos2 = iPos
-    iPos = InStr(sIntr, "<node", iPos + 1)
-    If iPos = 0 Then iPos = Len(sIntr) + 1
-    iPos2 = InStr(sIntr, "</node>", iPos2 + 1)
-    If iPos2 = 0 Then iPos2 = Len(sIntr) + 1
-    
-    If iPos > Len(sIntr) And If iPos2 > Len(sIntr) Then Return aChildren
-    
-    If iPos < iPos2 Then
-    
-      Inc iLevel
-      If iLevel <> 2 Then Continue
-    
-      iPos2 = InStr(sIntr, ">", iPos + 1)
-      If iPos2 = 0 Then Continue
-      
-      sNode = Mid$(sIntr, iPos, iPos2 - iPos + 1)
-      Try sChild = Scan(sNode, "*name=\"*\"*")[1]
-      If sChild Then aChildren.Add(sChild)
-      
-      If Right(sNode, 2) = "/>" Then Dec iLevel
-    
-    Else
-    
-      iPos = iPos2
-      Dec iLevel
-    
-    Endif
-    
-  Loop
 
 End
 
@@ -307,3 +272,28 @@ Private Function _Introspection_Read() As String
   Return $sIntrospection
 
 End
+
+Public Sub _GetSymbols(Optional Which As String) As String[]
+
+  Dim hIntr As CIntrospection
+  Dim aSym As New String[]
+  Dim sName As String
+
+  hIntr = New CIntrospection($sIntrospection)
+  
+  While Not hIntr.MoveNext()
+    
+    If Not hIntr.Open Then Continue
+    If hIntr.Level <> 2 Then Continue
+    If Which And If hIntr.Node <> Which Then Continue
+    
+    sName = hIntr.GetAttribute("name")
+    If Not sName Then Continue
+    If Not Which Then sName = Left(hIntr.Node) & ":" & sName
+    aSym.Add(sName)
+    
+  Wend
+  
+  Return aSym
+
+End

gb.dbus/src/gb.dbus/.src/MMain.module

@@ -157,12 +157,14 @@ Public Sub Main()
 
  Dim cManaged As Collection
  
- Try Print DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2", "org.freedesktop.DBus.Introspectable"].Introspect()
+ 'Try Print DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2", "org.freedesktop.DBus.Introspectable"].Introspect()
  
- Try cManaged = DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2", "org.freedesktop.DBus.ObjectManager"].GetManagedObjects()
+ 'Try cManaged = DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2", "org.freedesktop.DBus.ObjectManager"].GetManagedObjects()
  
- If Error Then
+ Print DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2/drives/ST1000LM024_HN_M101MBB_S2ZUJ9BCB04136", "org.freedesktop.UDisks2.Drive"]._GetSymbols().Join("\n")
-    Print Error.Text
+ 
- Endif
+ 'Print DBus["system://org.freedesktop.UDisks2"]["/org/freedesktop/UDisks2/drives"]._GetSymbols("node").Join("\n")
+ 
+ 'Print DBus.System._Name
  
 End