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)
  20
  21 ;;; This file implements the more advanced functions of the
  22 ;;; functional SQL interface, which are just nicer layers above the
  23 ;;; basic SQL interface.
  24
  25 ;;; These functions are no longer exported since they conflict with names
  26 ;;; exported by CLSQL
  27
  28 (defun insert-records
  29     (&key into attributes values av-pairs query (database *default-database*))
  30   "Insert records into the given table according to the given options."
  31   (cond
  32     ((and av-pairs (or attributes values))
  33      (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
  34     ((and (or av-pairs values) query)
  35      (error
  36       "Supply either query or values/av-pairs to call of insert-records."))
  37     ((and attributes (not query)
  38           (or (not (listp values)) (/= (length attributes) (length values))))
  39      (error "You must supply a matching values list when using attributes in call of insert-records."))
  40     (query
  41      (execute-command
  42       (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
  43       :database database))
  44     (t
  45      (execute-command
  46       (multiple-value-bind (attributes values)
  47           (if av-pairs
  48               (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
  49               (values attributes values))
  50         (format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
  51                 into attributes values))
  52       :database database))))
  53
  54 (defun delete-records (&key from where (database *default-database*))
  55   "Delete the indicated records from the given database."
  56   (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
  57                    :database database))
  58
  59 (defun update-records (table &key attributes values av-pairs where (database *default-database*))
  60   "Update the specified records in the given database."
  61   (cond
  62     ((and av-pairs (or attributes values))
  63      (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
  64     ((and attributes
  65           (or (not (listp values)) (/= (length attributes) (length values))))
  66      (error "You must supply a matching values list when using attributes in call of update-records."))
  67     ((or (and attributes (not values)) (and values (not attributes)))
  68      (error "You must supply both values and attributes in call of update-records."))
  69     (t
  70      (execute-command
  71       (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
  72               table
  73               (or av-pairs
  74                   (mapcar #'list attributes values))
  75               where)
  76       :database database))))
  77