entity-values.ss 5.29 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 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
#lang racket

;; Starwisp Copyright (C) 2014 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/>.

(require
 "../web/scripts/utils.ss"
 "../web/scripts/sql.ss"
 "ktv.ss"
 "ktv-list.ss")

(provide (all-defined-out))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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
(define (insert-value db table entity-id ktv dirty)
  ;; use type to dispatch insert to correct value table
  (db-insert db (string-append "insert into " table "_value_" (ktv-type ktv)
                               " values (null, ?, ?, ?, ?, 0)")
             entity-id (ktv-key ktv) (ktv-value ktv) (if dirty 1 0)))

;; update the value given an entity type, a attribute type and it's key (= attriute_id)
;; creates the value if it doesn't already exist, updates it otherwise if it's different
(define (update-value db table entity-id ktv)
  (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 the are different
        (if (not (ktv-eq? ktv (list (ktv-key ktv) (ktv-type ktv) s)))
            (db-exec
             db (string-append "update " table "_value_" (ktv-type ktv)
                               " set value=?, dirty=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
(define (update-value-from-sync db table entity-id ktv)
  (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))))
    ;;(msg "update-value-from-sync" s)
    ;;(msg ktv)
    ;;(msg entity-id)
    (if (null? s)
Dave Griffiths's avatar
Dave Griffiths committed
91
        (insert-value db table entity-id ktv #t) ;; <- don't make dirty!?
Dave Griffiths's avatar
Dave Griffiths committed
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 122 123
        (db-exec
         db (string-append "update " table "_value_" (ktv-type ktv)
                           " set value=?, dirty=0 where entity_id = ? and attribute_id = ?")
         (ktv-value ktv) entity-id (ktv-key ktv)))))

;; 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)))))

;; get the value, dirty and version given an entity type, a attribute type and it's key (= attriute_id)
(define (get-value db table entity-id kt)
  (let ((s (db-select
            db (string-append "select value, dirty 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)))))

(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)))
Dave Griffiths's avatar
Dave Griffiths committed
124

Dave Griffiths's avatar
Dave Griffiths committed
125
(define (dirtify-value db table entity-id kt)
Dave Griffiths's avatar
Dave Griffiths committed
126
  (db-exec db (string-append "update " table "_value_" (ktv-type kt)
Dave Griffiths's avatar
Dave Griffiths committed
127 128
                             " set dirty=1  where entity_id = ? and attribute_id = ?")
           entity-id (ktv-key kt)))