diff options
| -rw-r--r-- | org-ckons-sql.asd | 39 | ||||
| -rw-r--r-- | src/database.lisp | 8 | ||||
| -rw-r--r-- | src/generics.lisp | 244 | ||||
| -rw-r--r-- | src/postgres-record.lisp | 37 | ||||
| -rw-r--r-- | src/record-pkg.lisp | 45 | ||||
| -rw-r--r-- | src/record.lisp | 269 |
6 files changed, 642 insertions, 0 deletions
diff --git a/org-ckons-sql.asd b/org-ckons-sql.asd new file mode 100644 index 0000000..b1bb5c0 --- /dev/null +++ b/org-ckons-sql.asd @@ -0,0 +1,39 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :cl) + +(defpackage :org-ckons-sql-system (:use :cl :asdf)) +(in-package :org-ckons-sql-system) + +(defmacro do-defsystem (&key name version maintainer author description long-description depends-on components) + `(defsystem ,name + :name ,name + :version ,version + :maintainer ,maintainer + :author ,author + :description ,description + :long-description ,long-description + :depends-on ,(eval depends-on) + :components ,components)) + +(defparameter *quicklisp-packages* '(postmodern cl-ppcre simple-date simple-date/postgres-glue local-time)) +(defparameter *asdf-packages* '(org-ckons-core org-ckons-serializable)) +(defparameter *all-packages* (append *quicklisp-packages* *asdf-packages*)) + +(loop for pkg in *quicklisp-packages* do + (ql:quickload (symbol-name pkg))) + +(do-defsystem :name "org-ckons-sql" + :version "1" + :maintainer "Carlos Konstanski <me@ckons.org>" + :author "Carlos Konstanski <me@ckons.org>" + :description "org-ckons-sql" + :long-description "org-ckons-sql is a library which provides a PostgreSQL interface and entity framework. It uses the third-party postmodern library." + :depends-on *all-packages* + :components ((:module src + :components ((:file "generics") + (:file "database" :depends-on ("generics")) + (:file "record" :depends-on ("database")) + (:file "postgres-record" :depends-on ("record")) + (:file "record-pkg" :depends-on ("postgres-record")))))) diff --git a/src/database.lisp b/src/database.lisp new file mode 100644 index 0000000..3762bc9 --- /dev/null +++ b/src/database.lisp @@ -0,0 +1,8 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :org-ckons-sql) + +(defmacro with-database (db &body body) + `(postmodern:with-connection ,db + ,@body)) diff --git a/src/generics.lisp b/src/generics.lisp new file mode 100644 index 0000000..59dbc12 --- /dev/null +++ b/src/generics.lisp @@ -0,0 +1,244 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(defpackage :org-ckons-sql + (:use :cl) + (:export :id + :*project + :*table + :*where-expression + :record + :postgres-record + :record-pkg + :get-record + :get-records + :insert-record + :update-record + :delete-record + :call-pg-function + :intersect-slots + :slot-is-field-p + :simple-date-to-date + :sanitize-json + :with-database)) + +(in-package :org-ckons-sql) + +(defgeneric to-date (record date-string) + (:documentation "In PostgreSQL, a string in the format `YYYY-MM-DD +HH:MM:SS' can be used directly to populate a date field. Therefore, +this function does nothing except to put quotes arount the value.")) + +(defgeneric sanitize (record field) + (:documentation "If `field' is a lisp `nil', returns `NULL'. Also +converts datestrings to a PLSQL to_date() function call, converts +numbers to oracle-friendly representations, and puts single ticks +around string values. All munging, workarounds, hacks, etc. to make +the interface between lisp and PostgreSQL work better should be done +here.")) + +(defgeneric call-pg-function* (record) + (:documentation "Calls a Postgresql function that returns something +other than a result set that matches up with the passed-in `record' +which is always a postgresql-record, or returns nothing at all.")) + +(defgeneric field-names-string (record) + (:documentation "Builds a string of SQL query field names.")) + +(defgeneric field-values-string (record) + (:documentation "Builds a string of SQL query values to match the +field names returned by `field-names-string'.")) + +(defgeneric field-value-pairs (record) + (:documentation "Builds a string of SQL query field/value pairs.")) + +(defgeneric field-value-pairs-no-nulls (record) + (:documentation "Builds a string of SQL query field/value pairs, but +only those fields with a non-null value are included.")) + +(defgeneric field-value-list (record) + (:documentation "Builds a list of SQL query field/value pairs, but +only those fields with a non-null value are included.")) + +(defgeneric field-value-list-no-nulls (record) + (:documentation "Builds a list of SQL query field/value pairs, but +only those fields with a non-null value are included.")) + +(defgeneric field-plist-no-nulls (record) + (:documentation "Returns the non-null field slots of `record' as a +plist. Used for record serialization.")) + +(defgeneric build-where-clause (record) + (:documentation "Builds a WHERE clause from the non-nil slots in +`record'.")) + +(defgeneric intersect-slots (record slots) + (:documentation "Since the built-in `intersect' function does not +take package name prefixes into account, and since `map-slot-names' +returns slot names prefixed with the package name, this method was +written to intersect lists ignoring package prefixes.")) + +(defgeneric expand-where-expression (record where-expression) + (:documentation "All WHERE clauses must pass through this method. +If the WHERE clause contains all hard-coded values, then it will make +it through untouched. If it contains ~a placeholders, it will be +parsed and expanded using the values contained in `record'. Finally +the WHERE keyword is prepended.")) + +(defgeneric insert-query (record) + (:documentation "Builds an INSERT query to save the state of +`record' in the database. Does not include `nil' slots.")) + +(defgeneric currval-query (record) + (:documentation "Calls currval() to get the last inserted ID. This +must be called with the same database connection that performed the +prior INSERT, and `record' must have a `*table' that can be used as +the first arguemnt to pg_get_serial_sequence().")) + +(defgeneric update-query (record) + (:documentation "Builds an UPDATE query to save the state of +`record' in the database.")) + +(defgeneric select-query (record) + (:documentation "Builds a SELECT query to retrieve the state of +`record' from the database.")) + +(defgeneric delete-query (record) + (:documentation "Builds a DELETE query to to delete a `record' from +the database. CAUTION: use this only on `record' objects whose +backend tables are real tables, not inlined table functions.")) + +(defgeneric insert-record* (record) + (:documentation "Inserts the state of `record' into the database, +and fetches the newly-created ID into the `id' slot of `record'.")) + +(defgeneric update-record* (record) + (:documentation "Saves the state of `record' to the database.")) + +(defgeneric select-records-impl* (record where-clause order-by-clause) + (:documentation "Low-level function which is to be called via +`select-records'. Executes a SELECT statement with the given WHERE +clause and ORDER BY clause. Do not include the WHERE and ORDER BY +keywords in your arguments, as they will be automatically +prepended.")) + +(defgeneric select-records* (record order-by-clause) + (:documentation "High-level interface to `select-records-impl'. +Executes a SELECT statement with the given ORDER BY clause, with a +WHERE clause automatically built by AND-separating the name/values +stored in `record', and fetches the result set of the query into a +list of `record' objects. Do not include the ORDER BY keyword in +`order-by-clause', as it will be automatically prepended.")) + +(defgeneric select-records-where* (record where-expression order-by-clause) + (:documentation "High-level interface to `select-records-impl'. +Executes a SELECT statement with the given WHERE clause and ORDER BY +clause. `where-expression' is a FORMAT-style string which uses ~a for +value placeholders. The slots of `record' that correspond to the +field names in `where-expression' are used to fill in the +placeholders. Fetches the result set of the query into a list of +`record' objects. Do not include the WHERE and ORDER BY keywords in +`where-expression' and `order-by-clause', as they will be +automatically prepended.")) + +(defgeneric delete-records-impl* (record where-expression) + (:documentation "Low-level function which is to be called via +`delete-records'. Executes a DELETE statement with the given WHERE +clause. Do not include the WHERE keyword in your argument, as this +method automatically prepends it.")) + +(defgeneric delete-record* (record) + (:documentation "High-level interface to `delete-records-impl'. +Convenience function for deleting records by `id'. record' must +conform to a certain standard pattern. Executes a DELETE statement +with a WHERE clause built with `*where-expression' and `id'. Assumes +that `*where-expression' is the format string id = ~a.")) + +(defgeneric delete-records* (record) + (:documentation "High-level interface to `delete-records-impl'. +Executes a DELETE statement with a WHERE clause automatically built by +AND-separating the name/values stored in `record'.")) + +(defgeneric delete-records-where* (record where-expression) + (:documentation "High-level interface to `delete-records-impl'. +Executes a DELETE statement with the given WHERE clause. +`where-expression' is a FORMAT-style string which uses ~a for value +placeholders. The slots of `record' that correspond to the field +names in `where-expression' are used to fill in the placeholders.Do +not include the WHERE keyword in `where-expression', as it will be +automatically prepended.")) + +(defgeneric load-record (record row) + (:documentation "Populates the slots of the `record' subclass from +the fields in `row', which are usually obtained by running a SELECT +query.")) + +(defgeneric sanitize-json (record-or-service) + (:documentation "Untaints the record or service object so that it's +safe to serialize into JSON.")) + +(defgeneric insert-record (record-pkg record) + (:documentation "Inserts a new record into the table associated with +`record', using the data from `record'.")) + +(defgeneric update-record (record-pkg record) + (:documentation "Updates an existing record in the table associated +with `record', using the data from `record'.")) + +(defgeneric delete-record (record-pkg record) + (:documentation "Deletes an existing record in the table associated +with `record', using `id' and `*where-expression' from `record'.")) + +(defgeneric delete-records (record-pkg record) + (:documentation "Deletes an existing record in the table associated +with `record', using the data from `record'.")) + +(defgeneric delete-records-where (record-pkg record where-expression) + (:documentation "Updates an existing record in the table associated +with `record', using the passed-in `where-expression'.")) + +(defgeneric get-records (record-pkg record order-by-clause) + (:documentation "All-purpose method for issuing a SELECT statement +to obtain a result set of `record' objects. The instance of `record' +passed into this method is used to hold input parameters, including +the table name. Any slots that are populated with a non-nil value +will be used in the AND-separated WHERE clause. Fetches the result +set of the query into a list of `record' objects.")) + +(defgeneric get-records-where (record-pkg record where-expression order-by-clause) + (:documentation "All-purpose method for issuing a SELECT statement +to obtain a result set of `record' objects. The instance of `record' +passed into this method is used to hold input parameters, including +the table name. `where-expression' is a FORMAT-style string which +uses ~a for value placeholders. The slots of `record' that correspond +to the field names in `where-expression' are used to fill in the +placeholders. Fetches the result set of the query into a list of +`record' objects.")) + +(defgeneric get-record (record-pkg record) + (:documentation "Returns a single `record' object. The instance of +`record' passed into this method is used to hold input parameters, +including the table name. Any slots that are populated with a non-nil +value will be used in the AND-separated WHERE clause. Meant for +queries that return only one unique row. Returns `nil' if no rows +were found matching the query. Warning: if more than one row is +returned by the query, this method will return the first one. Note +that you cannot control which row will be first because of the lack of +an ORDER BY clause. Use this only for queries that are supposed to +return no more than one row.")) + +(defgeneric get-record-where (record-pkg record where-expression) + (:documentation "Returns a single `record' object. The instance of +`record' passed into this method is used to hold input parameters, +including the table name. `where-expression' is a FORMAT-style string +which uses ~a for value placeholders. The slots of `record' that +correspond to the field names in `where-expression' are used to fill +in the placeholders. Meant for queries that return only one unique +row. Returns `nil' if no rows were found matching the query. +Warning: if more than one row is returned by the query, this method +will return the first one. Note that you cannot control which row +will be first because of the lack of an ORDER BY clause. Use this +only for queries that are supposed to return no more than one row.")) + +(defgeneric call-pg-function (record-pkg postgresql-record) + (:documentation "")) diff --git a/src/postgres-record.lisp b/src/postgres-record.lisp new file mode 100644 index 0000000..5115a68 --- /dev/null +++ b/src/postgres-record.lisp @@ -0,0 +1,37 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :org-ckons-sql) + +(defclass postgres-record (record) ()) + +(defun sysdate () + (simple-date-to-date (caar (execute-query (format nil "select now()"))))) + +(defun date-or-nothing (value) + (handler-case + (simple-date-to-date value) + (error (e) + (declare (ignore e)) + nil))) + +(defmethod to-date ((postgres-record postgres-record) date-string) + (quote-string date-string)) + +(defmethod sanitize ((postgres-record postgres-record) field) + (cond ((numberp field) + (if (integerp field) + (format nil "~a" (parse-integer (format nil "~a" field) :junk-allowed t)) + (org-ckons-core::real-to-string field :places 4))) + ((org-ckons-core::null-or-empty-p field) + "NULL") + ((stringp field) + (cond ((org-ckons-core::match-it "^\\d\\d\\d\\d-\\d\\d-\\d\\d \\d\\d:\\d\\d:\\d\\d" field) + (to-date postgres-record field)) + (t + (quote-string field)))) + (t + field))) + +(defmethod call-pg-function* ((postgres-record postgres-record)) + (execute-query (format nil "select * from ~a" (*table postgres-record)))) diff --git a/src/record-pkg.lisp b/src/record-pkg.lisp new file mode 100644 index 0000000..7a5ceb2 --- /dev/null +++ b/src/record-pkg.lisp @@ -0,0 +1,45 @@ +*;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :org-ckons-sql) + +(defclass record-pkg () + () + (:documentation "The superclass for all `pkg' classes.")) + +(defmethod insert-record ((record-pkg record-pkg) (record record)) + (insert-record* record)) + +(defmethod update-record ((record-pkg record-pkg) (record record)) + (update-record* record)) + +(defmethod delete-record ((record-pkg record-pkg) (record record)) + (delete-record* record)) + +(defmethod delete-records ((record-pkg record-pkg) (record record)) + (delete-records* record)) + +(defmethod delete-records-where ((record-pkg record-pkg) (record record) where-expression) + (delete-records-where* record where-expression)) + +(defmethod get-records ((record-pkg record-pkg) (record record) order-by-clause) + (select-records* record order-by-clause)) + +(defmethod get-records-where ((record-pkg record-pkg) (record record) where-expression order-by-clause) + (select-records-where* record where-expression order-by-clause)) + +(defmethod get-record ((record-pkg record-pkg) (record record)) + (let ((record-list (get-records record-pkg record nil))) + (when (not (org-ckons-core::null-or-empty-p record-list)) + (car record-list)))) + +(defmethod get-record-where ((record-pkg record-pkg) (record record) where-expression) + (let ((record-list (get-records-where record-pkg record where-expression nil))) + (when (org-ckons-core::null-or-empty-p record-list) + (car record-list)))) + +(defmethod get-records-where ((record-pkg record-pkg) (record record) where-expression order-by-clause) + (select-records-where* record where-expression order-by-clause)) + +(defmethod call-pg-function ((record-pkg record-pkg) (postgres-record postgres-record)) + (call-pg-function* postgres-record)) diff --git a/src/record.lisp b/src/record.lisp new file mode 100644 index 0000000..31d7f50 --- /dev/null +++ b/src/record.lisp @@ -0,0 +1,269 @@ + ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :org-ckons-sql) + +(defclass record (org-ckons-serializable::serializable) + ((*project :initarg :*project + :initform nil + :accessor *project) + (*table :initarg :*table + :initform (error "Subclasses of RECORD must supply an initform for the *TABLE slot.") + :accessor *table) + (*where-expression :initarg :*where-expression + :initform (error "Subclasses of RECORD must supply an initform for the *WHERE-EXPRESSION slot.") + :accessor *where-expression + :documentation "A string that specifies a WHERE +clause that is the proper format to feed through +`expand-where-expression'. `nil' if the `record' subclass is +read-only, as would be the case if the backing table is a view, or a +table that you do not ever want to write to.")) + (:documentation "Superclass for all sql record objects. Since some +`record' subclasses are also `session' subclasses, `record' is +sometimes involved in multiple inheritance. + +`record' is not 100% ready to be used directly as a superclass of a +concrete entity object. We need a few more methods than what `record' +alone supplies: + +`sysdate' +`to-date' +`sanitize' + +See `postgres-record' as an example of their implementations. All +`record' subclasses are really direct subclasses of one of these +database-specific variants.")) + +(defmacro with-record-slots-to-string (record &rest body) + "Iterates over all the slots of `record', and builds a string based +on those slots. The action taken on each slot is completely +customizable; this macro only provides the loop. It is assumed that +the fencepost problem will creep into your string, so this macro trims +the last character." + `(let ((record-slot-string (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t))) + (with-output-to-string (stream record-slot-string) + (loop for slot in (org-ckons-core::map-slot-names ,record) do + (when (slot-is-field-p slot) ,@body))) + (org-ckons-core::trim-last-char record-slot-string))) + +(defmacro with-record-slots-to-list (record &rest body) + "Iterates over all the slots of `record', and builds an alist based +on those slots." + `(remove-if 'null (mapcar (lambda (slot) + (when (slot-is-field-p slot) + ,@body)) + (org-ckons-core::map-slot-names ,record)))) + +;; (defmethod id ((record record)) +;; (car (remove-if 'null (mapcar (lambda (slot) +;; (when (string= (org-ckons-core::parse-slot slot) "ID") +;; (slot-value record slot))) +;; (org-ckons-core::map-slot-names record))))) + +;; (defmethod (setf id) (value (record record)) +;; (loop for slot in (org-ckons-core::map-slot-names record) do +;; (when (string= (org-ckons-core::parse-slot slot) "ID") +;; (setf (slot-value record slot) value)))) + +(defmethod field-names-string ((record record)) + (with-record-slots-to-string record (format stream "~a," slot))) + +(defmethod field-values-string ((record record)) + (with-record-slots-to-string record (format stream "~a," (sanitize record (slot-value record slot))))) + +(defmethod field-value-pairs ((record record)) + (with-record-slots-to-string record (format stream "~a = ~a," slot (sanitize record (slot-value record slot))))) + +(defmethod field-value-pairs-no-nulls ((record record)) + (with-record-slots-to-string record (when (slot-value record slot) + (format stream "~a = ~a," slot (sanitize record (slot-value record slot)))))) + +(defmethod field-value-list ((record record)) + (with-record-slots-to-list record `(,slot . ,(slot-value record slot)))) + +(defmethod field-value-list-no-nulls ((record record)) + (with-record-slots-to-list record (when (slot-value record slot) + `(,slot . ,(slot-value record slot))))) + +(defmethod field-plist-no-nulls ((record record)) + (let ((field-plist ())) + (loop for field in (field-value-list-no-nulls record) do + (setf field-plist (append field-plist `(,(intern (format nil "~a" (car field)) "KEYWORD") ,(cdr field))))) + field-plist)) + +(defmethod build-where-clause ((record record)) + (if (field-value-list-no-nulls record) + (reduce (lambda (x y) + (format nil "~a AND ~a" x y)) + (mapcar (lambda (slot-cons) + (format nil "~a = ~a" (car slot-cons) (sanitize record (cdr slot-cons)))) + (field-value-list-no-nulls record))) + nil)) + +(defmethod intersect-slots ((record record) slots) + (let ((intersect-slots ())) + (loop for class-slot in (org-ckons-core::map-slot-names record) do + (let ((class-slot-string (org-ckons-core::parse-slot class-slot))) + (loop for arg-slot in slots do + (let ((arg-slot-string (org-ckons-core::parse-slot arg-slot))) + (when (string= class-slot-string arg-slot-string) + (push class-slot intersect-slots)))))) + (nreverse intersect-slots))) + +(defmethod expand-where-expression ((record record) where-expression) + (if (org-ckons-core::null-or-empty-p where-expression) + "" + (let ((field-names (nreverse (remove-if (lambda (x) + (or (org-ckons-core::null-or-empty-p x) + (equal x "LIKE") + (equal x "NOT"))) + (ppcre:split "[ ()!=<>,]" where-expression)))) + (slots ()) + (slot-values ())) + (let ((field-name-impending-p nil)) + (loop for field-name in field-names do + (cond (field-name-impending-p + (push (intern (string-upcase field-name)) slots) + (setf field-name-impending-p nil)) + (t + (when (ppcre:all-matches-as-strings "~a" field-name) + (setf field-name-impending-p t)))))) + (loop for slot in (intersect-slots record slots) do + (when (slot-is-field-p slot) + (push (sanitize record (slot-value record slot)) slot-values))) + (org-ckons-core::format-list (concatenate 'string " WHERE " where-expression) (reverse slot-values))))) + +(defmethod insert-query ((record record)) + (let* ((field-value-alist (field-value-list-no-nulls record))) + (format nil + "INSERT INTO ~a (~a) VALUES (~a)" + (org-ckons-core::format-list (if (slot-exists-p record '*write-table) (slot-value record '*write-table) (slot-value record '*table)) `(,(*project record))) + (org-ckons-core::reduce-to-comma-separated-string (mapcar (lambda (pair) + (car pair)) + field-value-alist)) + (org-ckons-core::reduce-to-comma-separated-string (mapcar (lambda (pair) + (sanitize record (cdr pair))) + field-value-alist))))) + +(defmethod currval-query ((record record)) + (format nil "SELECT * from currval(pg_get_serial_sequence('~a', 'id'))" (*table record))) + +(defmethod update-query ((record record)) + (if (null (*where-expression record)) + (error 'org-ckons-condition::handled-error (format nil "Attempting to update a record of type ~a, but it has no *WHERE-EXPRESSION" (type-of record))) + (format nil + "UPDATE ~a SET ~a~a" + (org-ckons-core::format-list (if (slot-exists-p record '*write-table) (slot-value record '*write-table) (slot-value record '*table)) `(,(*project record))) + (field-value-pairs record) + (expand-where-expression record (*where-expression record))))) + +(defmethod select-query ((record record)) + (format nil + "SELECT ~a FROM ~a" + (field-names-string record) + (org-ckons-core::format-list (*table record) `(,(*project record))))) + +(defmethod delete-query ((record record)) + (format nil + "DELETE FROM ~a" + (org-ckons-core::format-list (if (slot-exists-p record '*write-table) + (slot-value record '*write-table) + (slot-value record '*table)) + `(,(*project record))))) + +(defmethod insert-record* ((record record)) + (execute-command (insert-query record)) + (setf (id record) (caar (execute-query (currval-query record))))) + +(defmethod update-record* ((record record)) + (execute-command (update-query record))) + +(defmethod select-records-impl* ((record record) where-expression order-by-clause) + (let* ((where-string (expand-where-expression record where-expression)) + (order-by-string (if (org-ckons-core::null-or-empty-p order-by-clause) + "" + (format nil " ORDER BY ~a" order-by-clause))) + (sql-query (format nil + "~a~a~a" + (select-query record) + where-string + order-by-string))) + (execute-query sql-query))) + +(defmethod select-records* ((record record) order-by-clause) + (select-records-where* record (build-where-clause record) order-by-clause)) + +(defmethod select-records-where* ((record record) where-expression order-by-clause) + (let* ((result-set (select-records-impl* record where-expression order-by-clause)) + (records ())) + (loop for row in result-set do + (let ((my-record (make-instance (type-of record)))) + (load-record my-record row) + (push my-record records))) + (nreverse records))) + +(defmethod delete-records-impl* ((record record) where-expression) + (let* ((where-string (expand-where-expression record where-expression)) + (sql-query (format nil "~a~a" (delete-query record) where-string))) + (execute-command sql-query))) + +(defmethod delete-record* ((record record)) + (delete-records-where* record (format nil (*where-expression record) (id record)))) + +(defmethod delete-records* ((record record)) + (delete-records-where* record (build-where-clause record))) + +(defmethod delete-records-where* ((record record) where-expression) + (delete-records-impl* record where-expression)) + +(defmethod load-record ((record record) row) + (loop for slot in (org-ckons-core::map-slot-names record) do + (when (slot-is-field-p slot) + (eval `(setf (,slot ,record) ,(pop row)))))) + +(defmethod sanitize-json ((record record)) + (setf (*project record) nil) + (setf (*table record) nil) + (setf (*where-expression record) nil)) + +(defun slot-is-field-p (slot) + (equal (symbol-name slot) (ppcre:regex-replace "^\\*" (symbol-name slot) ""))) + +(defun execute-command (sql-query) + "Given a SQL query in a string, runs the query. No result set is +returned. Use this for INSERT, UPDATE, DELETE, etc." + ;;(print sql-query) + (postmodern:execute sql-query)) + +(defun execute-query (sql-query) + "Given a SQL query in a string, runs the query and returns the +result set. Use this for SELECT." + ;;(print sql-query) + (postmodern:query sql-query)) + +(defun timestamp-to-date (timestamp) + (let ((dateparts (ppcre:split "-" (local-time:to-rfc3339-timestring timestamp)))) + (ppcre:regex-replace-all "T" (format nil "~a-~a-~a" (pop dateparts) (pop dateparts) (pop dateparts)) " "))) + +(defun universal-to-date (universal) + (timestamp-to-date (local-time:universal-to-timestamp universal))) + +(defun simple-date-to-date (simple-date) + (universal-to-date (simple-date:timestamp-to-universal-time simple-date))) + +(defun get-date (full-sql-date) + (car (ppcre:split "\\." full-sql-date))) + +(defun notime (full-sql-date) + (car (ppcre:split " " full-sql-date))) + +(defun quote-string (field) + "Puts single ticks around `field'." + (format nil "'~a'" (ppcre:regex-replace-all "'" field "''"))) + +(defun get-slot-names-list (record-type) + "Returns a list of field slots in `record-type'. `record-type' is a +symbol, not a `record' instance." + (remove-if-not (lambda (x) + (slot-is-field-p x)) + (org-ckons-core::map-slot-names (make-instance (find-class record-type))))) |