mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

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

Browse source
This commit is contained in:
David Botton 2022-02-20 16:45:19 -05:00
parent 43c4c58531
commit ecb3913edb
2 changed files with 90 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

95
source/clog-data.lisp
View file

@ -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
looking up symbol). All slot-names must be bound."
value. Slot names may be symbols, keywords or text (and will be
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)
"Given list of fields return a string to use in a SQL select. Use a cons to
rename field if desired. Symbols are stringified first. If :QUOTE-ALL t then
all fields are in quotes for use on case sensitive SQL dbms.
Eg. ((\"a\" \"index\") 'b :|c|) would return -> a as 'index', B, c"
(defun sql-list (field-list &key quote-all)
"Given list of fields returns a string for use in a SQL select and
insert field lists. Use a cons to rename fields for selects if
desired. Symbols are stringified first. If :QUOTE-ALL t then all
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)))

5
source/clog.lisp
View file

@ -526,9 +526,12 @@ embedded in a native template application.)"
"Load and Write to objects and CLOG-Elements"
(data-load-plist 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"