Coverage report: /development/source/library/org/datagraph/spocq-shard/src/odbc/sql/sql-insert-values-exp.lisp

KindCoveredAll%
expression61108 56.5
branch912 75.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;
2
 ;;; insert values into <table> (v1, ...) (v2,...) ... 
3
 
4
 ;;; (load "patches/sql-insert-values-exp.lisp")
5
 
6
 
7
 (in-package :clsql-sys)
8
 
9
 (export '(sql-insert-values insert-values)
10
         :clsql-sys)
11
 (import '(sql-insert-values insert-values)
12
         :clsql)
13
 (export '(sql-insert-values insert-values)
14
         :clsql)
15
 
16
 (defclass sql-insert-values-exp (sql-ident)
17
   ((name :initarg :name)
18
    (attributes :initarg :attributes :initform ())
19
    (values :initarg :values)
20
    (conflict :initarg :conflict :initform nil)))
21
 
22
 (defmethod initialize-instance :after ((instance sql-insert-values-exp) &key)
23
   (with-slots (attributes values conflict) instance
24
     (assert (every #'listp values) ()
25
             "insert values element must be lists.")
26
     (let ((length (length (first values))))
27
       (assert (or (null attributes)
28
                   (null values)
29
                   (= (length attributes) length)) ()
30
               "insert attributes must match values.")
31
       (assert (loop for element in values
32
                 unless (= length (length element))
33
                 return nil finally (return t)) ()
34
                 "insert values must be consistent"))
35
     (assert (or (null conflict)
36
                 (stringp conflict)) ()
37
             "insert conflict actions must be a string")))
38
 
39
 (defmethod make-load-form ((sql sql-insert-values-exp) &optional environment)
40
   (declare (ignore environment))
41
   (with-slots (name attributes values conflict) sql
42
     `(make-instance 'sql-insert-values-exp :name ',name :attributes ',attributes :values ',values
43
        :conflict ,conflict)))
44
 
45
 (defmethod output-sql ((expr sql-insert-values-exp) database)
46
   (with-slots (name attributes values conflict) expr
47
     (format *sql-stream* "INSERT INTO \"~a\" " name)
48
     (when attributes
49
       (format *sql-stream* "(~{~a~^, ~}) " attributes))
50
     (write-string "VALUES " *sql-stream*)
51
     (loop for count from 0
52
       for tuple in values
53
       do (progn (unless (zerop count) (write-string ", " *sql-stream*))
54
            (write-char #\( *sql-stream*)
55
            (loop for count from 0
56
              for value in tuple
57
              do (progn (unless (zerop count) (write-string ", " *sql-stream*))
58
                   (output-sql value *sql-stream*)))
59
            (write-char #\) *sql-stream*)))
60
     (when conflict (format *sql-stream* " ON CONFLICT ~a" conflict))))
61
 
62
 (defsql sql-insert-values (:symbol "insert-values") (name &rest rest)
63
   (let* ((arguments (member-if #'keywordp rest))
64
          (data (ldiff rest arguments)))
65
     (case (length data)
66
       (1 (apply #'make-instance 'sql-insert-values-exp
67
                 :name name
68
                 :attributes ()
69
                 :values (first data)
70
                 arguments))
71
       (2 (apply #'make-instance 'sql-insert-values-exp
72
                 :name name
73
                 :attributes (first data)
74
                 :values (second data)
75
                 arguments))
76
       (t
77
        (error 'sql-user-error "INSERT-VALUES requires attributes and tuples values.")))))
78
 
79
 (defun insert-values (&key (into (error "insert-values: into is required"))
80
                            (attributes nil)
81
                            (values nil)
82
                            (database *default-database*)
83
                            (conflict nil))
84
   "Inserts records into the table specified by INTO in DATABASE
85
 which defaults to *DEFAULT-DATABASE*.
86
 
87
 VALUES contains a list of tuples, each of which comprises the values for one rwo, to insert.
88
 ATTRIBUTES, if present, specifies the respective column."
89
   (let ((stmt (make-instance 'sql-insert-values-exp
90
                 :name into
91
                 :attributes attributes
92
                 :values values
93
                 :conflict conflict)))
94
     (execute-command stmt :database database)))
95
 
96
 ;;; (clsql:sql-operation :insert-values "test" '((1 2) (3 4)))
97
 ;;; (clsql:sql-operation :insert-values "test" '(a s) '((1 2) (3 4)))
98
 ;;; (clsql:sql-operation :insert-values "test" '(a s) '((1 2) (3 4)) :conflict "(a) DO NOTHING")