diff options
| -rw-r--r-- | ebus-racket/db-pq.rkt | 92 | ||||
| -rw-r--r-- | ebus-racket/doc/database-schema.sql | 18 | ||||
| -rw-r--r-- | ebus-racket/doc/sample_dump_1_1min.bin | bin | 0 -> 1300 bytes | |||
| -rwxr-xr-x | ebus-racket/dumper.rkt | 4 | ||||
| -rw-r--r-- | ebus-racket/ebus/db.rkt (renamed from ebus-racket/db.rkt) | 71 | ||||
| -rw-r--r-- | ebus-racket/ebus/layer2.rkt (renamed from ebus-racket/layer2.rkt) | 0 | ||||
| -rw-r--r-- | ebus-racket/ebus/layer7.rkt (renamed from ebus-racket/layer7.rkt) | 26 | ||||
| -rwxr-xr-x | ebus-racket/inserter-pq.rkt | 121 | ||||
| -rwxr-xr-x | ebus-racket/inserter.rkt | 20 | ||||
| -rw-r--r-- | ebus-racket/tests/layer2-test.rkt (renamed from ebus-racket/layer2-test.rkt) | 4 | ||||
| -rw-r--r-- | ebus-racket/tests/layer7-test.rkt (renamed from ebus-racket/layer7-test.rkt) | 6 | ||||
| -rw-r--r-- | ebus-racket/util/tcp-repl.rkt (renamed from ebus-racket/tcp-repl.rkt) | 0 |
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 Binary files differnew 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 |