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
|
val TEXT NOT NULL,
CONSTRAINT envvars_constraint UNIQUE (context,var))"))))
(set-busy-handler! db (busy-timeout 10000))
db))
;; save vars in given context, this is NOT incremental by default
;;
(define (env:save-env-vars db context #!key (incremental #f))
(with-transaction
db
(lambda ()
;; first clear out any vars for this context
(if (not incremental)(exec (sql db "DELETE FROM envvars WHERE context=?") context))
(for-each
(lambda (varval)
(let ((var (car varval))
(val (cdr varval)))
(if incremental (exec (sql db "DELETE FROM envvars WHERE context=? AND var=?") context var))
(exec (sql db "INSERT INTO envvars (context,var,val) VALUES (?,?,?)") context var val)))
(get-environment-variables)))))
;; merge contexts in the order given
;; - each context is applied in the given order
;; - variables in the paths list are split on the separator and the components
;; merged using simple delta addition
;; returns a hash of the merged vars
;;
|
|
>
>
|
|
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
|
val TEXT NOT NULL,
CONSTRAINT envvars_constraint UNIQUE (context,var))"))))
(set-busy-handler! db (busy-timeout 10000))
db))
;; save vars in given context, this is NOT incremental by default
;;
(define (env:save-env-vars db context #!key (incremental #f)(vardat #f))
(with-transaction
db
(lambda ()
;; first clear out any vars for this context
(if (not incremental)(exec (sql db "DELETE FROM envvars WHERE context=?") context))
(for-each
(lambda (varval)
(let ((var (car varval))
(val (cdr varval)))
(if incremental (exec (sql db "DELETE FROM envvars WHERE context=? AND var=?") context var))
(exec (sql db "INSERT INTO envvars (context,var,val) VALUES (?,?,?)") context var val)))
(if vardat
(hash-table->alist vardat)
(get-environment-variables))))))
;; merge contexts in the order given
;; - each context is applied in the given order
;; - variables in the paths list are split on the separator and the components
;; merged using simple delta addition
;; returns a hash of the merged vars
;;
|
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
(define (env:get-removed db contexta contextb)
(let ((result (make-hash-table)))
(query
(for-each-row
(lambda (row)
(let ((var (car row))
(val (cadr row)))
(hash-table-set! result var valb))))
(sql db "SELECT var,val FROM envvars WHERE context=? AND var NOT IN (SELECT var FROM envvars WHERE context=?)")
contexta contextb)
result))
;; get list of variables added to contextb from contexta
;;
(define (env:get-added db contexta contextb)
(let ((result (make-hash-table)))
(query
(for-each-row
(lambda (row)
(let ((var (car row))
(val (cadr row)))
(hash-table-set! result var valb))))
(sql db "SELECT var,val FROM envvars WHERE context=? AND var NOT IN (SELECT var FROM envvars WHERE context=?)")
contextb contexta)
result))
;; get list of variables in both contexta and contexb that have been changed
;;
(define (env:get-changed db contexta contextb)
(let ((result (make-hash-table)))
(query
(for-each-row
(lambda (row)
(let ((var (car row))
(val (cadr row)))
(hash-table-set! result var val))))
(sql db "SELECT var,val FROM envvars WHERE context=? AND val != (SELECT val FROM envvars WHERE var=? AND context=?)")
contexta contextb))
result)
;;
(define (env:blind-merge l1 l2)
(if (null? l1) l2
(if (null? l2) l1
(cons (car l1) (cons (car l2) (env:blind-merge (cdr l1) (cdr l2)))))))
|
|
|
|
|
|
|
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
(define (env:get-removed db contexta contextb)
(let ((result (make-hash-table)))
(query
(for-each-row
(lambda (row)
(let ((var (car row))
(val (cadr row)))
(hash-table-set! result var val))))
(sql db "SELECT var,val FROM envvars WHERE context=? AND var NOT IN (SELECT var FROM envvars WHERE context=?)")
contexta contextb)
result))
;; get list of variables added to contextb from contexta
;;
(define (env:get-added db contexta contextb)
(let ((result (make-hash-table)))
(query
(for-each-row
(lambda (row)
(let ((var (car row))
(val (cadr row)))
(hash-table-set! result var val))))
(sql db "SELECT var,val FROM envvars WHERE context=? AND var NOT IN (SELECT var FROM envvars WHERE context=?)")
contextb contexta)
result))
;; get list of variables in both contexta and contexb that have been changed
;;
(define (env:get-changed db contexta contextb)
(let ((result (make-hash-table)))
(query
(for-each-row
(lambda (row)
(let ((var (car row))
(val (cadr row)))
(hash-table-set! result var val))))
(sql db "SELECT var,val FROM envvars AS a WHERE context=? AND val != (SELECT val FROM envvars WHERE var=a.var AND context=?)")
contexta contextb)
result))
;;
(define (env:blind-merge l1 l2)
(if (null? l1) l2
(if (null? l2) l1
(cons (car l1) (cons (car l2) (env:blind-merge (cdr l1) (cdr l2)))))))
|
137
138
139
140
141
142
143
|
(define (env:have-context db context)
(> (query fetch-value (sql db "SELECT count(id) FROM envvars WHERE context=?") context)
0))
;; this is so the calling block does not need to import sql-de-lite
(define (env:close-database db)
(close-database db))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
(define (env:have-context db context)
(> (query fetch-value (sql db "SELECT count(id) FROM envvars WHERE context=?") context)
0))
;; this is so the calling block does not need to import sql-de-lite
(define (env:close-database db)
(close-database db))
(define (env:lazy-hash-table->alist indat)
(if (hash-table? indat)
(let ((dat (hash-table->alist indat)))
(if (null? dat)
#f
dat))
#f))
(define (env:print added removed changed)
(let ((a (env:lazy-hash-table->alist added))
(r (env:lazy-hash-table->alist removed))
(c (env:lazy-hash-table->alist changed)))
(case (if (args:get-arg "-dumpmode")
(string->symbol (args:get-arg "-dumpmode"))
'bash)
((bash)
(if a
(begin
(print "# Added vars")
(map (lambda (dat)(print "export " (car dat) "=" (cdr dat)))
(hash-table->alist added))))
(if r
(begin
(print "# Removed vars")
(map (lambda (dat)(print "unset " (car dat)))
(hash-table->alist removed))))
(if c
(begin
(print "# Changed vars")
(map (lambda (dat)(print "export " (car dat) "=" (cdr dat)))
(hash-table->alist changed)))))
((csh)
(if a
(begin
(print "# Added vars")
(map (lambda (dat)(print "setenv " (car dat) " " (cdr dat)))
(hash-table->alist added))))
(if r
(begin
(print "# Removed vars")
(map (lambda (dat)(print "unsetenv " (car dat)))
(hash-table->alist removed))))
(if c
(begin
(print "# Changed vars")
(map (lambda (dat)(print "setenv " (car dat) " " (cdr dat)))
(hash-table->alist changed)))))
((config ini)
(if a
(begin
(print "# Added vars")
(map (lambda (dat)(print (car dat) " " (cdr dat)))
(hash-table->alist added))))
(if r
(begin
(print "# Removed vars")
(map (lambda (dat)(print "#{scheme (unsetenv \"" (car dat) "\")}"))
(hash-table->alist removed))))
(if c
(begin
(print "# Changed vars")
(map (lambda (dat)(print (car dat) " " (cdr dat)))
(hash-table->alist changed)))))
(else
(debug:print 0 "ERROR: No dumpmode specified, use -dumpmode [bash|csh|config]")))))
|