Permalink
Browse files

+fb-query (macro), some fixes

  • Loading branch information...
1 parent be113a5 commit 69cae278e7d9387ee19844ae6db1b95b23653aff @klimenko-serj committed Aug 22, 2012
Showing with 51 additions and 43 deletions.
  1. +1 −0 cl-fbclient-functions.lisp
  2. +48 −43 cl-fbclient.lisp
  3. +2 −0 package.lisp
View
1 cl-fbclient-functions.lisp
@@ -219,6 +219,7 @@
(defun get-var-val+name (xsqlda* index)
(list (get-var-name xsqlda* index)
(get-var-val xsqlda* index)))
+;-----------------------------------------------------------------------------------
(defun get-vars-names (xsqlda*)
(loop for i from 0 to (- (get-vars-count xsqlda*) 1) collect (get-var-name xsqlda* i)))
;-----------------------------------------------------------------------------------
View
91 cl-fbclient.lisp
@@ -8,44 +8,6 @@
;-----------------------------------------------------------------------------------
(defgeneric fb-verbalize-error (err)
(:documentation "The method, which creates a single text error message."))
-;(defgeneric fb-connect (fb-db)
-; (:documentation "Method to connect to the database."))
-;(defgeneric fb-disconnect (db)
-; (:documentation "Method to disconnect from the database."))
-;; (defgeneric fb-start-transaction (transaction)
-;; (:documentation "Method to start transaction."))
-;; (defgeneric fb-commit-transaction (transaction)
-;; (:documentation "Method to commit transaction."))
-;; (defgeneric fb-rollback-transaction (transaction)
-;; (:documentation "Method to rollback transaction."))
-;; (defgeneric fb-prepare-and-execute-statement (statement)
-;; (:documentation "Method to prepare and execute statement."))
-;; (defgeneric fb-statement-free (statement)
-;; (:documentation "Method to free statement."))
-;; (defgeneric fb-statement-fetch (statement)
-;; (:documentation "Method to fetch results from executed statement."))
-;; (defgeneric fb-statement-get-var-val (statement index)
-;; (:documentation "A method for obtaining the values of result variables. Used after Fetch."))
-;; (defgeneric fb-statement-get-vars-vals-list (statement)
-;; (:documentation "A method for obtaining the list of values ​​of result variables. Used after Fetch."))
-;; (defgeneric fb-statement-get-var-val+name (statement index)
-;; (:documentation "A method for obtaining the values and names of result variables. Used after Fetch."))
-;; (defgeneric fb-statement-get-vars-vals+names-list (statement)
-;; (:documentation "A method for obtaining the list of values and names of result variables. Used after Fetch."))
-;; (defgeneric fb-statement-get-vars-names-list (statement)
-;; (:documentation "A method for obtaining names of result variables. Used after Fetch."))
-;; (defgeneric fb-noresult-query (fb-db request-str)
-;; (:documentation "A method for performing queries that do not require answers.(insert,delete,update, etc.)
-;; (transaction will be created, started and commited automatically)"))
-;; (defgeneric fb-query-fetch-all (fb-db request-str)
-;; (:documentation "The method, which executes the query and returns all its results in a list.
-;; (transaction will be created, started and commited automatically)"))
-;; (defgeneric fb-query-fetch-all+names (fb-db request-str)
-;; (:documentation "The method, which executes the query and returns all its results(+names) in a list.
-;; (transaction will be created, started and commited automatically)"))
-;; (defgeneric fb-query-fetch-all+names-header (fb-db request-str)
-;; (:documentation "The method, which executes the query and returns all its results(+names header) in a list.
-;; (transaction will be created, started and commited automatically)"))
;===================================================================================
;; PARAMETERS
;-----------------------------------------------------------------------------------
@@ -65,6 +27,9 @@
(cl-fbclient:fb-error-code err)
(cl-fbclient:fb-error-text err)
(cl-fbclient:fbclient-msg err)))
+;-----------------------------------------------------------------------------------
+(defmethod print-object ((err fb-error) stream)
+ (format stream (fb-verbalize-error err)))
;===================================================================================
;; FB-DATABASE
;-----------------------------------------------------------------------------------
@@ -301,12 +266,14 @@
(cffi-sys:foreign-free status-vector*)))
(cffi-sys:foreign-free status-vector*)))
;-----------------------------------------------------------------------------------
-(defmethod initialize-instance :after ((stmt fb-statement) &key (no-auto-execute Nil) (no-auto-prepare Nil) (no-auto-allocate Nil))
- (when (null no-auto-allocate)
+(defmethod initialize-instance :after ((stmt fb-statement)
+ &key (no-auto-execute Nil)
+ (no-auto-prepare Nil) (no-auto-allocate Nil))
+ (unless no-auto-allocate
(fb-allocate-statement stmt)
- (when (null no-auto-prepare)
+ (unless no-auto-prepare
(fb-prepare-statement stmt)
- (when (null no-auto-execute)
+ (unless no-auto-execute
(fb-execute-statement stmt)))))
;-----------------------------------------------------------------------------------
(defun fb-statement-free (stmt)
@@ -333,7 +300,7 @@
:fb-error-text "Unable to fetch statement"
:fbclient-msg (get-status-vector-msg status-vector*)))
(cffi-sys:foreign-free status-vector*))
- (when(= fetch-res 0) T)))
+ (when (= fetch-res 0) T)))
(error 'fb-error
:fb-error-code 36
:fb-error-text "Unable to fetch statement. Statement type is not SELECT."
@@ -361,6 +328,13 @@
;===================================================================================
;; 'FB-WIDTH-..' and 'FB-LOOP-..' macroses
;-----------------------------------------------------------------------------------
+(defmacro fb-with-database ((database-name &rest params) &body body)
+ "Macro to automatic connect and disconnect database."
+ `(let ((,database-name (make-instance 'fb-database ,@params)))
+ (unwind-protect
+ (progn ,@body)
+ (fb-disconnect ,database-name))))
+;-----------------------------------------------------------------------------------
(defmacro fb-with-transaction ((fb-db transaction-name) &body body)
"Macro to create, automatic start and commit transactions."
`(let ((,transaction-name (make-instance 'fb-transaction :fb-db ,fb-db)))
@@ -399,6 +373,37 @@
(fb-statement-get-var-val ,st-name ,i)))
(progn ,@body))))))
;-----------------------------------------------------------------------------------
+;;; FB-QUERY macro
+;; working with transactions or databases(transaction will be created, started and commited automatically)
+;; parameters:
+;; ':db' or ':tr' fb-database or fb-transaction
+;; :header-names - Add header(which contains names of variables) to values list
+;; :vars-names - Add variable name to value like ("name" ~val~)
+;; :one-record - Read only one record.
+;-----------------------------------------------------------------------------------
+(defmacro fb-query (request-str &rest kpar)
+ (progn
+ (unless (evenp (length kpar)) (setf kpar (append kpar '(Nil))))
+ (append
+ (cond ((getf kpar :db)
+ `(fb-with-statement-db (,(getf kpar :db) tmp-stmt ,request-str)))
+ ((getf kpar :tr)
+ `(fb-with-statement (,(getf kpar :tr) tmp-stmt ,request-str)))
+ (T 'ERR))
+ `((if (eq (fb-get-sql-type tmp-stmt) 'select)
+ (append
+ ,(if (member :header-names kpar)
+ '(list (fb-statement-get-vars-names-list tmp-stmt))
+ ''())
+ ,(let ((funct (if (member :vars-names kpar)
+ 'fb-statement-get-vars-vals+names-list
+ 'fb-statement-get-vars-vals-list)))
+ (if (member :one-record kpar)
+ `(when (fb-statement-fetch tmp-stmt) (list (,funct tmp-stmt)))
+ `(loop while (fb-statement-fetch tmp-stmt)
+ collect (,funct tmp-stmt)))))
+ Nil)))))
+;-----------------------------------------------------------------------------------
;===================================================================================
;; QUERY functions
;; (automatic 'start' and 'commit' transaction)
View
2 package.lisp
@@ -22,11 +22,13 @@
:fb-statement-get-var-val+name
:fb-statement-get-vars-vals+names-list
:fb-get-sql-type
+ :fb-with-database
:fb-with-transaction
:fb-with-statement
:fb-with-statement-db
:fb-loop-statement-fetch
:fb-loop-query-fetch
+ :fb-query
:fb-noresult-query
:fb-query-fetch-all
:fb-query-fetch-all+names

0 comments on commit 69cae27

Please sign in to comment.