X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Futils.lisp;h=12d5d286b5024116360e92a9319adc688a7136db;hb=f5b49cfe271f8c467f74002eaf27e1d93409cdc5;hp=d5b31ed4fd1678862294132dfd7bee98e95c6ee8;hpb=ab6923bf84f595fb61eb0107f97ce143ca92db57;p=clsql.git diff --git a/sql/utils.lisp b/sql/utils.lisp index d5b31ed..12d5d28 100644 --- a/sql/utils.lisp +++ b/sql/utils.lisp @@ -16,6 +16,22 @@ (in-package #:clsql-sys) +(defmacro defaulting (&rest place-value-plist) + `(progn + ,@(loop for (place value . rest) on place-value-plist by #'cddr + collect `(unless ,place (setf ,place ,value))))) + +(defun %get-int (v) + (etypecase v + (string (parse-integer v :junk-allowed t)) + (integer v) + (number (truncate v)))) + +(defun dequote (it) + (if (and (listp it) (eql (first it) 'quote)) + (second it) + it)) + (defvar +whitespace-chars+ '(#\space #\tab #\newline #\return ;; Tested: sbcl unicode, allegrocl, openmcl,clisp use #\no-break_space @@ -426,3 +442,27 @@ removed. keys are searched with #'MEMBER" #+sbcl :weakness #+sbcl :value ,@args) )) + +(defun to-slot-name (slot) + "try to turn what we got representing the slot into a slot name" + (etypecase slot + (symbol slot) + (slot-definition (slot-definition-name slot)))) + +(defun to-class (it) + (etypecase it + (class it) + (symbol (find-class it)) + (standard-object (class-of it)))) + +(defun easy-slot-value (obj slot) + "like slot-value except it accepts slot-names or defs + and returns nil when the slot is unbound" + (let ((n (to-slot-name slot))) + (when (and obj (slot-boundp obj n)) + (slot-value obj n)))) + +(defun (setf easy-slot-value) (new obj slot) + "like slot-value except it accepts slot-names or defs" + (setf (slot-value obj (to-slot-name slot)) new)) +