X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Fbasic-sql.lisp;h=2f25fd42bed99e1a58e0ba21e255b16db794af73;hb=89465a80557c2b03b9701b4239a34ded292eb018;hp=4610c4208793c21cf3e85d57ddb8564b4392880f;hpb=d68d59f99911564ac2af867561fefef107cb14e8;p=clsql.git diff --git a/base/basic-sql.lisp b/base/basic-sql.lisp index 4610c42..2f25fd4 100644 --- a/base/basic-sql.lisp +++ b/base/basic-sql.lisp @@ -12,7 +12,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base-sys) +(in-package #:clsql-base) ;;; Query @@ -30,16 +30,17 @@ one result per row. Returns a list of lists of values of the result of that expression and a list of field names selected in sql-exp.")) (defmethod query ((query-expression string) &key (database *default-database*) - (result-types nil) (flatp nil)) - (record-sql-command query-expression database) - (let* ((res (database-query query-expression database result-types)) - (res (if (and flatp (= (length - (slot-value query-expression 'selections)) - 1)) - (mapcar #'car res) - res))) - (record-sql-result res database) - res)) + (result-types :auto) (flatp nil) (field-names t)) + (record-sql-action query-expression :query database) + (multiple-value-bind (rows names) (database-query query-expression database result-types + field-names) + (let ((result (if (and flatp (= 1 (length (car rows)))) + (mapcar #'car rows) + rows))) + (record-sql-action result :result database) + (if field-names + (values result names) + result)))) ;;; Execute @@ -54,61 +55,81 @@ pair.")) (defmethod execute-command ((sql-expression string) &key (database *default-database*)) - (record-sql-command sql-expression database) + (record-sql-action sql-expression :command database) (let ((res (database-execute-command sql-expression database))) - (record-sql-result res database)) + (record-sql-action res :result database)) (values)) - (defmacro do-query (((&rest args) query-expression - &key (database '*default-database*) (types nil)) + &key (database '*default-database*) (result-types :auto)) &body body) - "Repeatedly executes BODY within a binding of ARGS on the attributes -of each record resulting from QUERY. The return value is determined by -the result of executing BODY. The default value of DATABASE is -*DEFAULT-DATABASE*." - (let ((result-set (gensym)) - (columns (gensym)) - (row (gensym)) - (db (gensym))) - `(let ((,db ,database)) - (multiple-value-bind (,result-set ,columns) - (database-query-result-set ,query-expression ,db - :full-set nil :types ,types) - (when ,result-set - (unwind-protect - (do ((,row (make-list ,columns))) - ((not (database-store-next-row ,result-set ,db ,row)) - nil) - (destructuring-bind ,args ,row - ,@body)) - (database-dump-result-set ,result-set ,db))))))) + "Repeatedly executes BODY within a binding of ARGS on the +attributes of each record resulting from QUERY-EXPRESSION. The +return value is determined by the result of executing BODY. The +default value of DATABASE is *DEFAULT-DATABASE*." + (let ((result-set (gensym "RESULT-SET-")) + (qe (gensym "QUERY-EXPRESSION-")) + (columns (gensym "COLUMNS-")) + (row (gensym "ROW-")) + (db (gensym "DB-"))) + `(let ((,qe ,query-expression)) + (typecase ,qe + (list + ;; Object query + (dolist (,row ,qe) + (destructuring-bind ,args + ,row + ,@body))) + (t + ;; Functional query + (let ((,db ,database)) + (multiple-value-bind (,result-set ,columns) + (database-query-result-set ,qe ,db + :full-set nil + :result-types ,result-types) + (when ,result-set + (unwind-protect + (do ((,row (make-list ,columns))) + ((not (database-store-next-row ,result-set ,db ,row)) + nil) + (destructuring-bind ,args ,row + ,@body)) + (database-dump-result-set ,result-set ,db)))))))))) (defun map-query (output-type-spec function query-expression &key (database *default-database*) - (types nil)) - "Map the function over all tuples that are returned by the query in -query-expression. The results of the function are collected as -specified in output-type-spec and returned like in MAP." - (macrolet ((type-specifier-atom (type) - `(if (atom ,type) ,type (car ,type)))) - (case (type-specifier-atom output-type-spec) - ((nil) - (map-query-for-effect function query-expression database types)) - (list - (map-query-to-list function query-expression database types)) - ((simple-vector simple-string vector string array simple-array - bit-vector simple-bit-vector base-string - simple-base-string) - (map-query-to-simple output-type-spec function query-expression database types)) - (t - (funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t) - function query-expression :database database :types types))))) - -(defun map-query-for-effect (function query-expression database types) + (result-types :auto)) + "Map the function over all tuples that are returned by the +query in QUERY-EXPRESSION. The results of the function are +collected as specified in OUTPUT-TYPE-SPEC and returned like in +MAP." + (if (listp query-expression) + ;; Object query + (map output-type-spec #'(lambda (x) (apply function x)) query-expression) + ;; Functional query + (macrolet ((type-specifier-atom (type) + `(if (atom ,type) ,type (car ,type)))) + (case (type-specifier-atom output-type-spec) + ((nil) + (map-query-for-effect function query-expression database + result-types)) + (list + (map-query-to-list function query-expression database result-types)) + ((simple-vector simple-string vector string array simple-array + bit-vector simple-bit-vector base-string + simple-base-string) + (map-query-to-simple output-type-spec function query-expression + database result-types)) + (t + (funcall #'map-query + (cmucl-compat:result-type-or-lose output-type-spec t) + function query-expression :database database + :result-types result-types)))))) + +(defun map-query-for-effect (function query-expression database result-types) (multiple-value-bind (result-set columns) (database-query-result-set query-expression database :full-set nil - :types types) + :result-types result-types) (when result-set (unwind-protect (do ((row (make-list columns))) @@ -117,10 +138,10 @@ specified in output-type-spec and returned like in MAP." (apply function row)) (database-dump-result-set result-set database))))) -(defun map-query-to-list (function query-expression database types) +(defun map-query-to-list (function query-expression database result-types) (multiple-value-bind (result-set columns) (database-query-result-set query-expression database :full-set nil - :types types) + :result-types result-types) (when result-set (unwind-protect (let ((result (list nil))) @@ -132,10 +153,10 @@ specified in output-type-spec and returned like in MAP." (database-dump-result-set result-set database))))) -(defun map-query-to-simple (output-type-spec function query-expression database types) +(defun map-query-to-simple (output-type-spec function query-expression database result-types) (multiple-value-bind (result-set columns rows) (database-query-result-set query-expression database :full-set t - :types types) + :result-types result-types) (when result-set (unwind-protect (if rows @@ -166,5 +187,21 @@ specified in output-type-spec and returned like in MAP." (apply function row)))) (database-dump-result-set result-set database))))) +;;; Large objects support + +(defun create-large-object (&key (database *default-database*)) + "Creates a new large object in the database and returns the object identifier" + (database-create-large-object database)) + +(defun write-large-object (object-id data &key (database *default-database*)) + "Writes data to the large object" + (database-write-large-object object-id data database)) + +(defun read-large-object (object-id &key (database *default-database*)) + "Reads the large object content" + (database-read-large-object object-id database)) +(defun delete-large-object (object-id &key (database *default-database*)) + "Deletes the large object in the database" + (database-delete-large-object object-id database))