X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=base%2Fbasic-sql.lisp;h=a7d32cfba64a92d3278750975fae24c2f92929cb;hp=bf8ef80f4934d8f692c48fd863d2cf8d24dd6b2d;hb=09f07ac9d914a83f9426609f3264f4e66b5a6d97;hpb=4d1a3100285889c84e63f8f4500dbd4b6c1f8ddc diff --git a/base/basic-sql.lisp b/base/basic-sql.lisp index bf8ef80..a7d32cf 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 @@ -31,13 +31,13 @@ that expression and a list of field names selected in sql-exp.")) (defmethod query ((query-expression string) &key (database *default-database*) (result-types :auto) (flatp nil) (field-names t)) - (record-sql-action query-expression :query database) + (record-sql-command query-expression 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) + (record-sql-result result database) (if field-names (values result names) result)))) @@ -55,116 +55,26 @@ pair.")) (defmethod execute-command ((sql-expression string) &key (database *default-database*)) - (record-sql-action sql-expression :command database) + (record-sql-command sql-expression database) (let ((res (database-execute-command sql-expression database))) - (record-sql-action res :result database)) + (record-sql-result res database)) (values)) -(defmacro do-query (((&rest args) query-expression - &key (database '*default-database*) (result-types nil)) - &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 :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))))))) +;;; Large objects support -(defun map-query (output-type-spec function query-expression - &key (database *default-database*) - (result-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 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 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 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 - :result-types result-types) - (when result-set - (unwind-protect - (do ((row (make-list columns))) - ((not (database-store-next-row result-set database row)) - nil) - (apply function row)) - (database-dump-result-set result-set database))))) - -(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 - :result-types result-types) - (when result-set - (unwind-protect - (let ((result (list nil))) - (do ((row (make-list columns)) - (current-cons result (cdr current-cons))) - ((not (database-store-next-row result-set database row)) - (cdr result)) - (rplacd current-cons (list (apply function row))))) - (database-dump-result-set result-set database))))) - - -(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 - :result-types result-types) - (when result-set - (unwind-protect - (if rows - ;; We know the row count in advance, so we allocate once - (do ((result - (cmucl-compat:make-sequence-of-type output-type-spec rows)) - (row (make-list columns)) - (index 0 (1+ index))) - ((not (database-store-next-row result-set database row)) - result) - (declare (fixnum index)) - (setf (aref result index) - (apply function row))) - ;; Database can't report row count in advance, so we have - ;; to grow and shrink our vector dynamically - (do ((result - (cmucl-compat:make-sequence-of-type output-type-spec 100)) - (allocated-length 100) - (row (make-list columns)) - (index 0 (1+ index))) - ((not (database-store-next-row result-set database row)) - (cmucl-compat:shrink-vector result index)) - (declare (fixnum allocated-length index)) - (when (>= index allocated-length) - (setq allocated-length (* allocated-length 2) - result (adjust-array result allocated-length))) - (setf (aref result index) - (apply function row)))) - (database-dump-result-set result-set 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))