racket: aufgraeumt, data2c gefixt

12 files changed, 85 insertions, 277 deletions

diff --git a/ebus-racket/db-pq.rkt b/ebus-racket/db-pq.rkt
deleted file mode 100644
index 3b15a73..0000000
--- a/ebus-racket/db-pq.rkt
+++ /dev/null
@@ -1,92 +0,0 @@
-#lang racket/base
-;; Database Access with synx/libpq ffi bindings
-(require racket/class)
-(require (prefix-in pq: (planet synx/libpq:1:3)))
-
-(define logger (make-logger 'ebus-db (current-logger)))
-
-(define con-user? (make-parameter "ebus"))
-(define con-password? (make-parameter "ebus"))
-(define con-database? (make-parameter "ebus"))
-(define con-server? (make-parameter "localhost"))
-
-(define _con (void))
-(define (con)
-	(when (void? _con)
-	     (log-message logger 'info (format "Connect using libpq to Database: user=~a database=~a server=~a" 
-					       (con-user?) (con-database?) (con-server?)) #t)
-		(set! _con
-			(pq:connect #:host (con-server?)
-                               #:user (con-user?)
-                               #:password (con-password?)
-                               #:dbname (con-database?))))
-	_con)
-
-(define (query-matrix stmt)
-	(con)
-	(send _con exec stmt))
-
-;; Test Database Connection
-;; Returns #t on success, #f otherwise
-(define (pgc-test)
-  (with-handlers ([exn:fail? (lambda (exn) (display exn)(display "\n") #f)])
-    (query-matrix "SELECT 123")
-    #t))
-
-;; Query ID of sensor given by sensor-name
-;; return void 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))])
-    (let* (
-	[result (send (con) exec sql-stmt sensor-name)]
-	[matrix (send result get-matrix)])
-	(caar matrix))))
-
-;; Create Sensor-ID with given name
-;; returns id
-(define (create-sensor-id sensor-name)
-  (log-message logger 'info (format "create sensor id for ~a" sensor-name) #t)
-  (define sql-stmt "INSERT INTO sensor(name) VALUES ($1)")
-  (send (con) exec sql-stmt 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 (insert-field sensor-name datatype offset value)
-  (cond ((member datatype (list "data1c" "data2b" "data2c"))
-  	 (insert sensor-name "float" (real->double-flonum value)))
-  	((member datatype (list "bit" "byte" "data1b" "word" "bcd"))
-  	 (insert sensor-name "int" value))
-  	((member datatype (list "byteEnum"))
-  	 (insert sensor-name "string" value))
-  	(else 
-         (log-message logger 'error (format "Datatype ~a is not support by DB" datatype) #t))))
-
-(define (insert sensor-name type value)
-  (define sensor-id (get-or-create-sensor-id sensor-name))
-  (log-message logger 'info (string-append (format "sensor-id=~a type=~a value=~a"
-					    sensor-id type value)) #t)
-  (cond ((string=? type "string")
-	 (send (con) p-exec "INSERT INTO value (timestamp, sensor_id, type, value_string) VALUES (now(), $1, 'string', $2)" sensor-id value))
-        ((string=? type "float")
-	 (send (con) p-exec "INSERT INTO value (timestamp, sensor_id, type, value_float) VALUES (now(), $1, 'float', $2)" sensor-id value))
-        ((string=? type "int")
-	 (send (con) p-exec "INSERT INTO value (timestamp, sensor_id, type, value_int) VALUES (now(), $1, 'int', $2::integer)" sensor-id value))))
-
-(provide
- (prefix-out db- logger)
- (prefix-out db- con-user?)
- (prefix-out db- con-password?)
- (prefix-out db- con-database?)
- (prefix-out db- con-server?)
- (prefix-out db- pgc-test)
- (prefix-out db- insert-field))
diff --git a/ebus-racket/doc/database-schema.sql b/ebus-racket/doc/database-schema.sql
new file mode 100644
index 0000000..281659c
--- /dev/null
+++ b/ebus-racket/doc/database-schema.sql
@@ -0,0 +1,18 @@
+CREATE TABLE sensor (
+        id INTEGER PRIMARY KEY AUTOINCREMENT,
+        name TEXT,
+        description TEXT
+);
+CREATE TABLE value (
+        id INTEGER PRIMARY KEY AUTOINCREMENT,
+        "timestamp" timestamp without time zone,
+        sensor_id integer,
+        type TEXT,
+        value_float real,
+        value_int integer,
+        value_string TEXT,
+        FOREIGN KEY(sensor_id) REFERENCES sensor(id)
+);
+CREATE INDEX sensor_idx_001 on sensor(id);
+CREATE INDEX sensor_idx_002 on sensor(name);
+CREATE INDEX value_idx_001 on value(sensor_id, timestamp);
diff --git a/ebus-racket/doc/sample_dump_1_1min.bin b/ebus-racket/doc/sample_dump_1_1min.bin
new file mode 100644
index 0000000..f0ec73e
--- /dev/null
+++ b/ebus-racket/doc/sample_dump_1_1min.bin
diff --git a/ebus-racket/dumper.rkt b/ebus-racket/dumper.rkt
index cc31a16..bc60590 100755
--- a/ebus-racket/dumper.rkt
+++ b/ebus-racket/dumper.rkt
@@ -3,8 +3,8 @@
 (require racket/cmdline
          racket/tcp
 	 racket/pretty
-         "layer2.rkt"
-	 "layer7.rkt")
+         "ebus/layer2.rkt"
+	 "ebus/layer7.rkt")
 
 ;(define verbose? (make-parameter #f))
 (define connect-host? (make-parameter null))
diff --git a/ebus-racket/db.rkt b/ebus-racket/ebus/db.rkt
index 081cca7..2c6be6c 100644
--- a/ebus-racket/db.rkt
+++ b/ebus-racket/ebus/db.rkt
@@ -1,44 +1,48 @@
 #lang racket/base
-;; Database Acess with ryanc/db
-;;   leaks memory somewhere in db.plt
-(require (prefix-in db: (planet ryanc/db:1:5)))
-(require (prefix-in db: (planet ryanc/db:1:5/util/connect)))
+(require racket/path)
+(require (prefix-in db: db))
 
-(define logger (make-logger 'ebus-db (current-logger)))
+(define db-logger (make-logger 'ebus-db (current-logger)))
 
-(define con-user? (make-parameter "ebus"))
-(define con-password? (make-parameter "ebus"))
-(define con-database? (make-parameter "ebus"))
-(define con-server? (make-parameter "localhost"))
+(define db-file? (make-parameter 
+                   (build-path (path-only (find-system-path 'run-file)) "database.sqlite3")))
 
-(define pgc
+(define pool
   (db:virtual-connection
-   (lambda ()
-     (log-message logger 'info (format "Connect to Database: user=~a database=~a server=~a" 
-				       (con-user?) (con-database?) (con-server?)) #t)
-     (db:postgresql-connect #:user (con-user?)
-			    #:database (con-database?)
-			    #:password (con-password?)
-			    #:server (con-server?)))))
+    (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 (pgc-test)
-  (with-handlers ([exn:fail? (lambda (exn) #f)])
-    (= (db:query-value pgc "SELECT 1") 1)))
+(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 pgc sql-stmt sensor-name)))
+    (db:query-value pool sql-stmt sensor-name)))
 
 ;; Create Sensor-ID with given name
 ;; returns id
 (define (create-sensor-id sensor-name)
-  (log-message logger 'info (format "create sensor id for ~a" sensor-name) #t)
-  (db:query-exec pgc "INSERT INTO sensor(name) VALUES ($1)" 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
@@ -51,7 +55,7 @@
 ;; Insert Field in Database
 ;; Decide Database-Datatype from Ebus-Datatype
 ;; then calls 'insert`
-(define (insert-field sensor-name datatype offset value)
+(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))
@@ -61,7 +65,7 @@
   	((member datatype (list "byteEnum"))
   	 ;; string
   	 (insert sensor-name db:sql-null db:sql-null value))
-  	(else (log-message logger 'error (format "Datatype ~a is not support by DB" datatype) #t))))
+  	(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))
@@ -70,18 +74,15 @@
 		     ((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 (now(), $1, $2, $3, $4, $5)"))
-  (log-message logger 'info (string-append sql-stmt "\n\t\t"
+		   "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 pgc sql-stmt sensor-id type value-float value-int value-string))
+  (db:query-exec pool sql-stmt sensor-id type value-float value-int value-string))
 
 (provide
- (prefix-out db- logger)
- (prefix-out db- con-user?)
- (prefix-out db- con-password?)
- (prefix-out db- con-database?)
- (prefix-out db- con-server?)
- (prefix-out db- pgc-test)
- (prefix-out db- insert-field))
+ db-file?
+ db-logger
+ db-test
+ db-insert-field)
diff --git a/ebus-racket/layer2.rkt b/ebus-racket/ebus/layer2.rkt
index 3dd881c..3dd881c 100644
--- a/ebus-racket/layer2.rkt
+++ b/ebus-racket/ebus/layer2.rkt
diff --git a/ebus-racket/layer7.rkt b/ebus-racket/ebus/layer7.rkt
index b335ddc..3bcad01 100644
--- a/ebus-racket/layer7.rkt
+++ b/ebus-racket/ebus/layer7.rkt
@@ -100,7 +100,14 @@
 	    (/ (+ 256 (bitwise-not (+ lowByte 1))) 256.0)))
       (+ highByte (/ lowByte 256.0))))
 
-;; type data2c
+ ;; type data2c
+ ;;    Beispiel für die Berechnung:
+ ;;    if ((x & 8000h) == 8000h) // y negativ
+ ;;    y = - [dez(High_Byte(!x)) 16 + dez(High_Nibble (Low_Byte (!x)))
+ ;;    + (dez(Low_Nibble (Low_Byte (!x))) +1 ) / 16]
+ ;;    else                       // y positiv
+ ;;    y = dez(High_Byte(x)) 16 + dez(High_ Nibble (Low Byte (x)))
+ ;;    + dez(Low_ Nibble (Low Byte (x))) / 16
 (define (field-decoder-data2c lowByte highByte)
   (define (lowNibble v)
     (bitwise-and v #x0f))
@@ -110,14 +117,15 @@
     (+ 256 (bitwise-not v)))
   (if (= (bitwise-and highByte 128) 128)
       (* -1
-	 (/
 	  (+ (arithmetic-shift (u-not highByte) 4)
-	     (u-not (highNibble lowByte))
-	     (+ (u-not (lowNibble lowByte)) 1))
-	  16.0))
-      (+ (* 16 highByte)
-	 (arithmetic-shift lowByte -4)
-	 (/ (lowNibble lowByte) 16))))
+	     (highNibble (u-not lowByte))
+             (/ (+ (lowNibble (u-not lowByte)) 1)
+                16.0)))
+      (+ (arithmetic-shift highByte 4)
+         (highNibble lowByte)
+         (/
+           (lowNibble lowByte)
+           16))))
 
 ;; type byteEnum
 (define (field-decoder-byteEnum value field-definition)
@@ -155,4 +163,4 @@
          (prefix-out layer7- device-name)
 	 ;; read ebus from port an return fields from next paket
 	 (prefix-out layer7- read-ebus)
-	 (prefix-out layer7- logger))
\ No newline at end of file
+	 (prefix-out layer7- logger))
diff --git a/ebus-racket/inserter-pq.rkt b/ebus-racket/inserter-pq.rkt
deleted file mode 100755
index 8dc9fb8..0000000
--- a/ebus-racket/inserter-pq.rkt
+++ /dev/null
@@ -1,121 +0,0 @@
-#! /usr/bin/env racket
-#lang racket/base
-(require racket/cmdline
-         racket/tcp
-         racket/match
-         "db-pq.rkt"
-         "layer7.rkt"
-         "layer2.rkt"
-         "tcp-repl.rkt")
-
-(define logger (make-logger 'ebus-inserter (current-logger)))
-
-(define connect-host? (make-parameter null))
-(define connect-port? (make-parameter null))
-(define loglevel-layer2? (make-parameter 'info))
-(define loglevel-db? (make-parameter 'warning))
-(define insert? (make-parameter #f))
-
-(define (get-input-port)
-  (if (or (null? (connect-host?)) (null? (connect-port?)))
-    (begin
-      (log-message (current-logger) 'info "Using stdin" #t)
-      (current-input-port))
-    (let-values ([(cin cout) (tcp-connect (connect-host?) (connect-port?))])
-                (log-message logger 'info (format "Connected to ~s ~s" (connect-host?) (connect-port?)) #t)
-                cin)))
-
-(define (handle-fields fields)
-  (for ([field fields])
-       (log-message logger 'info (format "Field: ~a" field) #t)
-       (when (insert?)
-         (with-handlers ([exn:fail? (lambda (exn)
-                                      (log-message logger 'error (format "Failed to insert ~a: ~a" field exn) #t))])
-           (apply db-insert-field field)))))
-
-(define (read-ebus-loop7)
-  (define input-port (get-input-port))
-
-  (define (reconnect)
-    (log-message logger 'warning "Reconnect - sleep 5sec" #t)
-    (sleep 5)
-    (log-message logger 'warning "Reconnect - now" #t)
-    (set! input-port (get-input-port)))
-      
-  (let loop ()
-    (with-handlers ([exn:fail:read:eof? 
-                      (lambda (exn-eof)
-                        (log-message logger 'error (format "EOF read: ~a" exn) #t)
-                        (raise exn-eof))]; re-raise to prevent reconnect
-                    [exn:fail:network? 
-                      (lambda (exn-network)
-                        (log-message logger 'error (format "Network error: ~a" exn) #t)
-                        (reconnect))]
-                    [exn:fail? (lambda (exn)
-                                 (log-message logger 'error (format "Failed to parse paket: ~a" exn) #t))])
-      (let ([fields (layer7-read-ebus input-port)])
-        (when (eof-object? fields)
-          (raise
-            (make-exn:fail:read:eof "Read EOF from layer7" 
-                                    (current-continuation-marks)
-                                    (list))))
-        (when (not (or (void? fields) (eof-object? fields)))
-          (handle-fields fields))))
-    (loop)))
-
-;; Start Thread that observe all given log-receivers
-(define (start-logger-thread receiver1 . receiverN)
-  (define receivers (cons receiver1 receiverN))
-  (void 
-   (thread
-    (lambda ()
-      (let loop ()
-        (match (apply sync receivers)
-          [(vector level msg data)
-           (printf "[~s] ~a~n" level msg)
-           (flush-output)])
-        (loop))))))
-
-;; Marks Namespace where TCP-REPL starts
-(define-namespace-anchor repl-ns-anchor)
-
-(define (main)
-  ;; Parse commandline
-  (command-line
-   #:once-each
-   [("-c" "--connect") host port "Connect to server <host> <port>"
-    (connect-host? host)
-    (connect-port? (string->number port))]
-   ["--tcp-repl" port "Open REPL on TCP <port>"
-    (tcp-repl-run (namespace-anchor->namespace repl-ns-anchor) (string->number port))]
-   ["--debug-layer2" "Log level for Layer 2 Parser"
-    (loglevel-layer2? 'debug)]
-   ["--debug-db" "Log level for DB" 
-    (loglevel-db? 'debug)]
-   ["--insert" "Do Insert into Database"
-    (insert? #t)]
-   ["--db-user" user "Datanase User"
-    (db-con-user? user)]
-   ["--db-password" password "Database password"
-    (db-con-password? password)]
-   ["--db-database" database "Database database-name"
-    (db-con-database? database)]
-   ["--db-server" server  "Database Address/Server"
-    (db-con-server? server)])
-
-  ;; Init Logging
-  (start-logger-thread (make-log-receiver logger 'info)
-                       (make-log-receiver db-logger (loglevel-db?))
-                       (make-log-receiver layer2-logger (loglevel-layer2?))
-                       (make-log-receiver layer7-logger 'info)
-                       (make-log-receiver tcp-repl-logger 'info))
-
-  ;; Test Database Connection
-  (when (not (db-pgc-test))
-    (log-message logger 'fatal "Failed to connect to database" #t)
-    (exit 1))
-
-  ;; Process Ebus Packets
-  (read-ebus-loop7))
-
-(exit (main))
diff --git a/ebus-racket/inserter.rkt b/ebus-racket/inserter.rkt
index b07207d..657154f 100755
--- a/ebus-racket/inserter.rkt
+++ b/ebus-racket/inserter.rkt
@@ -3,10 +3,10 @@
 (require racket/cmdline
 	 racket/tcp
 	 racket/match
-	 "db.rkt"
-	 "layer7.rkt"
-	 "layer2.rkt"
-	 "tcp-repl.rkt")
+	 "ebus/db.rkt"
+	 "ebus/layer7.rkt"
+	 "ebus/layer2.rkt"
+	 "util/tcp-repl.rkt")
 
 (define logger (make-logger 'ebus-inserter (current-logger)))
 
@@ -66,14 +66,8 @@
     (loglevel-db? 'debug)]
    ["--insert" "Do Insert into Database"
     (insert? #t)]
-   ["--db-user" user "Datanase User"
-    (db-con-user? user)]
-   ["--db-password" password "Database password"
-    (db-con-password? password)]
-   ["--db-database" database "Database database-name"
-    (db-con-database? database)]
-   ["--db-server" server  "Database Address/Server"
-    (db-con-server? server)])
+   ["--db-file" user "Database file"
+    (db-file? user)])
 
   ;; Init Logging
   (start-logger-thread (make-log-receiver logger 'info)
@@ -83,7 +77,7 @@
 		       (make-log-receiver tcp-repl-logger 'info))
 
   ;; Test Database Connection
-  (when (not (db-pgc-test))
+  (when (not (db-test))
     (log-message logger 'fatal "Failed to connect to database" #t)
     (exit 1))
 
diff --git a/ebus-racket/layer2-test.rkt b/ebus-racket/tests/layer2-test.rkt
index 326725d..c329de1 100644
--- a/ebus-racket/layer2-test.rkt
+++ b/ebus-racket/tests/layer2-test.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 (require rackunit
          rackunit/text-ui
-         "layer2.rkt")
+         "../ebus/layer2.rkt")
 
 (define layer2-test
   (test-suite
@@ -68,4 +68,4 @@
    ))
       
 
-(exit (run-tests layer2-test))
\ No newline at end of file
+(exit (run-tests layer2-test))
diff --git a/ebus-racket/layer7-test.rkt b/ebus-racket/tests/layer7-test.rkt
index 2099bf8..68442d9 100644
--- a/ebus-racket/layer7-test.rkt
+++ b/ebus-racket/tests/layer7-test.rkt
@@ -1,8 +1,8 @@
 #lang racket/base
 (require rackunit
          rackunit/text-ui
-         "layer2.rkt"
-         "layer7.rkt")
+         "../ebus/layer2.rkt"
+         "../ebus/layer7.rkt")
 
 (define layer7-test
   (test-suite
@@ -43,4 +43,4 @@
    ))
 
 
-(exit (run-tests layer7-test))
\ No newline at end of file
+(exit (run-tests layer7-test))
diff --git a/ebus-racket/tcp-repl.rkt b/ebus-racket/util/tcp-repl.rkt
index 4b19d85..4b19d85 100644
--- a/ebus-racket/tcp-repl.rkt
+++ b/ebus-racket/util/tcp-repl.rkt