1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
#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))
|
