Handle unquoted values for field lists in clog-data

source/clog-data.lisp

@@ -153,23 +153,34 @@ stringified first. If :QUOTE-ALL t then all fields are in quotes."
       (push field result))
     (format nil "~{~A~}" result)))
 
+;;;;;;;;;;;;;;;
+;; sql-quote ;;
+;;;;;;;;;;;;;;;
+
+(defun sql-quote (value)
+  "Returns value single quoted if string (single quote quoted by doubling)
+unless is the single character '?'. If value is a list the car is returned
+unquoted"
+  (cond ((and (stringp value)
+	      (not (equal value "?")))
+	 (format nil "'~A'"
+		 (ppcre:regex-replace-all "'" value "''")))
+	((consp value)
+	 (car value))
+	(t
+	 value)))
+
 ;;;;;;;;;;;;;;;;;;;;
 ;; 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 '?'."
+  "Given list of values each passed to SQL-QUOTE returns a string for
+use in a SQL insert value list."
   (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))
+			  (sql-quote value)
 			  (if result ", " "")))
     (push value result))
   (format nil "~{~A~}" result)))
@@ -179,10 +190,9 @@ character '?'."
 ;;;;;;;;;;;;;;;;;;;;;
 
 (defun sql-update-list (plist)
-  "Given plist of field names and values returns a string for use in a
-SQL update. if the 'key' is a cons the first 'key' used. If a value
-is a string it is quoted with single quotes (and single quotes qutoed
-by doubling) unless is the single character '?'."
+  "Given plist of field names and values each passed to SQL-QUOTE and
+returns a string for use in a SQL update. if the 'key' is a cons the
+first 'key' used."
   (let ((result))
     (loop for (key value) on plist by #'cddr while value
 	  do
@@ -190,11 +200,7 @@ by doubling) unless is the single character '?'."
 			   (if (consp key)
 			       (car key)
 			       key)
-			   (if (and (stringp value)
-				    (not (equal value "?")))
-			       (format nil "'~A'"
-				       (ppcre:regex-replace-all "'" value "''"))
-			       (format nil "~A" value))
+			   (sql-quote value)
 			   (if result ", " ""))
 		   result))
     (format nil "~{~A~}" result)))

source/clog-web-dbi.lisp

@@ -21,6 +21,7 @@
   (get-profile        function)
   (sign-up            function)
   (make-token         function)
+  (load-content       function)
   (create-base-tables function))
 
 ;;;;;;;;;;;;;;;;;
@@ -135,11 +136,37 @@ if one is present and login fails."
   (dbi:do-sql
     sql-connection
     "create table config (key varchar, value varchar)")
+  (dbi:do-sql
+    sql-connection
+    (format nil "create table content (key varchar, value varchar, parent varchar, title varchar, username varchar, createdate date)"))
+  (dbi:do-sql
+    sql-connection
+    "create table tags (key varchar, value varchar, category varchar)")
   (dbi:do-sql
     sql-connection
     "create table users (username varchar, password varchar, token varchar)")
+  (dbi:do-sql
+    sql-connection
+    (sql-insert* "content" '(:key        "main"
+			     :value      "<h3>Welcome to CLOG</h3>"
+			     :createdate ("date()"))))
   (dbi:do-sql
     sql-connection
     (sql-insert* "users" `(:username "admin"
 			   :password "admin"
 			   :token    ,(make-token)))))
+
+;;;;;;;;;;;;;;;;;;
+;; load-content ;;
+;;;;;;;;;;;;;;;;;;
+
+(defun load-content (sql-connection table key-value &key (key-col "key"))
+  "Returns list of records found in TABLE where KEY-COL = KEY-VALUE"
+  (let ((contents (dbi:fetch-all
+		   (dbi:execute
+		    (dbi:prepare
+		     sql-connection
+		     (format nil "select * from ~A where ~A=?"
+			     table key-col))
+		    (list key-value)))))
+    contents))

source/clog.lisp

@@ -535,6 +535,7 @@ embedded in a native template application.)"
   (data-write-plist function)
 
   "SQL Writing Helpers"
+  (sql-quote       function)
   (sql-field-list  function)
   (sql-value-list  function)
   (sql-update-list function)