X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Ffdml.lisp;h=bd8d6d36012e6183a8d6e0e96f0608f069848523;hb=925a29060928f773d4bc7d8e6bdd13c97e0ef65a;hp=fcd6a3dd637e3ada63170a81486825820f794f23;hpb=a58462f512e08c0eecf6a668a00a07ed7e858f64;p=clsql.git diff --git a/sql/fdml.lisp b/sql/fdml.lisp index fcd6a3d..bd8d6d3 100644 --- a/sql/fdml.lisp +++ b/sql/fdml.lisp @@ -135,7 +135,7 @@ columns." (subquery nil)) (unless into (error 'sql-user-error :message ":into keyword not supplied")) - (let ((insert (make-instance 'sql-insert :into into))) + (let ((insert (make-instance 'sql-insert :into (database-identifier into nil)))) (with-slots (attributes values query) insert @@ -163,7 +163,7 @@ columns." "Deletes records satisfying the SQL expression WHERE from the table specified by FROM in DATABASE specifies a database which defaults to *DEFAULT-DATABASE*." - (let ((stmt (make-instance 'sql-delete :from from :where where))) + (let ((stmt (make-instance 'sql-delete :from (database-identifier from database) :where where))) (execute-command stmt :database database))) (defun update-records (table &key (attributes nil) @@ -184,7 +184,7 @@ are nil and AV-PAIRS is an alist of (attribute value) pairs." (when av-pairs (setf attributes (mapcar #'car av-pairs) values (mapcar #'cadr av-pairs))) - (let ((stmt (make-instance 'sql-update :table table + (let ((stmt (make-instance 'sql-update :table (database-identifier table database) :attributes attributes :values values :where where))) @@ -209,7 +209,8 @@ types are automatically computed for each field." (qe (gensym "QUERY-EXPRESSION-")) (columns (gensym "COLUMNS-")) (row (gensym "ROW-")) - (db (gensym "DB-"))) + (db (gensym "DB-")) + (last-form-eval (gensym "LFE-"))) `(let ((,qe ,query-expression) (,db ,database)) (typecase ,qe @@ -226,11 +227,14 @@ types are automatically computed for each field." :result-types ,result-types) (when ,result-set (unwind-protect - (do ((,row (make-list ,columns))) + (do ((,row (make-list ,columns)) + (,last-form-eval nil)) ((not (database-store-next-row ,result-set ,db ,row)) - nil) + ,last-form-eval) (destructuring-bind ,args ,row - ,@body)) + (setq ,last-form-eval + (progn + ,@body)))) (database-dump-result-set ,result-set ,db))))))))) (defun map-query (output-type-spec function query-expression