+ (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)
+ (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")))
+ ;; 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)
+ "A function that takes whatever you give it, recursively coerces it,
+ and returns a database-identifier.
+
+ (escaped-database-identifiers *any-reasonable-object*) should be called to
+ produce a string that is safe to splice directly into sql strings.
+
+ This function should NOT throw errors when database is nil
+
+ find-class-p should be T if we want to search for classes
+ and check their use their view table. Should be used
+ on symbols we are sure indicate tables
+
+
+ ;; metaclasses has further typecases of this, so that it will
+ ;; load less painfully (try-recompiles) in SBCL
+
+ "
+ (flet ((flatten-id (id)
+ "if we have multiple pieces that we need to represent as
+ db-id lets do that by rendering out the id, then creating
+ a new db-id with that string as escaped"
+ (let ((s (sql-output id database)))
+ (make-instance '%database-identifier :escaped s :unescaped s))))
+ (setf name (dequote name))
+ (etypecase name
+ (null nil)
+ (string (%make-database-identifier name database))
+ (symbol
+ ;; if this is being used as a table, we should check
+ ;; for a class with this name and use the identifier specified
+ ;; on it
+ (if (and find-class-p (setf cls (find-standard-db-class name)))
+ (database-identifier cls)
+ (%make-database-identifier name database)))
+ (%database-identifier name)
+ ;; we know how to deref this without further escaping
+ (sql-ident-table
+ (with-slots ((inner-name name) alias) name
+ (if alias
+ (flatten-id name)
+ (database-identifier inner-name))))
+ ;; if this is a single name we can derefence it
+ (sql-ident-attribute
+ (with-slots (qualifier (inner-name name)) name
+ (if qualifier
+ (flatten-id name)
+ (database-identifier inner-name))))
+ (sql-ident
+ (with-slots ((inner-name name)) name
+ (database-identifier inner-name)))
+ ;; dont know how to handle this really :/
+ (%sql-expression (flatten-id name))
+ )))
+
+(defun %clsql-subclauses (clauses)
+ "a helper for dealing with lists of sql clauses"
+ (loop for c in clauses
+ when c
+ collect (typecase c
+ (string (clsql-sys:sql-expression :string c))
+ (T c))))
+
+(defun clsql-ands (clauses)
+ "Correctly creates a sql 'and' expression for the clauses
+ ignores any nil clauses
+ returns a single child expression if there is only one
+ returns an 'and' expression if there are many
+ returns nil if there are no children"
+ (let ((ex (%clsql-subclauses clauses)))
+ (when ex
+ (case (length ex)
+ (1 (first ex))
+ (t (apply #'clsql-sys:sql-and ex))))))
+
+(defun clsql-and (&rest clauses)
+ "Correctly creates a sql 'and' expression for the clauses
+ ignores any nil clauses
+ returns a single child expression if there is only one
+ returns an 'and' expression if there are many
+ returns nil if there are no children"
+ (clsql-ands clauses))
+
+(defun clsql-ors (clauses)
+ "Correctly creates a sql 'or' expression for the clauses
+ ignores any nil clauses
+ returns a single child expression if there is only one
+ returns an 'or' expression if there are many
+ returns nil if there are no children"
+ (let ((ex (%clsql-subclauses clauses)))
+ (when ex
+ (case (length ex)
+ (1 (first ex))
+ (t (apply #'clsql-sys:sql-or ex))))))
+
+(defun clsql-or (&rest clauses)
+ "Correctly creates a sql 'or' expression for the clauses
+ ignores any nil clauses
+ returns a single child expression if there is only one
+ returns an 'or' expression if there are many
+ returns nil if there are no children"
+ (clsql-ors clauses))