classic/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 ;;; With the integration of CLSQL-USQL, these functions are no
  37 ;;; longer exported by the CLSQL package since they conflict with names
  38 ;;; exported by CLSQL-USQL
  39
  40 (defun insert-records
  41     (&key into attributes values av-pairs query (database *default-database*))
  42   "Insert records into the given table according to the given options."
  43   (cond
  44     ((and av-pairs (or attributes values))
  45      (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
  46     ((and (or av-pairs values) query)
  47      (error
  48       "Supply either query or values/av-pairs to call of insert-records."))
  49     ((and attributes (not query)
  50           (or (not (listp values)) (/= (length attributes) (length values))))
  51      (error "You must supply a matching values list when using attributes in call of insert-records."))
  52     (query
  53      (execute-command
  54       (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
  55       :database database))
  56     (t
  57      (execute-command
  58       (multiple-value-bind (attributes values)
  59           (if av-pairs
  60               (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
  61               (values attributes values))
  62         (format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
  63                 into attributes values))
  64       :database database))))
  65
  66 (defun delete-records (&key from where (database *default-database*))
  67   "Delete the indicated records from the given database."
  68   (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
  69                    :database database))
  70
  71 (defun update-records (table &key attributes values av-pairs where (database *default-database*))
  72   "Update the specified records in the given database."
  73   (cond
  74     ((and av-pairs (or attributes values))
  75      (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
  76     ((and attributes
  77           (or (not (listp values)) (/= (length attributes) (length values))))
  78      (error "You must supply a matching values list when using attributes in call of update-records."))
  79     ((or (and attributes (not values)) (and values (not attributes)))
  80      (error "You must supply both values and attributes in call of update-records."))
  81     (t
  82      (execute-command
  83       (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
  84               table
  85               (or av-pairs
  86                   (mapcar #'list attributes values))
  87               where)
  88       :database database))))
  89