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 ;;;;
   8 ;;;; Copyright (c) 1999-2001 Pierre R. Mai
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file is part of CLSQL.
  13 ;;;;
  14 ;;;; CLSQL users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;; *************************************************************************
  18
  19 (in-package #:clsql-classic-sys)
  20
  21
  22 ;;; This file implements the more advanced functions of the
  23 ;;; functional SQL interface, which are just nicer layers above the
  24 ;;; basic SQL interface.
  25
  26 ;;; These functions are no longer exported since they conflict with names
  27 ;;; exported by CLSQL
  28
  29 (defun insert-records
  30     (&key into attributes values av-pairs query (database *default-database*))
  31   "Insert records into the given table according to the given options."
  32   (cond
  33     ((and av-pairs (or attributes values))
  34      (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
  35     ((and (or av-pairs values) query)
  36      (error
  37       "Supply either query or values/av-pairs to call of insert-records."))
  38     ((and attributes (not query)
  39           (or (not (listp values)) (/= (length attributes) (length values))))
  40      (error "You must supply a matching values list when using attributes in call of insert-records."))
  41     (query
  42      (execute-command
  43       (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
  44       :database database))
  45     (t
  46      (execute-command
  47       (multiple-value-bind (attributes values)
  48           (if av-pairs
  49               (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
  50               (values attributes values))
  51         (format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
  52                 into attributes values))
  53       :database database))))
  54
  55 (defun delete-records (&key from where (database *default-database*))
  56   "Delete the indicated records from the given database."
  57   (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
  58                    :database database))
  59
  60 (defun update-records (table &key attributes values av-pairs where (database *default-database*))
  61   "Update the specified records in the given database."
  62   (cond
  63     ((and av-pairs (or attributes values))
  64      (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
  65     ((and attributes
  66           (or (not (listp values)) (/= (length attributes) (length values))))
  67      (error "You must supply a matching values list when using attributes in call of update-records."))
  68     ((or (and attributes (not values)) (and values (not attributes)))
  69      (error "You must supply both values and attributes in call of update-records."))
  70     (t
  71      (execute-command
  72       (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
  73               table
  74               (or av-pairs
  75                   (mapcar #'list attributes values))
  76               where)
  77       :database database))))
  78