;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;;
-;;;; $Id$
-;;;;
;;;; The CLSQL Functional Data Manipulation Language (FDML).
;;;;
;;;; This file is part of CLSQL.
(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
"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)
(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)))
(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*)