X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fexpressions.lisp;h=8b6167ba2c71f22ba288835e0699a04f554d9431;hp=7a8c11a6b226d1202ad6158830a4f0a8fd701676;hb=d858cb15ce270fc5d1ad58abd651ba1864979e9f;hpb=3b7cb72a2117fe5e4599da811c9e2821de02824b diff --git a/sql/expressions.lisp b/sql/expressions.lisp index 7a8c11a..8b6167b 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -68,6 +68,14 @@ #\^ #\& #\* #\| #\( #\) #\- #\+ #\< #\> #\{ #\})))) +(defun special-cased-symbol-p (sym) + "Should the symbols case be preserved, or should we convert to default casing" + (let ((name (symbol-name sym))) + (case (readtable-case *readtable*) + (:upcase (not (string= (string-upcase name) name))) + (:downcase (not (string= (string-downcase name) name))) + (t t)))) + (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." @@ -88,8 +96,12 @@ (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))))))) + (%escape-identifier + (if (special-cased-symbol-p inp) + s + (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) @@ -237,6 +249,10 @@ (declare (ignore sql)) nil) +(defmethod collect-table-refs ((sql list)) + (loop for i in sql + appending (listify (collect-table-refs i)))) + (defmethod collect-table-refs ((sql sql-ident-attribute)) (let ((qual (slot-value sql 'qualifier))) (when qual @@ -274,6 +290,9 @@ sql `(make-instance 'sql-ident-table :name ',name :table-alias ',alias))) +(defmethod collect-table-refs ((sql sql-ident-table)) + (list sql)) + (defmethod output-sql ((expr sql-ident-table) database) (with-slots (name alias) expr (flet ((p (s) ;; the etypecase is in sql-escape too @@ -1170,3 +1189,51 @@ uninclusive, and the args from that keyword to the end." (%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)) +