r8821: integrate usql support
[clsql.git] / sql / functional.lisp
1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
4 ;;;;
5 ;;;; Name:          functional.lisp
6 ;;;; Purpose:       Functional interface
7 ;;;; Programmer:    Pierre R. Mai
8 ;;;;
9 ;;;; Copyright (c) 1999-2001 Pierre R. Mai
10 ;;;;
11 ;;;; $Id$
12 ;;;;
13 ;;;; This file is part of CLSQL. 
14 ;;;;
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.
18 ;;;;
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.
23 ;;;;
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 ;;;; *************************************************************************
28
29 (in-package #:clsql-sys)
30
31
32 ;;;; This file implements the more advanced functions of the
33 ;;;; functional SQL interface, which are just nicer layers above the
34 ;;;; basic SQL interface.
35
36 (defun insert-records
37     (&key into attributes values av-pairs query (database *default-database*))
38   "Insert records into the given table according to the given options."
39   (cond
40     ((and av-pairs (or attributes values))
41      (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
42     ((and (or av-pairs values) query)
43      (error
44       "Supply either query or values/av-pairs to call of insert-records."))
45     ((and attributes (not query)
46           (or (not (listp values)) (/= (length attributes) (length values))))
47      (error "You must supply a matching values list when using attributes in call of insert-records."))
48     (query
49      (execute-command
50       (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
51       :database database))
52     (t
53      (execute-command
54       (multiple-value-bind (attributes values)
55           (if av-pairs
56               (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
57               (values attributes values))
58         (format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
59                 into attributes values))
60       :database database))))
61
62 (defun delete-records (&key from where (database *default-database*))
63   "Delete the indicated records from the given database."
64   (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
65                    :database database))
66
67 (defun update-records (table &key attributes values av-pairs where (database *default-database*))
68   "Update the specified records in the given database."
69   (cond
70     ((and av-pairs (or attributes values))
71      (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
72     ((and attributes
73           (or (not (listp values)) (/= (length attributes) (length values))))
74      (error "You must supply a matching values list when using attributes in call of update-records."))
75     ((or (and attributes (not values)) (and values (not attributes)))
76      (error "You must supply both values and attributes in call of update-records."))
77     (t
78      (execute-command
79       (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
80               table
81               (or av-pairs
82                   (mapcar #'list attributes values))
83               where)
84       :database database))))
85