1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: functional.cl
6 ;;;; Purpose: Functional interface
7 ;;;; Programmer: Pierre R. Mai
9 ;;;; Copyright (c) 1999-2001 Pierre R. Mai
11 ;;;; $Id: functional.cl,v 1.8 2002/09/17 17:16:43 kevin Exp $
13 ;;;; This file is part of CLSQL.
15 ;;;; CLSQL is free software; you can redistribute it and/or modify
16 ;;;; it under the terms of the GNU General Public License (version 2) as
17 ;;;; published by the Free Software Foundation.
19 ;;;; CLSQL is distributed in the hope that it will be useful,
20 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;;;; GNU General Public License for more details.
24 ;;;; You should have received a copy of the GNU General Public License
25 ;;;; along with CLSQL; if not, write to the Free Software Foundation, Inc.,
26 ;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27 ;;;; *************************************************************************
29 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
30 (in-package :clsql-sys)
33 ;;;; This file implements the more advanced functions of the
34 ;;;; functional SQL interface, which are just nicer layers above the
35 ;;;; basic SQL interface.
38 (&key into attributes values av-pairs query (database *default-database*))
39 "Insert records into the given table according to the given options."
41 ((and av-pairs (or attributes values))
42 (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
43 ((and (or av-pairs values) query)
45 "Supply either query or values/av-pairs to call of insert-records."))
46 ((and attributes (not query)
47 (or (not (listp values)) (/= (length attributes) (length values))))
48 (error "You must supply a matching values list when using attributes in call of insert-records."))
51 (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
55 (multiple-value-bind (attributes values)
57 (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
58 (values attributes values))
59 (format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
60 into attributes values))
61 :database database))))
63 (defun delete-records (&key from where (database *default-database*))
64 "Delete the indicated records from the given database."
65 (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
68 (defun update-records (table &key attributes values av-pairs where (database *default-database*))
69 "Update the specified records in the given database."
71 ((and av-pairs (or attributes values))
72 (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
74 (or (not (listp values)) (/= (length attributes) (length values))))
75 (error "You must supply a matching values list when using attributes in call of update-records."))
76 ((or (and attributes (not values)) (and values (not attributes)))
77 (error "You must supply both values and attributes in call of update-records."))
80 (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
83 (mapcar #'list attributes values))
85 :database database))))
87 (defmacro with-database ((db-var connection-spec &rest connect-args) &body body)
88 "Evaluate the body in an environment, where `db-var' is bound to the
89 database connection given by `connection-spec' and `connect-args'.
90 The connection is automatically closed or released to the pool on exit from the body."
91 (let ((result (gensym "result-")))
92 (unless db-var (setf db-var '*default-database*))
93 `(let ((,db-var (connect ,connection-spec ,@connect-args))
96 (let ((,db-var ,db-var))
97 (setf ,result (progn ,@body)))
98 (disconnect :database ,db-var))