racket update to http database server.

3 files changed, 10 insertions, 101 deletions

diff --git a/ebus-racket/ebus/db.rkt b/ebus-racket/ebus/db.rkt
deleted file mode 100644
index 2c6be6c..0000000
--- a/ebus-racket/ebus/db.rkt
+++ /dev/null
@@ -1,88 +0,0 @@
-#lang racket/base
-(require racket/path)
-(require (prefix-in db: db))
-
-(define db-logger (make-logger 'ebus-db (current-logger)))
-
-(define db-file? (make-parameter 
-                   (build-path (path-only (find-system-path 'run-file)) "database.sqlite3")))
-
-(define pool
-  (db:virtual-connection
-    (db:connection-pool
-      (lambda () 
-        (log-message db-logger 'info (format "Open database file ~a" (db-file?)) #t)
-        (with-handlers ([exn:fail? (lambda (exn)
-                                     (log-message db-logger 'error (format "Error opening database ~a" (db-file?)) #t) (raise exn))])
-                       (db:postgresql-connect #:user "ebus"
-			    #:database "ebus"
-			    #:password "ebus"
-			    #:server "localhost")))
- ;;                      (db:sqlite3-connect #:database (db-file?))))
- ;;
-      #:max-connections 5
-      #:max-idle-connections 2
-      )))
-
-
-;; Test Database Connection
-;; Returns #t on success, #f otherwise
-(define (db-test)
-  (with-handlers ([exn:fail? (lambda (exn) (log-message db-logger 'error (format "Error: ~a" exn) #t) #f)])
-    (= (db:query-value pool "SELECT 1") 1)))
-
-;; Query ID of sensor given by sensor-name
-;; Returns null if sensor is undefined
-(define (get-sensor-id sensor-name)
-  (define sql-stmt "SELECT id FROM sensor WHERE name = $1")
-  (with-handlers ([exn:fail?  (lambda (exn) (void))])
-    (db:query-value pool sql-stmt sensor-name)))
-
-;; Create Sensor-ID with given name
-;; returns id
-(define (create-sensor-id sensor-name)
-  (log-message db-logger 'info (format "create sensor id for ~a" sensor-name) #t)
-  (db:query-exec pool "INSERT INTO sensor(name) VALUES ($1)" sensor-name)
-  (get-sensor-id sensor-name))
-
-;; Get ID of sensor given by sensor-name
-;; define sensor if needed
-(define (get-or-create-sensor-id sensor-name)
-  (define id (get-sensor-id sensor-name))
-  (cond ((void? id) (create-sensor-id sensor-name))
-	(else id)))
-
-;; Insert Field in Database
-;; Decide Database-Datatype from Ebus-Datatype
-;; then calls 'insert`
-(define (db-insert-field sensor-name datatype offset value)
-  (cond ((member datatype (list "data1c" "data2b" "data2c"))
-  	 ;; float
-  	 (insert sensor-name value db:sql-null db:sql-null))
-  	((member datatype (list "bit" "byte" "data1b" "word" "bcd"))
-  	 ;; int
-  	 (insert sensor-name db:sql-null value db:sql-null))
-  	((member datatype (list "byteEnum"))
-  	 ;; string
-  	 (insert sensor-name db:sql-null db:sql-null value))
-  	(else (log-message db-logger 'error (format "Datatype ~a is not support by DB" datatype) #t))))
-
-(define (insert sensor-name value-float value-int value-string)
-  (define sensor-id (get-or-create-sensor-id sensor-name))
-  (define type (cond ((not (db:sql-null? value-string)) "string")
-		     ((not (db:sql-null? value-float)) "float")
-		     ((not (db:sql-null? value-int)) "int")))
-  (define sql-stmt 
-    (string-append "INSERT INTO value(timestamp, sensor_id, type, value_float, value_int, value_string) "
-		   "VALUES (CURRENT_TIMESTAMP, $1, $2, $3, $4, $5)"))
-  (log-message db-logger 'info (string-append sql-stmt "\n\t\t"
-					   (format
-					    "sensor-id=~a type=~a value-float=~a value-int=~a value-string=~a"
-					    sensor-id type value-float value-int value-string)) #t)
-  (db:query-exec pool sql-stmt sensor-id type value-float value-int value-string))
-
-(provide
- db-file?
- db-logger
- db-test
- db-insert-field)
diff --git a/ebus-racket/ebus/layer2.rkt b/ebus-racket/ebus/layer2.rkt
index 3dd881c..3309c16 100644
--- a/ebus-racket/ebus/layer2.rkt
+++ b/ebus-racket/ebus/layer2.rkt
@@ -91,7 +91,7 @@
 	(else
 	 ;; skip one byte
 	 (let ([byte (read-byte input-port)])
-	   (log-message logger 'debug (format "drop ~s 0x~x ~n" byte byte) #t))
+	   (log-message logger 'debug (format "drop ~s 0x~x" byte byte) #t))
 	 (read-ebus input-port))))
 
 (provide 
@@ -101,4 +101,4 @@
  (prefix-out layer2- (struct-out ebus-body-broadcast))
  (prefix-out layer2- (struct-out ebus-body-mastermaster))
  (prefix-out layer2- (struct-out ebus-body-masterslave))
- (prefix-out layer2- logger))
\ No newline at end of file
+ (prefix-out layer2- logger))
diff --git a/ebus-racket/ebus/layer7.rkt b/ebus-racket/ebus/layer7.rkt
index 3bcad01..cb9da0b 100644
--- a/ebus-racket/ebus/layer7.rkt
+++ b/ebus-racket/ebus/layer7.rkt
@@ -1,7 +1,5 @@
 #lang racket/base
-(require racket/list
-         (planet lizorkin/sxml:2:1/sxml)
-         (planet lizorkin/ssax:2:0/ssax)
+(require (planet clements/sxml2:1:=3)
          "layer2.rkt")
 
 (define logger (make-logger 'ebus-layer7 (current-logger)))
@@ -24,8 +22,7 @@
 
 ;; returns device-name in a list or empty-list
 (define (device-name address)
-  (first ((sxpath "@name/text()") (device address))))
-
+  (car ((sxpath "@name/text()") (device address))))
 
 (define (paket-fields ebus-paket)
   (define paket-definition (paket ebus-paket))
@@ -34,7 +31,7 @@
 	     ([paket-name (string-append 
 			   (device-name (layer2-ebus-paket-source ebus-paket))
 			   "." 
-			   (first ((sxpath "@name/text()") paket-definition)))]
+			   (car ((sxpath "@name/text()") paket-definition)))]
 	      [fields ((sxpath "fields/*") paket-definition)]
 	      [values 
 	       (for/list ([field fields]) (paket-fields-dispatch-decoder ebus-paket field paket-name))])
@@ -45,8 +42,8 @@
 
 (define (paket-fields-dispatch-decoder ebus-paket field paket-name)
   (define datatype ((sxpath "name()") field))
-  (define name (string-append paket-name "." (first ((sxpath "@name/text()") field))))
-  (define offset (string->number (first ((sxpath "@offset/text()") field))))
+  (define name (string-append paket-name "." (car ((sxpath "@name/text()") field))))
+  (define offset (string->number (car ((sxpath "@offset/text()") field))))
   (define payload (layer2-ebus-paket-payload ebus-paket))
   (cond ((string=? "bit" datatype)
 	 (list name datatype offset
@@ -132,11 +129,11 @@
   (define (pred l)
     (= value (list-ref l 0)))
   (define all-options (for/list ([option ((sxpath "option") field-definition)])
-				(list (string->number (first ((sxpath "@value/text()") option))) ;; value, name
-				      (first ((sxpath "@name/text()") option)))))
+				(list (string->number (car ((sxpath "@value/text()") option))) ;; value, name
+				      (car ((sxpath "@name/text()") option)))))
   (define options (filter pred all-options))
   (cond ((= (length options) 1)
-	 (list-ref (first options) 1))
+	 (list-ref (car options) 1))
 	(else "<undefined>")))
 
 ;; type word