Add postgresql escape string expression/operator

[clsql.git] / sql / expressions.lisp

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 16bf687567ebc75e7dec65ed895ed5de92fda40b..4f0baf1230b0ab32353dc69026645306adae11e0 100644 (file)
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -450,8 +450,6 @@
           (remove-duplicates tabs :test #'database-identifier-equal))
         nil)))
 
-
-
 (defmethod output-sql ((expr sql-value-exp) database)
   (with-slots (modifier components)
     expr
@@ -1093,48 +1091,42 @@ uninclusive, and the args from that keyword to the end."
 ;;
 ;; Column constraint types and conversion to SQL
 ;;
-
-(defparameter *constraint-types*
-  (list
-   (cons (symbol-name-default-case "NOT-NULL") "NOT NULL")
-   (cons (symbol-name-default-case "PRIMARY-KEY") "PRIMARY KEY")
-   (cons (symbol-name-default-case "NOT") "NOT")
-   (cons (symbol-name-default-case "NULL") "NULL")
-   (cons (symbol-name-default-case "PRIMARY") "PRIMARY")
-   (cons (symbol-name-default-case "KEY") "KEY")
-   (cons (symbol-name-default-case "UNSIGNED") "UNSIGNED")
-   (cons (symbol-name-default-case "ZEROFILL") "ZEROFILL")
-   (cons (symbol-name-default-case "AUTO-INCREMENT") "AUTO_INCREMENT")
-   (cons (symbol-name-default-case "DEFAULT") "DEFAULT")
-   (cons (symbol-name-default-case "UNIQUE") "UNIQUE")
-   (cons (symbol-name-default-case "IDENTITY") "IDENTITY (1,1)") ;; added for sql-server support
-   ))
-
 (defmethod database-constraint-statement (constraint-list database)
   (make-constraints-description constraint-list database))
 
+;; KEEP THIS SYNCED WITH database-translate-constraint
+(defparameter +auto-increment-names+
+  '(:auto-increment :auto_increment :autoincrement :identity))
+
 (defmethod database-translate-constraint (constraint database)
-  (assoc (symbol-name constraint)
-        *constraint-types*
-        :test #'equal))
-
-(defun make-constraints-description (constraint-list database)
-  (if constraint-list
-      (let ((string ""))
-        (do ((constraint constraint-list (cdr constraint)))
-            ((null constraint) string)
-          (let ((output (database-translate-constraint (car constraint)
-                                                      database)))
-            (if (null output)
-                (error 'sql-user-error
-                       :message (format nil "unsupported column constraint '~A'"
-                                        constraint))
-                (setq string (concatenate 'string string (cdr output))))
-           (when (equal (symbol-name (car constraint)) "DEFAULT")
-             (setq constraint (cdr constraint))
-             (setq string (concatenate 'string string " " (car constraint))))
-            (if (< 1 (length constraint))
-                (setq string (concatenate 'string string " "))))))))
+  (case constraint
+    (:not-null "NOT NULL")
+    (:primary-key "PRIMARY KEY")
+    ((:auto-increment :auto_increment :autoincrement :identity)
+     (ecase (database-underlying-type database)
+       (:mssql "IDENTITY (1,1)")
+       ((:sqlite :sqlite3) "PRIMARY KEY AUTOINCREMENT")
+       (:mysql "AUTO_INCREMENT")
+       ;; this is modeled as a datatype instead of a constraint
+       (:postgresql "")))
+    ;; everything else just get the name
+    (T (string-upcase (symbol-name constraint)))))
+
+(defun make-constraints-description (constraint-list database
+                                     &aux (rest constraint-list) constraint)
+  (when constraint-list
+    (flet ((next ()
+             (setf constraint (first rest)
+                   rest (rest rest))
+             constraint))
+      (with-output-to-string (s)
+        (loop while (next)
+              do (unless (keywordp constraint)
+                   (setf constraint (intern (symbol-name constraint) :keyword)))
+                 (write-string (database-translate-constraint constraint database) s)
+                 (when (eql :default constraint) (princ (next) s))
+                 (write-char #\space s)
+              )))))
 
 (defmethod database-identifier ( name  &optional database find-class-p
                                  &aux cls)
@@ -1240,3 +1232,16 @@ uninclusive, and the args from that keyword to the end."
     returns nil if there are no children"
   (clsql-ors clauses))
 
+
+(defclass sql-escape-string-exp (%sql-expression)
+  ((string
+    :initarg :string
+    :initform nil))
+  (:documentation
+   "An escaped string string expression (postgresql E'stuff') ."))
+
+(defmethod output-sql ((exp sql-escape-string-exp) database)
+  (with-slots (string) exp
+    (when string
+      (write-char #\E *sql-stream*)
+      (output-sql string database))))