X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Futils.lisp;h=d5b31ed4fd1678862294132dfd7bee98e95c6ee8;hb=f1d668746523a72a6893a46380468a9e033545e4;hp=7f307d63d2da32ce1c8a646df1cbd8b68ca432f9;hpb=925a29060928f773d4bc7d8e6bdd13c97e0ef65a;p=clsql.git

diff --git a/sql/utils.lisp b/sql/utils.lisp
index 7f307d6..d5b31ed 100644
--- a/sql/utils.lisp
+++ b/sql/utils.lisp
@@ -125,15 +125,17 @@
   (substitute-string-for-char s #\' "''"))
 
 (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
-          (subseq procstr 0 pos) subst-str
-          (substitute-string-for-char
-           (subseq procstr (1+ pos)) match-char subst-str))
-      procstr)))
+  "Substitutes a string for a single matching character of a string"
+  (when procstr
+    (locally
+        (declare (type string procstr))
+      (let ((pos (position match-char procstr)))
+        (if pos
+            (concatenate 'string
+                         (subseq procstr 0 pos) subst-str
+                         (substitute-string-for-char
+                          (subseq procstr (1+ pos)) match-char subst-str))
+            procstr)))))
 
 
 (defun position-char (char string start max)
@@ -393,4 +395,34 @@ is replaced with replacement. [FROM http://cl-cookbook.sourceforge.net/strings.h
 	  when pos do (write-string replacement out)
 	    while pos)
     (unless stream
-      (get-output-stream-string out))))
\ No newline at end of file
+      (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)
+    ))