X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=lsp-dbus-test.lsp;h=af8af95a0e18c86cb7d6558026c52811d31d129e;hb=74d2ded4c4e98675f80e33f2f18e07eca1ea1470;hp=0c13db4e87eb685185eb8f019fefbdbee2ffcfad;hpb=b803427b65b26ec297322de115e8dcbae55b033e;p=rrq%2Flsp-utils.git

diff --git a/lsp-dbus-test.lsp b/lsp-dbus-test.lsp
index 0c13db4..af8af95 100644
--- a/lsp-dbus-test.lsp
+++ b/lsp-dbus-test.lsp
@@ -1,39 +1,51 @@
-#!/usr/bin/newlisp
-
 ;; This is a test program for the lsp-dbus provided dbus API.
 
-(load "misc.lsp")
 (load "lsp-dbus.lsp")
+;; Loading that module sets up core framework API and connects to
+;; dbus' system bus registering this application. This includes
+;; Dbus:ROOT for the "/org/freedektop/DBus" path, and Dbus:DBus for
+;; the interrface "org.freedektop.DBus".
+
+;; Register a handler for the NameAcquired signal, to replace the one
+;; installed by lsp-dbus.lsp
+
+;; Request a bus name "au.rrq" for this client
+(println "RequestName: "
+         (if (:invoke Dbus:ROOT (:m ObjectManager "RequestName(su)")
+                      '("au.rrq" 0))
+             (!= ($it -1 -1 -1)) ; returns BOOLEAN
+           ))
+
+;; Set up a Match rule to see stuff
+(setf MATCH-RULE
+      (join (list "type='signal'"
+                  ;;"sender='org.example.App2'"
+                  ;;"path_namespace='/au/rrq'"
+                  ;;"eavesdrop='true'"
+                  )
+            ","))
+(println "AddMatch:\n" MATCH-RULE "\n"
+         (if (:invoke Dbus:ROOT (:m Dbus:DBus "AddMatch(s)")
+                      (list MATCH-RULE))
+             ($it -1 -1 -1) ; returns OOM on error
+           ))
+
+(reset)
+
+
+(println (if (:invoke Dbus:ROOT
+                      (print "GetNameOwner(s)")
+                      (println (list "org.bluez")))
+             ($it -1 -1 -1) ; Return value
+           ))
+(Dbus:process-all-pending)
+
+(println (setf org.bluez (Dbus "/" "org.bluez")))
+(println (if (:invoke org.bluez (:m ObjectManager "GetManagedObjects()"))
+             ($it -1 -1 -1) ; Return value
+           ))
+
 
-; Log system bus details
-(println Dbus:SYSTEM-BUS)
-(println (setf ME (Dbus "/au/rrq")))
-(println (setf ROOT (Dbus "/org/freedesktop/DBus")))
-
-(define (unpack-messages DATA)
-  (let ((AT 0) (OUT '()) (M nil) (D nil))
-    (while (and (< AT (length DATA))
-                (setf M (Dbus:unpack-data "yyyyuua(yv)" DATA AT)))
-      ;;(println M)
-      (dotimes (i (length (M 0 -1)))
-        (setf (M 0 -1 i 0) (Dbus:MESSAGE-HEADERS (M 0 -1 i 0) 0)))
-      (println M)
-      (setf AT (M 1))
-      (setf S ((lookup 'Dbus:SIGNATURE (M 0 -1)) 0))
-      (println "AT=" AT " " (unpack (dup "b" 20) (AT DATA)))
-      (if (and (< AT (length DATA)) (!= s ""))
-          (when (setf D (Dbus:unpack-data S DATA AT))
-            (println D)
-            (setf AT (D 1))
-            (push (list M (D 0)) OUT -1))
-        (push (list M nil) OUT -1))
-      (setf DATA (AT DATA))
-      (setf AT 0)
-      ;;(println (octals-string (AT DATA)))
-      )
-    OUT ))
-
-(setf M (:invoke ROOT "Hello" "org.freedesktop.DBus"))
-(println (unpack-messages M))
+(reset) ; 
 
 "lsp-dbus-test.lsp"