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
93
94
|
#lang racket/base
(require irc/core irc/bot irc/db irc/users
racket/list racket/function
racket/format racket/serialize
db sql)
(provide (all-defined-out))
(define (current-storage) (connection-storage (current-connection)))
(struct storage
(user volatile-user
channel volatile-channel
network volatile-network))
(define (storage-init)
(set-connection-storage!
(current-connection)
(storage (load-storage (select name data #:from users)) (make-hash)
(load-storage (select name data #:from channels)) (make-hash)
(load-storage (select name data #:from network)) (make-hash))))
; TODO !!! IRC downcasing of nicks
(define (user-storage user #:volatile? [volatile #f])
(hash-ref! ((if volatile storage-volatile-user storage-user)
(current-storage))
user (thunk (make-hash))))
(define (channel-storage channel #:volatile? [volatile #f])
(hash-ref! ((if volatile storage-volatile-channel storage-channel)
(current-storage)))
channel (thunk (make-hash)))
(define (network-storage name #:volatile? [volatile #f])
(hash-ref! ((if volatile storage-volatile-network storage-network)
(current-storage))
name (thunk (make-hash))))
(define (load-storage query)
(define storage (make-hash))
(for ([(name data) (in-query (current-database) query)])
(hash-set! storage name (deserialize (safe-read-string data))))
storage)
(define empty-serialized-hash
(~s (serialize (make-hash))))
(define (persist-user user)
(query-exec (current-database)
(insert #:into users
#:set [name ,user]
[power 0]
[data ,empty-serialized-hash]
#:or-ignore))
(query-exec (current-database)
(update users
#:set [data ,(~s (serialize (user-storage user)))]
#:where (= name ,user))))
(define (persist-channel channel)
(query-exec (current-database)
(insert #:into channels
#:set [name ,channel]
[autojoin 0]
[data ,empty-serialized-hash]
#:or-ignore))
(query-exec (current-database)
(update channels
#:set [data ,(~s (serialize (channel-storage channel)))]
#:where (= name ,channel))))
(define (persist-network name)
(query-exec (current-database)
(insert #:into network
#:set [name ,name]
[data ,empty-serialized-hash]
#:or-ignore))
(query-exec (current-database)
(update network
#:set [data ,(~s (serialize (network-storage name)))]
#:where (= name ,name))))
(define (ref h . path)
(foldl (λ (p h) (hash-ref h p)) h path))
(define (ref-set! h value . path)
(if (pair? (cdr path))
(apply ref-set!
(hash-ref! h (car path) (thunk (make-hash)))
value (cdr path))
(hash-set! h (car path) value)))
|