X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Futils.lisp;h=6e4230d84d94486d8448cc9c84f9c89839bd47e4;hb=bab5e8056e3850cd9fb0582f73955aee5abf010b;hp=b43e3180e64f6f8d392446229660c6eed1caaab1;hpb=dc107d34212597ed1272cfa21138d384e71b00d2;p=clsql.git diff --git a/sql/utils.lisp b/sql/utils.lisp index b43e318..6e4230d 100644 --- a/sql/utils.lisp +++ b/sql/utils.lisp @@ -43,6 +43,7 @@ (defun float-to-sql-string (num) "Convert exponent character for SQL" (let ((str (write-to-string num :readably t))) + (declare (type string str)) (cond ((find #\f str) (substitute #\e #\f str)) @@ -125,6 +126,7 @@ (defun substitute-string-for-char (procstr match-char subst-str) "Substitutes a string for a single matching character of a string" + (declare (type string procstr)) (let ((pos (position match-char procstr))) (if pos (concatenate 'string @@ -166,6 +168,7 @@ (setq pos (1+ end)))) (defun string-to-list-connection-spec (str) + (declare (type string str)) (let ((at-pos (position-char #\@ str 0 (length str)))) (cond ((and at-pos (> (length str) at-pos)) @@ -392,3 +395,32 @@ is replaced with replacement. [FROM http://cl-cookbook.sourceforge.net/strings.h (unless stream (get-output-stream-string out)))) + +(defun filter-plist (plist &rest keys-to-remove) + "Returns a copy of the given plist with indicated key-value pairs +removed. keys are searched with #'MEMBER" + (declare (dynamic-extent keys-to-remove)) + (when plist + (loop for (k v . rest) = plist then rest + unless (member k keys-to-remove) + collect k and collect v + while rest))) + +(defmacro make-weak-hash-table (&rest args) + "Creates a weak hash table for use in a cache." + `(progn + + ;;NB: These are generally used for caches that may not have an alternate + ;;clearing mechanism. If you are on an implementation that doesn't support + ;;weak hash tables then you're memory may accumulate. + + #-(or sbcl allegro clisp lispworks) + (warn "UNSAFE! use of weak hash on implementation without support. (see clsql/sql/utils.lisp to add)") + + (make-hash-table + #+allegro :values #+allegro :weak + #+clisp :weak #+clisp :value + #+lispworks :weak-kind #+lispworks :value + #+sbcl :weakness #+sbcl :value + ,@args) + ))