;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
;;; Query
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))
+ (result-types :auto) (flatp nil) (field-names t))
(record-sql-action query-expression :query database)
- (let* ((res (database-query query-expression database result-types))
- (res (if flatp
- (mapcar #'car res)
- res)))
- (record-sql-action res :result database)
- res))
+ (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
(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*."
+ "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))
(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)))))))
+ `(if (listp ,query-expression)
+ ;; Object query
+ (dolist (,row ,query-expression)
+ (destructuring-bind ,args
+ ,row
+ ,@body))
+ ;; Functional query
+ (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))))))))
(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)))))
+ "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)
(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))
projects / clsql.git / blobdiff