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