1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: High-level SQL interface
7 ;;;; Authors: Kevin M. Rosenberg based on code by Pierre R. Mai
8 ;;;; Date Started: Feb 2002
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
13 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
15 ;;;; CLSQL users are granted the rights to distribute and use this software
16 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
17 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
18 ;;;; *************************************************************************
20 (in-package #:clsql-classic-sys)
23 ;;; Row processing macro
25 (defmacro for-each-row (((&rest fields) &key from order-by where distinct limit) &body body)
26 (let ((d (gensym "DISTINCT-"))
27 (bind-fields (loop for f in fields collect (car f)))
29 (o (gensym "ORDER-BY-"))
30 (frm (gensym "FROM-"))
32 (q (gensym "QUERY-")))
38 (let ((,q (query-string ',fields ,frm ,w ,d ,o ,l)))
39 (loop for tuple in (query ,q)
40 collect (destructuring-bind ,bind-fields tuple
43 (defun query-string (fields from where distinct order-by limit)
46 (format nil "select ~A~{~A~^,~} from ~{~A~^ and ~}"
47 (if distinct "distinct " "") (field-names fields)
49 (if where (format nil " where ~{~A~^ ~}"
50 (where-strings where)) "")
51 (if order-by (format nil " order by ~{~A~^, ~}"
52 (order-by-strings order-by)))
53 (if limit (format nil " limit ~D" limit) "")))
55 (defun lisp->sql-name (field)
58 (symbol (string-upcase (symbol-name field)))
60 (t (format nil "~A" field))))
62 (defun field-names (field-forms)
63 "Return a list of field name strings from a fields form"
64 (loop for field-form in field-forms
71 (defun from-names (from)
72 "Return a list of field name strings from a fields form"
73 (loop for table in (if (atom from) (list from) from)
74 collect (lisp->sql-name table)))
77 (defun where-strings (where)
78 (loop for w in (if (atom (car where)) (list where) where)
81 (format nil "~A ~A ~A" (second w) (first w) (third w))
82 (format nil "~A" w))))
84 (defun order-by-strings (order-by)
85 (loop for o in order-by
89 (format nil "~A ~A" (lisp->sql-name (car o))
90 (lisp->sql-name (cadr o))))))
93 ;;; Marc Battyani : Large objects support
95 (defun create-large-object (&key (database *default-database*))
96 "Creates a new large object in the database and returns the object identifier"
97 (database-create-large-object database))
99 (defun write-large-object (object-id data &key (database *default-database*))
100 "Writes data to the large object"
101 (database-write-large-object object-id data database))
103 (defun read-large-object (object-id &key (database *default-database*))
104 "Reads the large object content"
105 (database-read-large-object object-id database))
107 (defun delete-large-object (object-id &key (database *default-database*))
108 "Deletes the large object in the database"
109 (database-delete-large-object object-id database))
112 ;;; These functions are not exported. If you application depends on these
113 ;;; functions consider using the clsql package using has further support.
115 (defun list-tables (&key (database *default-database*))
116 "List all tables in *default-database*, or if the :database keyword arg
117 is given, the specified database. If the keyword arg :system-tables
118 is true, then it will not filter out non-user tables. Table names are
119 given back as a list of strings."
120 (database-list-tables database))
123 (defun list-attributes (table &key (database *default-database*))
124 "List the attributes of TABLE in *default-database, or if the
125 :database keyword is given, the specified database. Attributes are
126 returned as a list of strings."
127 (database-list-attributes table database))
129 (defun attribute-type (attribute table &key (database *default-database*))
130 "Return the field type of the ATTRIBUTE in TABLE. The optional
131 keyword argument :database specifies the database to query, defaulting
132 to *default-database*."
133 (database-attribute-type attribute table database))
135 (defun create-sequence (name &key (database *default-database*))
136 (database-create-sequence name database))
138 (defun drop-sequence (name &key (database *default-database*))
139 (database-drop-sequence name database))
141 (defun sequence-next (name &key (database *default-database*))
142 (database-sequence-next name database))