eavdb.scm 25.7 KB
Newer Older
Dave Griffiths's avatar
Dave Griffiths committed
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
;; MongooseWeb Copyright (C) 2013 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;; android/racket stuff
(define db-select db-exec)

;; racket
;(define db-exec exec/ignore)
;(define db-select select)
;(define db-insert insert)
;(define (db-status) "")
;(define (time) (list 0 0))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; entity-attribut-value system for sqlite
;;

;; create eav tables (add types as required)
(define (setup db table)
  (db-exec db (string-append "create table " table "_entity ( entity_id integer primary key autoincrement, entity_type varchar(256), unique_id varchar(256), dirty integer, version integer)"))
  (db-exec db (string-append "create table " table "_attribute ( id integer primary key autoincrement, attribute_id varchar(256), entity_type varchar(256), attribute_type varchar(256))"))
34
35
36
37
  (db-exec db (string-append "create table " table "_value_varchar ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer, version integer)"))
  (db-exec db (string-append "create table " table "_value_int ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value integer, dirty integer, version integer)"))
  (db-exec db (string-append "create table " table "_value_real ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value real, dirty integer, version integer)"))
  (db-exec db (string-append "create table " table "_value_file ( id integer primary key autoincrement, entity_id integer, attribute_id varchar(255), value varchar(4096), dirty integer, version integer)")))
Dave Griffiths's avatar
Dave Griffiths committed
38
39
40
41

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; basic key/type/value structure
42
43
44
45
46
;; used for all data internally, and maps to the eavdb types

(define (ktv key type value) (list key type value -999))
(define (ktv-with-version key type value version) (list key type value version))
(define (ktv-create key type value) (list key type value 0))
Dave Griffiths's avatar
Dave Griffiths committed
47
48
49
(define ktv-key car)
(define ktv-type cadr)
(define ktv-value caddr)
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
(define (ktv-version ktv) (list-ref ktv 3))

(define (ktv-eq? a b)
  (and
   (equal? (ktv-key a) (ktv-key b))
   (equal? (ktv-type a) (ktv-type b))
   (cond
    ((or
      (equal? (ktv-type a) "int")
      (equal? (ktv-type a) "real"))
     (eqv? (ktv-value a) (ktv-value b)))
    ((or
      (equal? (ktv-type a) "varchar")
      (equal? (ktv-type a) "file"))
     (equal? (ktv-value a) (ktv-value b)))
    (else
     (msg "unsupported ktv type in ktv-eq?: " (ktv-type a))
     #f))))
Dave Griffiths's avatar
Dave Griffiths committed
68

69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
;; replace or insert a ktv
(define (ktvlist-replace ktv ktvlist)
  (cond
   ((null? ktvlist)
    (list ktv))
   ((equal? (ktv-key (car ktvlist)) (ktv-key ktv))
    (cons ktv (cdr ktvlist)))
   (else (cons (car ktvlist) (ktvlist-replace ktv (cdr ktvlist))))))

(define (ktvlist-merge a b)
  (foldl
   (lambda (ktv r)
     (ktvlist-replace ktv r))
   a b))

Dave Griffiths's avatar
Dave Griffiths committed
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
;; stringify based on type (for url)
(define (stringify-value ktv)
  (cond
   ((null? (ktv-value ktv)) "NULL")
   ((equal? (ktv-type ktv) "varchar") (string-append "'" (ktv-value ktv) "'"))
   (else
    (if (not (string? (ktv-value ktv)))
        (number->string (ktv-value ktv))
        (ktv-value ktv)))))

;; stringify based on type (for url)
(define (stringify-value-url ktv)
  (cond
   ((null? (ktv-value ktv)) "NULL")
   ((equal? (ktv-type ktv) "varchar") (ktv-value ktv))
   (else
    (if (not (string? (ktv-value ktv)))
        (number->string (ktv-value ktv))
        (ktv-value ktv)))))

104
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Dave Griffiths's avatar
Dave Griffiths committed
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

;; helper to return first instance from a select
(define (select-first db str . args)
  (let ((s (apply db-select (append (list db str) args))))
    (if (or (null? s) (eq? s #t))
        '()
        (vector-ref (cadr s) 0))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; putting data in

;; get the type from the attribute table with an entity/key
(define (get-attribute-type db table entity-type key)
  (let ((sql (string-append
              "select attribute_type from " table
              "_attribute where entity_type = ? and attribute_id = ?")))
    (select-first db sql entity-type key)))

;; search for a type and add it if it doesn't exist
(define (find/add-attribute-type db table entity-type key type)
  (let ((t (get-attribute-type db table entity-type key)))
    ;; add and return passed in type if not exist
    (cond
      ((null? t)
       (msg "adding new attribute for" entity-type " called " key " of type " type)
       (db-insert
        db (string-append "insert into " table "_attribute values (null, ?, ?, ?)")
        key entity-type type)
       type)
      (else
       (cond
         ((equal? type t) t)
         (else
          (msg "type has changed for" entity-type key "from" t "to" type "???")
          ;; wont work
          ;; what do we do?
          ;; some kind of coercion for existing data???
          type))))))

;; low level insert of a ktv
145
(define (insert-value db table entity-id ktv dirty)
Dave Griffiths's avatar
Dave Griffiths committed
146
147
  ;; use type to dispatch insert to correct value table
  (db-insert db (string-append "insert into " table "_value_" (ktv-type ktv)
148
                               " values (null, ?, ?, ?, ?, ?)")
149
             entity-id (ktv-key ktv) (ktv-value ktv) (if dirty 1 0) (ktv-version ktv)))
Dave Griffiths's avatar
Dave Griffiths committed
150
151

(define (get-unique user)
Dave Griffiths's avatar
Dave Griffiths committed
152
  (let ((t (time-of-day)))
Dave Griffiths's avatar
Dave Griffiths committed
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
    (string-append
     user "-" (number->string (car t)) ":" (number->string (cadr t)))))

;; insert an entire entity
(define (insert-entity db table entity-type user ktvlist)
  (insert-entity-wholesale db table entity-type (get-unique user) 1 0 ktvlist))

;; insert an entire entity
(define (insert-entity/get-unique db table entity-type user ktvlist)
  (let ((uid (get-unique user)))
    (insert-entity-wholesale db table entity-type uid 1 0 ktvlist)
    uid))

;; all the parameters - for syncing purposes
(define (insert-entity-wholesale db table entity-type unique-id dirty version ktvlist)
  (let ((id (db-insert
             db (string-append
                 "insert into " table "_entity values (null, ?, ?, ?, ?)")
             entity-type unique-id dirty version)))
    ;; create the attributes if they are new, and validate them if they exist
    (for-each
     (lambda (ktv)
       (find/add-attribute-type db table entity-type (ktv-key ktv) (ktv-type ktv)))
     ktvlist)
    ;; add all the keys
    (for-each
     (lambda (ktv)
180
       (insert-value db table id ktv dirty))
Dave Griffiths's avatar
Dave Griffiths committed
181
182
183
184
185
     ktvlist)
    id))


;; update the value given an entity type, a attribute type and it's key (= attriute_id)
186
;; creates the value if it doesn't already exist, updates it otherwise if it's different
Dave Griffiths's avatar
Dave Griffiths committed
187
(define (update-value db table entity-id ktv)
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
  (msg "update-value")
  (let ((s (select-first
            db (string-append
				"select value from " table "_value_" (ktv-type ktv) " where entity_id = ? and attribute_id = ?")
			entity-id (ktv-key ktv))))
    (if (null? s)
        (insert-value db table entity-id ktv #t)
        ;; only update if they are different
        (if (not (ktv-eq? ktv (list (ktv-key ktv) (ktv-type ktv) s)))
            (begin
              (msg "incrementing value version in update-value")
              (db-exec
               db (string-append "update " table "_value_" (ktv-type ktv)
                                 " set value=?, dirty=1, version=version+1  where entity_id = ? and attribute_id = ?")
               (ktv-value ktv) entity-id (ktv-key ktv)))
            '())))) ;;(msg "values for" (ktv-key ktv) "are the same (" (ktv-value ktv) "==" s ")")))))

;; don't make dirty or update version here
206
(define (update-value-from-sync db table entity-id ktv)
207
208
209
210
211
212
  (let ((s (select-first
            db (string-append
                "select value from " table "_value_" (ktv-type ktv) " where entity_id = ? and attribute_id = ?")
            entity-id (ktv-key ktv))))
    (if (null? s)
        (insert-value db table entity-id ktv #t)
213
214
215
216
217
218
        (begin
          (msg "actually updating (fs)" (ktv-key ktv) "to" (ktv-value ktv))
          (db-exec
           db (string-append "update " table "_value_" (ktv-type ktv)
                             " set value=?, dirty=0, version=? where entity_id = ? and attribute_id = ?")
           (ktv-value ktv) (ktv-version ktv) entity-id (ktv-key ktv))))))
Dave Griffiths's avatar
Dave Griffiths committed
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; getting data out

(define (entity-exists? db table unique-id)
  (not (null? (select-first
               db (string-append
                   "select * from " table "_entity where unique_id = ?")
               unique-id))))

(define (get-entity-type db table entity-id)
  (select-first
   db (string-append
       "select entity_type from " table "_entity where entity_id = ?")
       entity-id))

(define (get-all-entity-types db table)
  (cdr (db-select db (string-append "select distinct entity_type from " table "_entity;"))))

;; get all the (current) attributes for an entity type
(define (get-attribute-ids/types db table entity-type)
  (let ((s (db-select
            db (string-append
                "select * from " table "_attribute where entity_type = ?")
                entity-type)))
    (if (null? s) '()
        (map
         (lambda (row)
           (list (vector-ref row 1)    ;; id
                 (vector-ref row 3)))  ;; type
         (cdr s)))))

251
;; get the value, dirty and version given an entity type, a attribute type and it's key (= attriute_id)
Dave Griffiths's avatar
Dave Griffiths committed
252
(define (get-value db table entity-id kt)
253
254
255
256
257
258
259
260
  (let ((s (db-select
            db (string-append "select value, dirty, version from " table "_value_" (ktv-type kt)
                              " where entity_id = ? and attribute_id = ?")
            entity-id (ktv-key kt))))
    (if (null? s) '()
		(list (vector-ref (cadr s) 0)
			  (vector-ref (cadr s) 1)
			  (vector-ref (cadr s) 2)))))
261

Dave Griffiths's avatar
Dave Griffiths committed
262
263
;; get an entire entity, as a list of key/value pairs
(define (get-entity-plain db table entity-id)
264
  (msg "get-entity-plain")
Dave Griffiths's avatar
Dave Griffiths committed
265
266
267
268
269
270
  (let* ((entity-type (get-entity-type db table entity-id)))
    (cond
      ((null? entity-type) (msg "entity" entity-id "not found!") '())
      (else
       (map
        (lambda (kt)
271
272
273
274
275
276
277
278
279
		  (let ((vdv (get-value db table entity-id kt)))
			(if (null? vdv)
				(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
				(list (ktv-key kt) (ktv-type kt)
					  (list-ref vdv 0) (list-ref vdv 2)))))
        (get-attribute-ids/types db table entity-type))))))

;; get an entire entity, as a list of key/value pairs, only dirty values
(define (get-entity-plain-for-sync db table entity-id)
280
  (msg "gepfs")
281
282
283
284
285
286
  (let* ((entity-type (get-entity-type db table entity-id)))
    (cond
      ((null? entity-type) (msg "entity" entity-id "not found!") '())
      (else
       (foldl
        (lambda (kt r)
287
          (msg kt)
288
          (let ((vdv (get-value db table entity-id kt)))
289
            (msg vdv)
290
291
292
            (cond
			 ((null? vdv)
			  (msg "ERROR: get-entity-plain-for-sync: no value found for " entity-id " " (ktv-key kt))
293
294
295
296
297
			  r)
			 ;; only return if dirty
			 ((not (zero? (cadr vdv)))
			  (msg "value-dirty-version found" vdv)
			  (cons
298
			   (list (ktv-key kt) (ktv-type kt) (list-ref vdv 0) (list-ref vdv 2))
299
300
301
			   r))
			 (else r))))
        '()
Dave Griffiths's avatar
Dave Griffiths committed
302
303
304
305
306
307
308
309
310
311
312
313
314
        (get-attribute-ids/types db table entity-type))))))

;; get an entire entity, as a list of key/value pairs (includes entity id)
(define (get-entity db table entity-id)
  (let ((unique-id (get-unique-id db table entity-id)))
    (cons
     (list "unique_id" "varchar" unique-id)
     (get-entity-plain db table entity-id))))

(define (all-entities db table type)
  (let ((s (db-select
            db (string-append "select e.entity_id from " table "_entity as e "
                              "join " table "_value_varchar "
315
316
317
318
319
320
321
                              " as n on n.entity_id = e.entity_id and n.attribute_id = ?"
                              "left join " table "_value_int "
                              "as d on d.entity_id = e.entity_id and d.attribute_id = ? "
                              "where e.entity_type = ? "
                              "and (d.value='NULL' or d.value is NULL or d.value = 0) "
                              "order by n.value")
            "name" "deleted" type)))
Dave Griffiths's avatar
Dave Griffiths committed
322
323
324
325
326
327
328
329
    (msg (db-status db))
    (if (null? s)
        '()
        (map
         (lambda (i)
           (vector-ref i 0))
         (cdr s)))))

Dave Griffiths's avatar
Dave Griffiths committed
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
(define (all-entities-with-parent db table type parent)
  (let ((s (db-select
            db (string-append "select e.entity_id from " table "_entity as e "
                              "join " table "_value_varchar "
                              " as n on n.entity_id = e.entity_id and n.attribute_id = ?"
                              "join " table "_value_varchar "
                              " as p on p.entity_id = e.entity_id and p.attribute_id = ?"
                              "left join " table "_value_int "
                              "as d on d.entity_id = e.entity_id and d.attribute_id = ? "
                              "where e.entity_type = ? and "
                              "p.value = ? and "
                              "(d.value='NULL' or d.value is NULL or d.value = 0) "
                              "order by n.value")
            "name" "parent" "deleted" type parent)))
    (msg (db-status db))
    (if (null? s)
        '()
        (map
         (lambda (i)
           (vector-ref i 0))
         (cdr s)))))


353
354
355
356
357
358
359
360
361
;; filter is list of (attribute-key type op arg) e.g. ("gender" "varchar" "=" "Female")
;; note: only one filter per key..

(define (make-filter k t o a) (list k t o a))
(define (filter-key f) (list-ref f 0))
(define (filter-type f) (list-ref f 1))
(define (filter-op f) (list-ref f 2))
(define (filter-arg f) (list-ref f 3))

362
363
364
365
366
367
368
369
370
371
372
373
374
375
(define (merge-filter f fl)
  (cond
   ((null? fl) (list f))
   ((equal? (filter-key (car fl)) (filter-key f))
    (cons f (cdr fl)))
   (else (cons (car fl) (merge-filter f (cdr fl))))))

(define (delete-filter key fl)
  (cond
   ((null? fl) '())
   ((equal? (filter-key (car fl)) key)
    (cdr fl))
   (else (cons (car fl) (delete-filter key (cdr fl))))))

376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
(define (build-query table filter)
  (string-append
   (foldl
    (lambda (i r)
      (let ((var (string-append (filter-key i) "_var")))
        ;; add a query chunk
        (string-append
         r "join " table "_value_" (filter-type i) " "
         "as " var " on "
         var ".entity_id = e.entity_id and " var ".attribute_id = '" (filter-key i) "' and "
         var ".value " (filter-op i) " ? ")))

    ;; boilerplate query start
    (string-append
     "select e.entity_id from " table "_entity as e "
     ;; order by name
     "join " table "_value_varchar "
     "as n on n.entity_id = e.entity_id and n.attribute_id = 'name' "
     ;; ignore deleted
     "join " table "_value_int "
     "as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' and "
     "d.value = 0 ")
    filter)
399
   "where e.entity_type = ? order by n.value"))
400
401
402
403
404
405
406
407
408
409
410
411

(define (build-args filter)
  (map
   (lambda (i)
     (filter-arg i))
   filter))

(define (filter-entities db table type filter)
  (let ((s (apply
            db-select
            (dbg (append
                  (list db (build-query table filter))
412
413
                  (build-args filter)
                  (list type))))))
414
415
416
417
418
419
420
421
422
    (msg (db-status db))
    (if (null? s)
        '()
        (map
         (lambda (i)
           (vector-ref i 0))
         (cdr s)))))


Dave Griffiths's avatar
Dave Griffiths committed
423
424
425
426
427
428
429
430
431
432
433
434
435
436
(define (validate db)
  ;; check attribute for duplicate entity-id/attribute-ids
  0)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helpers

(define (ktv-get ktv-list key)
  (cond
   ((null? ktv-list) #f)
   ((equal? (ktv-key (car ktv-list)) key)
    (ktv-value (car ktv-list)))
   (else (ktv-get (cdr ktv-list) key))))

437
438
439
440
441
442
443
(define (ktv-get-type ktv-list key)
  (cond
   ((null? ktv-list) #f)
   ((equal? (ktv-key (car ktv-list)) key)
    (ktv-type (car ktv-list)))
   (else (ktv-get-type (cdr ktv-list) key))))

Dave Griffiths's avatar
Dave Griffiths committed
444
445
446
447
448
449
450
451
(define (ktv-set ktv-list ktv)
  (cond
   ((null? ktv-list) (list ktv))
   ((equal? (ktv-key (car ktv-list)) (ktv-key ktv))
    (cons ktv (cdr ktv-list)))
   (else (cons (car ktv-list) (ktv-set (cdr ktv-list) ktv)))))

(define (db-all db table type)
Dave Griffiths's avatar
Dave Griffiths committed
452
  (map
Dave Griffiths's avatar
Dave Griffiths committed
453
454
   (lambda (i)
     (get-entity db table i))
Dave Griffiths's avatar
Dave Griffiths committed
455
456
457
458
459
460
461
462
   (all-entities db table type)))

(define (db-with-parent db table type parent)
  (map
   (lambda (i)
     (get-entity db table i))
   (all-entities-with-parent db table type parent)))

463
464
465
466
467
(define (db-filter db table type filter)
  (map
   (lambda (i)
     (get-entity db table i))
   (filter-entities db table type filter)))
Dave Griffiths's avatar
Dave Griffiths committed
468
469
470
471
472
473

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data

;; update an entire entity (version incl), via a (possibly partial) list of key/value pairs
(define (update-to-version db table entity-id version ktvlist)
474
475
  ;; not dirty
  (update-entity-values db table entity-id ktvlist #f)
Dave Griffiths's avatar
Dave Griffiths committed
476
477
478
479
  (update-entity-version db table entity-id version))

;; auto update version
(define (update-entity db table entity-id ktvlist)
480
481
  (msg "update-entity")
  ;; dirty
Dave Griffiths's avatar
Dave Griffiths committed
482
  (update-entity-changed db table entity-id)
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
  (update-entity-values db table entity-id ktvlist #t))

(define (clean-value db table entity-id kt)
  (db-exec db (string-append "update " table "_value_" (ktv-type kt)
                             " set dirty=0  where entity_id = ? and attribute_id = ?")
           entity-id (ktv-key kt)))

(define (clean-entity-values db table entity-id)
  (msg "clean-entity-values")
  (let* ((entity-type (get-entity-type db table entity-id)))
    (cond
     ((null? entity-type)
      (msg "clean-entity-values: entity" entity-id "not found!") '())
     (else
      (for-each
       (lambda (kt)
         (msg "cleaning" kt)
         (clean-value db table entity-id (list (ktv-key kt) (ktv-type kt))))
       (get-attribute-ids/types db table entity-type))))))
Dave Griffiths's avatar
Dave Griffiths committed
502
503

;; update an entity, via a (possibly partial) list of key/value pairs
504
505
506
;; if dirty is not true, this is coming from a sync
(define (update-entity-values db table entity-id ktvlist dirty)
  (msg "update-entity-values")
Dave Griffiths's avatar
Dave Griffiths committed
507
508
509
510
511
512
513
514
515
516
517
518
  (let* ((entity-type (get-entity-type db table entity-id)))
    (cond
     ((null? entity-type) (msg "entity" entity-id "not found!") '())
     (else
      ;; update main entity type
      (for-each
       (lambda (ktv)
         (when (not (equal? (ktv-key ktv) "unique_id"))
               (find/add-attribute-type db table entity-type (ktv-key ktv) (ktv-type ktv))))
       ktvlist)
      (for-each
       (lambda (ktv)
519
520
521
522
         (when (not (equal? (ktv-key ktv) "unique_id"))
			   (if dirty
				   (update-value db table entity-id ktv)
				   (update-value-from-sync db table entity-id ktv))))
Dave Griffiths's avatar
Dave Griffiths committed
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
       ktvlist)))))

;; update or create an entire entity if it doesn't exist
;; will return the new entity id if it's created
(define (update/insert-entity db table entity-type user entity-id ktvlist)
  (let* ((entity-type (get-entity-type db table entity-id)))
    (cond
     ((null? entity-type)
      (insert-entity db table entity-type user ktvlist))
     (else
      (update-entity db table entity-id ktvlist)
      #f))))

(define (insert-entity-if-not-exists db table entity-type user entity-id ktvlist)
  (let ((found (get-entity-type db table entity-id)))
    (if (null? found)
        (insert-entity db table entity-type user ktvlist)
        #f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; versioning

(define (get-entity-version db table entity-id)
  (select-first
   db (string-append "select version from " table "_entity where entity_id = ?")
   entity-id))

(define (get-entity-dirty db table entity-id)
  (select-first
   db (string-append "select dirty from " table "_entity where entity_id = ?")
   entity-id))

(define (update-entity-changed db table entity-id)
  (db-exec
   db (string-append
558
559
       "update " table "_entity set dirty=?, version=version+1 where entity_id = ?")
   1 entity-id))
Dave Griffiths's avatar
Dave Griffiths committed
560

561
;; set from a sync, so clear dirty - should be anyway
Dave Griffiths's avatar
Dave Griffiths committed
562
563
564
(define (update-entity-version db table entity-id version)
  (db-exec
   db (string-append
565
566
       "update " table "_entity set dirty=0, version=? where entity_id = ?")
   version entity-id))
Dave Griffiths's avatar
Dave Griffiths committed
567
568

(define (update-entity-clean db table unique-id)
569
570
  (msg "cleaning")
  ;; clean entity table
Dave Griffiths's avatar
Dave Griffiths committed
571
572
  (db-exec
   db (string-append "update " table "_entity set dirty=? where unique_id = ?")
573
574
575
576
   0 unique-id)
  ;; clean value tables for this entity
  (msg "cleaning values")
  (clean-entity-values db table (entity-id-from-unique db table unique-id))  )
Dave Griffiths's avatar
Dave Griffiths committed
577
578
579
580
581
582
583
584

(define (get-dirty-stats db table)
  (list
   (select-first
    db (string-append "select count(entity_id) from " table "_entity where dirty=1"))
   (select-first
    db (string-append "select count(entity_id) from " table "_entity;"))))

585
586


Dave Griffiths's avatar
Dave Griffiths committed
587
588
589
590
591
592
593
594
(define (dirty-entities db table)
  (let ((de (db-select
             db (string-append
                 "select entity_id, entity_type, unique_id, dirty, version from " table "_entity where dirty=1;"))))
    (if (null? de)
        '()
        (map
         (lambda (i)
595
           (msg "dirty-entities")
Dave Griffiths's avatar
Dave Griffiths committed
596
597
598
599
           (list
            ;; build according to url ([table] entity-type unique-id dirty version)
            (cdr (vector->list i))
            ;; data entries (todo - only dirty values!)
600
            (dbg (get-entity-plain-for-sync db table (vector-ref i 0)))))
Dave Griffiths's avatar
Dave Griffiths committed
601
602
         (cdr de)))))

603
604
;; todo: BROKEN...
;; used for sync-all
Dave Griffiths's avatar
Dave Griffiths committed
605
606
607
608
609
610
611
612
613
614
615
(define (dirty-and-all-entities db table)
  (let ((de (db-select
             db (string-append
                 "select entity_id, entity_type, unique_id, dirty, version from " table "_entity"))))
    (if (null? de)
        '()
        (map
         (lambda (i)
           (list
            ;; build according to url ([table] entity-type unique-id dirty version)
            (cdr (vector->list i))
616
            ;; data entries (todo - only dirty values!)???????????
Dave Griffiths's avatar
Dave Griffiths committed
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
            (get-entity-plain db table (vector-ref i 0))))
         (cdr de)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syncing

(define (stringify-list l)
  (foldl
   (lambda (i r)
     (string-append r " " i))
   "" l))

(define (stringify-ktvlist ktvlist)
  (foldl
   (lambda (i r)
     (string-append r " " (ktv-key i) ":" (stringify-value i)))
   ""
   ktvlist))

(define (build-sync-debug db table)
  (foldl
   (lambda (i r)
     (string-append
      r "\n" (vector-ref i 0) " " (vector-ref i 1) " "
      (stringify-ktvlist (get-entity db table (vector-ref i 0)))))
   ""
   (cdr (db-select
         db (string-append "select * from " table "_entity where dirty=1;")))))


(define (build-sync db table)
  (map
   (lambda (i)
     (list
      (vector->list i)
      (get-entity db table (vector-ref i 0))))
   (cdr (db-select
         db (string-append "select * from " table "_entity where dirty=1;")))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; doing things with unique ids

(define (entity-id-from-unique db table unique-id)
  (select-first
   db (string-append "select entity_id from " table "_entity where unique_id = ?")
   unique-id))

(define (entity-version-from-unique db table unique-id)
  (select-first
   db (string-append "select version from " table "_entity where unique_id = ?")
   unique-id))


(define (get-unique-id db table entity-id)
  (select-first
   db (string-append
       "select unique_id from " table "_entity where entity_id = ?")
       entity-id))

(define (get-entity-id db table unique-id)
  (select-first
   db (string-append
       "select entity_id from " table "_entity where unique_id = ?")
   unique-id))

683
684
685
(define (get-entity-by-unique db table unique-id)
  (get-entity db table (get-entity-id db table unique-id)))

Dave Griffiths's avatar
Dave Griffiths committed
686
(define (get-entity-name db table unique-id)
687
  (ktv-get (get-entity-by-unique db table unique-id) "name"))
Dave Griffiths's avatar
Dave Griffiths committed
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737

(define (get-entity-names db table id-list)
  (foldl
   (lambda (id r)
     (if (equal? r "")
         (get-entity-name db table id)
         (string-append r ", " (get-entity-name db table id))))
   ""
   id-list))

(define (csv-titles db table entity-type)
  (foldl
   (lambda (kt r)
     (if (equal? r "") (string-append "\"" (ktv-key kt) "\"")
         (string-append r ", \"" (ktv-key kt) "\"")))
   "id, "
   (get-attribute-ids/types db table entity-type)))

(define (csv db table entity-type)
  (foldl
   (lambda (res r)
     (let ((entity (get-entity db table (vector-ref res 0))))
       (string-append
        r "\n"
        (foldl
         (lambda (ktv r)
           (cond
            ((equal? (ktv-key ktv) "unique_id") r)
            ((null? (ktv-value ktv))
             (msg "value not found in csv for " (ktv-key ktv))
             r)
            ;; dereferences lists of ids
            ((and
              (> (string-length (ktv-key ktv)) 8)
              (equal? (substring (ktv-key ktv) 0 8) "id-list-"))
             (string-append r ", \"" (get-entity-names db "sync" (string-split (ktv-value ktv) '(#\,))) "\""))
            ;; look for unique ids and dereference them
            ((and
              (> (string-length (ktv-key ktv)) 3)
              (equal? (substring (ktv-key ktv) 0 3) "id-"))
             (string-append r ", \"" (get-entity-name db "sync" (ktv-value ktv)) "\""))
            (else
             (string-append r ", \"" (stringify-value-url ktv) "\""))))
         (vector-ref res 1) ;; unique_id
         entity))))
   (csv-titles db table entity-type)
   (cdr (db-select
         db (string-append
             "select entity_id, unique_id from "
             table "_entity where entity_type = ?") entity-type))))