Major rewrite of table/column name output escaping system wide.

[clsql.git] / sql / fdml.lisp

diff --git a/sql/fdml.lisp b/sql/fdml.lisp
index 34062620389844cb3bf61ba93650db782b6b2db5..bd8d6d36012e6183a8d6e0e96f0608f069848523 100644 (file)
--- a/sql/fdml.lisp
+++ b/sql/fdml.lisp
@@ -1,8 +1,6 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;;
-;;;; $Id$
-;;;;
 ;;;; The CLSQL Functional Data Manipulation Language (FDML).
 ;;;;
 ;;;; This file is part of CLSQL.
@@ -137,9 +135,10 @@ 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
+
       (cond ((and vals (not attrs) (not query) (not av-pairs))
              (setf values vals))
             ((and vals attrs (not subquery) (not av-pairs))
@@ -164,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)
@@ -185,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)))
@@ -210,29 +209,33 @@ types are automatically computed for each field."
         (qe (gensym "QUERY-EXPRESSION-"))
         (columns (gensym "COLUMNS-"))
         (row (gensym "ROW-"))
-        (db (gensym "DB-")))
-    `(let ((,qe ,query-expression))
+        (db (gensym "DB-"))
+        (last-form-eval (gensym "LFE-")))
+    `(let ((,qe ,query-expression)
+           (,db ,database))
       (typecase ,qe
         (sql-object-query
-         (dolist (,row (query ,qe))
+         (dolist (,row (query ,qe :database ,db))
            (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
+         (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))))))))))
+           (when ,result-set
+             (unwind-protect
+                  (do ((,row (make-list ,columns))
+                       (,last-form-eval nil))
+                      ((not (database-store-next-row ,result-set ,db ,row))
+                       ,last-form-eval)
+                    (destructuring-bind ,args ,row
+                      (setq ,last-form-eval
+                            (progn
+                              ,@body))))
+               (database-dump-result-set ,result-set ,db)))))))))
 
 (defun map-query (output-type-spec function query-expression
                   &key (database *default-database*)