+(defclass %database-identifier ()
+ ((escaped :accessor escaped :initarg :escaped :initform nil)
+ (unescaped :accessor unescaped :initarg :unescaped :initform nil))
+ (:documentation
+ "A database identifier represents a string/symbol ready to be spliced
+ into a sql string. It keeps references to both the escaped and
+ unescaped versions so that unescaped versions can be compared to the
+ results of list-tables/views/attributes etc. It also allows you to be
+ sure that an identifier is escaped only once.
+
+ (escaped-database-identifiers *any-reasonable-object*) should be called to
+ produce a string that is safe to splice directly into sql strings.
+
+ (unescaped-database-identifier *any-reasonable-object*) is generally what
+ you pass to it with the exception that symbols have been
+ clsql-sys:sql-escape which converts to a string and changes - to _ (so
+ that unescaped can be compared to the results of eg: list-tables)
+ "))
+
+(defmethod escaped ((it null)) it)
+(defmethod unescaped ((it null)) it)
+
+(defun database-identifier-equal (i1 i2 &optional (database clsql-sys:*default-database*))
+ (setf i1 (database-identifier i1 database)
+ i2 (database-identifier i2 database))
+ (flet ((cast (i)
+ (if (symbolp (unescaped i))
+ (sql-escape (unescaped i))
+ (unescaped i))))
+ (or ;; check for an exact match
+ (equal (escaped-database-identifier i1)
+ (escaped-database-identifier i2))
+ ;; check for an inexact match if we had symbols in the mix
+ (string-equal (cast i1) (cast i2)))))
+
+(defun delistify-dsd (list)
+ "Some MOPs, like openmcl 0.14.2, cons attribute values in a list."
+ (if (and (listp list) (null (cdr list)))
+ (car list)
+ list))
+
+(defun special-char-p (s)
+ "Check if a string has any special characters"
+ (loop for char across s
+ thereis (find char '(#\space #\, #\. #\! #\@ #\# #\$ #\% #\' #\"
+ #\^ #\& #\* #\| #\( #\) #\- #\+ #\< #\>
+ #\{ #\}))))
+
+(defun %make-database-identifier (inp &optional database)
+ "We want to quote an identifier if it came to us as a string or if it has special characters
+ in it."
+ (labels ((%escape-identifier (inp &optional orig)
+ "Quote an identifier unless it is already quoted"
+ (cond
+ ;; already quoted
+ ((and (eql #\" (elt inp 0))
+ (eql #\" (elt inp (- (length inp) 1))))
+ (make-instance '%database-identifier :unescaped (or orig inp) :escaped inp))
+ (T (make-instance
+ '%database-identifier :unescaped (or orig inp) :escaped
+ (concatenate
+ 'string "\"" (replace-all inp "\"" "\\\"") "\""))))))
+ (typecase inp
+ (string (%escape-identifier inp))
+ (%database-identifier inp)
+ (symbol
+ (let ((s (sql-escape inp)))
+ (if (and (not (eql '* inp)) (special-char-p s))
+ (%escape-identifier (convert-to-db-default-case s database) inp)
+ (make-instance '%database-identifier :escaped s :unescaped inp)))))))
+
+(defun combine-database-identifiers (ids &optional (database clsql-sys:*default-database*)
+ &aux res all-sym? pkg)
+ "Create a new database identifier by combining parts in a reasonable way
+ "
+ (setf ids (mapcar #'database-identifier ids)
+ all-sym? (every (lambda (i) (symbolp (unescaped i))) ids)
+ pkg (when all-sym? (symbol-package (unescaped (first ids)))))
+ (labels ((cast ( i )
+ (typecase i
+ (null nil)
+ (%database-identifier (cast (unescaped i)))
+ (symbol
+ (if all-sym?
+ (sql-escape i)
+ (convert-to-db-default-case (sql-escape i) database)))
+ (string i)))
+ (comb (i1 i2)
+ (setf i1 (cast i1)
+ i2 (cast i2))
+ (if (and i1 i2)
+ (concatenate 'string (cast i1) "_" (cast i2))
+ (or i1 i2))))
+ (setf res (reduce #'comb ids))
+ (database-identifier
+ (if all-sym? (intern res pkg) res)
+ database)))
+
+(defun escaped-database-identifier (name &optional database find-class-p)
+ (escaped (database-identifier name database find-class-p)))
+
+(defun unescaped-database-identifier (name &optional database find-class-p)
+ (unescaped (database-identifier name database find-class-p)))
+
projects / clsql.git / commitdiff