entity-insert.ss 3.23 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
#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"
dave griffiths's avatar
dave griffiths committed
23 24
 "entity-values.ss"
 "entity-get.ss")
Dave Griffiths's avatar
Dave Griffiths committed
25 26 27 28 29 30 31

(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
32 33 34 35
;; 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
36 37 38 39 40 41
;; 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
42 43 44 45 46 47 48
;; 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
49
(define entity-sema (make-semaphore 1))
Dave Griffiths's avatar
Dave Griffiths committed
50 51 52

;; 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
53
  (semaphore-wait entity-sema)
Dave Griffiths's avatar
Dave Griffiths committed
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
  (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
72
    (semaphore-post entity-sema)
Dave Griffiths's avatar
Dave Griffiths committed
73 74

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

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