diff options
Diffstat (limited to 'ebus-racket/db.rkt')
-rw-r--r-- | ebus-racket/db.rkt | 79 |
1 files changed, 62 insertions, 17 deletions
diff --git a/ebus-racket/db.rkt b/ebus-racket/db.rkt index 9ebdfa9..54de8f7 100644 --- a/ebus-racket/db.rkt +++ b/ebus-racket/db.rkt @@ -1,40 +1,85 @@ #lang racket/base (require (prefix-in db: (planet ryanc/db:1:5))) +(require (prefix-in db: (planet ryanc/db:1:5/util/connect))) + +(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 pgc - (db:postgresql-connect #:user "ebus" - #:database "ebus" - #:password "ebus" - #:server "10.2.2.26")) + (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?))))) + +;; 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))) ;; 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 "SELECT id FROM sensor WHERE name = $1" sensor-name))) + (db:query-value pgc sql-stmt sensor-name))) ;; Create Sensor-ID with given name ;; returns id (define (create-sensor-id sensor-name) - (db:query-exec "INSERT INTO sensor(name) VALUES ($1)" 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) (get-sensor-id sensor-name)) ;; Get ID of sensor given by sensor-name ;; define sensor if needed -(define (sensor-id sensor-name) +(define (get-or-create-sensor-id sensor-name) (define id (get-sensor-id sensor-name)) - (cond ((void? id) (create-sensor-id sensor-id)) + (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")) + ;; 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 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 (sensor-id sensor-name)) - (define type (cond ((not (void? value-string)) "string") - ((not (void? value-float)) "float") - ((not (void? value-int)) "int"))) - (db:query-exec (string-append "INSERT INTO value(timestamp, sensor_id, type, value_float, value_int, value_string) " - "VALUES (now(), $1, $2, $3, $4, $5)") - sensor-id type 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 (now(), $1, $2, $3, $4, $5)")) + (log-message 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 sql-stmt sensor-id type value-float value-int value-string)) (provide - (prefix-out db- insert)) - + (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)) |