use sql-value-list and sql-update-list

source/clog-data.lisp

@@ -44,12 +44,14 @@ upper cased before attempting to match it to a slot if :UPCASE-KEY t
 ;;;;;;;;;;;;;;;;;;;;;;
 
 (defun data-write-list (obj slot-name-list)
-  "Returns a list, one member for each slot name in SLOT-NAME-LIST. If
+  "Returns a list, one value for each slot name in SLOT-NAME-LIST. If
 a slot contains a CLOG-ELEMENT then TEXT-VALUE is used to retrieve the
-value. Slot names may be symbols or text (and will be upcased before
+value. Slot names may be symbols, keywords or text (and will be
-looking up symbol). All slot-names must be bound."
+upcased before looking up symbol). All slot-names must be bound."
   (let ((result))
     (dolist (slot (reverse slot-name-list))
+      (when (keywordp slot)
+	(setf slot (format nil "~A" slot)))
       (unless (symbolp slot)
 	(setf slot (find-symbol (string-upcase slot))))
       (if (and (slot-boundp obj slot)
@@ -58,19 +60,46 @@ looking up symbol). All slot-names must be bound."
 	  (push (slot-value obj slot) result)))
     result))
 
+;;;;;;;;;;;;;;;;;;;;;;;
+;;  data-write-plist ;;
+;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun data-write-plist (obj slot-name-list &key (keys-as-keywords t))
+  "Returns a plist, one member for each slot name in SLOT-NAME-LIST,
+the key is the slot name. If a slot contains a CLOG-ELEMENT then
+TEXT-VALUE is used to retrieve the value otherwise it is the
+slot-value. Slot names may be symbols, keywords, or text (and will be
+upcased before looking up symbol). All slot-names must be bound. If
+:KEYS-AS-KEYWORDS t (default) then the keys will be symbols in the
+keyword package."
+  (let ((result))
+    (dolist (slot (reverse slot-name-list))
+      (when (keywordp slot)
+	(setf slot (format nil "~A" slot)))
+      (unless (symbolp slot)
+	(setf slot (find-symbol (string-upcase slot))))
+      (if (and (slot-boundp obj slot)
+	       (typep (slot-value obj slot) 'clog:clog-element))
+	  (push (text-value (slot-value obj slot)) result)
+	  (push (slot-value obj slot) result))
+      (if keys-as-keywords
+	  (push (find-symbol (format nil "~A" slot) 'keyword) result)
+	  (push slot result)))
+    result))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation - simple sql writers
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;
-;; select-fields ;;
+;; sql-list ;;
-;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;
 
-(defun select-fields (field-list &key quote-all)
+(defun sql-list (field-list &key quote-all)
-  "Given list of fields return a string to use in a SQL select. Use a cons to
+  "Given list of fields returns a string for use in a SQL select and
-rename field if desired. Symbols are stringified first. If :QUOTE-ALL t then
+insert field lists. Use a cons to rename fields for selects if
-all fields are in quotes for use on case sensitive SQL dbms.
+desired. Symbols are stringified first. If :QUOTE-ALL t then all
- Eg. ((\"a\" \"index\") 'b :|c|) would return -> a as 'index', B, c"
+fields are in quotes."
   (let ((result))
     (dolist (field (reverse field-list))
       (if (consp field)
@@ -88,3 +117,47 @@ all fields are in quotes for use on case sensitive SQL dbms.
       (push field result))
     (format nil "~{~A~}" result)))
 
+;;;;;;;;;;;;;;;;;;;;
+;; sql-value-list ;;
+;;;;;;;;;;;;;;;;;;;;
+
+(defun sql-value-list (value-list)
+  "Given list of values returns a string for use in a SQL insert value
+list. If a value is a string it is quoted with single quotes
+(and single quotes qutoed by doubling) unless is the single
+character '?'."
+  (let ((result))
+    (dolist (value (reverse value-list))
+      (setf value (format nil "~A~A"
+			  (if (and (stringp value)
+				   (not (equal value "?")))
+			      (format nil "'~A'"
+				      (ppcre:regex-replace-all "'" value "''"))
+			      (format nil "~A" value))
+			  (if result ", " "")))
+    (push value result))
+  (format nil "~{~A~}" result)))
+
+;;;;;;;;;;;;;;;;;;;;;
+;; sql-update-list ;;
+;;;;;;;;;;;;;;;;;;;;;
+
+(defun sql-update-list (plist)
+  "Given plist of field names and values returns a string for use in a
+SQL update. If a value is a string it is quoted with single quotes
+(and single quotes qutoed by doubling) unless is the single
+character '?'."
+  (let ((result))
+    (loop for (key value) on plist by #'cddr while value 
+	  do
+	     (push (format nil "~A = ~A~A"
+			   key
+			   (if (and (stringp value)
+				    (not (equal value "?")))
+			       (format nil "'~A'"
+				       (ppcre:regex-replace-all "'" value "''"))
+			       (format nil "~A" value))
+			   (if result ", " ""))
+		   result))
+    (format nil "~{~A~}" result)))
+

source/clog.lisp

@@ -524,11 +524,14 @@ embedded in a native template application.)"
 
 (defsection @clog-data (:title "CLOG Data")
   "Load and Write to objects and CLOG-Elements"
-  (data-load-plist function)
+  (data-load-plist  function)
-  (data-write-list function)
+  (data-write-list  function)
+  (data-write-plist function)
 
   "SQL Writing Helpers"
-  (select-fields function))
+  (sql-list        function)
+  (sql-value-list  function)
+  (sql-update-list function))
 
 (defsection @clog-panels (:title "CLOG Panels")
   "CLOG-Panel - CLOG Panels"