entity-insert.ss 3.21 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
#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"
 "entity-values.ss")

(provide (all-defined-out))

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

Dave Griffiths's avatar
Dave Griffiths committed
31 32 33 34
;; insert an entire entity
(define (insert-entity-with-id db table id entity-type user ktvlist)
  (insert-entity-wholesale-with-id db table id entity-type (get-unique user) 1 0 ktvlist))

Dave Griffiths's avatar
Dave Griffiths committed
35 36 37 38 39 40
;; 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))

Dave Griffiths's avatar
Dave Griffiths committed
41 42 43 44 45 46 47
;; used for the app preferences
(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-with-id db table entity-id entity-type user ktvlist)
        #f)))

dave griffiths's avatar
dave griffiths committed
48
(define entity-sema (make-semaphore 1))
Dave Griffiths's avatar
Dave Griffiths committed
49 50 51

;; all the parameters - for syncing purposes
(define (insert-entity-wholesale db table entity-type unique-id dirty version ktvlist)
dave griffiths's avatar
dave griffiths committed
52
  (semaphore-wait entity-sema)
Dave Griffiths's avatar
Dave Griffiths committed
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
  (db-exec db "begin transaction")
  (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)
       (insert-value db table id ktv dirty))
     ktvlist)

    (db-exec db "end transaction")
dave griffiths's avatar
dave griffiths committed
71
    (semaphore-post entity-sema)
Dave Griffiths's avatar
Dave Griffiths committed
72 73

    id))
Dave Griffiths's avatar
Dave Griffiths committed
74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97

(define (insert-entity-wholesale-with-id db table id entity-type unique-id dirty version ktvlist)
  (semaphore-wait entity-sema)
  (db-exec db "begin transaction")
  (let ((id (db-insert
             db (string-append
                 "insert into " table "_entity values (?, ?, ?, ?, ?)")
             id 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)
       (insert-value db table id ktv dirty))
     ktvlist)

    (db-exec db "end transaction")
    (semaphore-post entity-sema)

    id))