X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=base%2Futils.lisp;h=8a96df6642846289ab4603f1449dda00cf95e9b7;hp=84e28b937bc77ff1fa69dfedf8990e853c22db31;hb=09f07ac9d914a83f9426609f3264f4e66b5a6d97;hpb=7fd52b8de887a2a328f78bddb6a2fb4230ef2b3a diff --git a/base/utils.lisp b/base/utils.lisp index 84e28b9..8a96df6 100644 --- a/base/utils.lisp +++ b/base/utils.lisp @@ -16,7 +16,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base-sys) +(in-package #:clsql-base) (defun number-to-sql-string (num) (etypecase num @@ -257,23 +257,6 @@ returns (VALUES string-output error-output exit-status)" )) -(eval-when (:compile-toplevel :load-toplevel :execute) - (when (char= #\a (schar (symbol-name '#:a) 0)) - (pushnew :lowercase-reader *features*))) - -(defun string-default-case (str) - #-lowercase-reader - (string-upcase str) - #+lowercase-reader - (string-downcase str)) - -;; From KMRCL -(defun ensure-keyword (name) - "Returns keyword for a name" - (etypecase name - (keyword name) - (string (nth-value 0 (intern (string-default-case name) :keyword))) - (symbol (nth-value 0 (intern (symbol-name name) :keyword))))) ;; From KMRCL (defmacro in (obj &rest choices) @@ -331,3 +314,30 @@ list of characters and replacement strings." (setf (char new-string dpos) c) (incf dpos)))))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (when (char= #\a (schar (symbol-name '#:a) 0)) + (pushnew :lowercase-reader *features*))) + +(defun symbol-name-default-case (str) + #-lowercase-reader + (string-upcase str) + #+lowercase-reader + (string-downcase str)) + +(defun convert-to-db-default-case (str database) + (if database + (case (db-type-default-case (database-underlying-type database)) + (:upper (string-upcase str)) + (:lower (string-downcase str)) + (t str)) + ;; Default CommonSQL behavior is to upcase strings + (string-upcase str))) + + +(defun ensure-keyword (name) + "Returns keyword for a name" + (etypecase name + (keyword name) + (string (nth-value 0 (intern (symbol-name-default-case name) :keyword))) + (symbol (nth-value 0 (intern (symbol-name name) :keyword)))))