blob: 081cca73a659840d2a0d8800153016793086554a (
plain)
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
|
#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)))
(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: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 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)
(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"))
;; 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 (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 pgc 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))
|
