1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: High-level interface to SQL driver routines needed for
8 ;;;; Programmers: Kevin M. Rosenberg and onShore Development Inc
9 ;;;; Date Started: Mar 2002
11 ;;;; $Id: usql.cl,v 1.8 2002/05/19 16:26:06 kevin Exp $
13 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; and onShore Development Inc
16 ;;;; CLSQL users are granted the rights to distribute and use this software
17 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
18 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
19 ;;;; *************************************************************************
22 ;;; Minimal high-level routines to enable low-level interface for USQL
24 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
25 (in-package :clsql-sys)
27 (defun list-tables (&key (database *default-database*)
29 "List all tables in *default-database*, or if the :database keyword arg
30 is given, the specified database. If the keyword arg :system-tables
31 is true, then it will not filter out non-user tables. Table names are
32 given back as a list of strings."
33 (database-list-tables database :system-tables system-tables))
36 (defun list-attributes (table &key (database *default-database*))
37 "List the attributes of TABLE in *default-database, or if the
38 :database keyword is given, the specified database. Attributes are
39 returned as a list of strings."
40 (database-list-attributes table database))
42 (defun attribute-type (attribute table &key (database *default-database*))
43 "Return the field type of the ATTRIBUTE in TABLE. The optional
44 keyword argument :database specifies the database to query, defaulting
45 to *default-database*."
46 (database-attribute-type attribute table database))
48 (defun add-attribute (table attribute &key (database *default-database*))
49 "Add the ATTRIBUTE to TABLE. The ATTRIBUTE sepcification must
50 include a type argument. The optional keyword argument :database
51 specifies the database to operation on, defaulting to
53 (database-add-attribute table attribute database))
55 (defun rename-attribute (table oldatt newname
56 &key (database *default-database*))
57 (error "(rename-attribute ~a ~a ~a ~a) is not implemented" table oldatt newname database))
60 (defclass %sql-expression ()
63 ;; For SQL Identifiers of generic type
64 (defclass sql-ident (%sql-expression)
68 (:documentation "An SQL identifer."))
70 (defmethod make-load-form ((sql sql-ident) &optional environment)
71 (declare (ignore environment))
74 `(make-instance 'sql-ident :name ',name)))
77 (defun create-sequence (name &key (database *default-database*))
78 (database-create-sequence name database))
80 (defun drop-sequence (name &key (database *default-database*))
81 (database-drop-sequence name database))
83 (defun sequence-next (name &key (database *default-database*))
84 (database-sequence-next name database))
86 (defclass sql-value-exp (%sql-expression)
94 "An SQL value expression.")
97 (defclass sql-typecast-exp (sql-value-exp)
100 "An SQL typecast expression.")
102 (defvar +null-string+ "NULL")
104 (defvar *sql-stream* nil
105 "stream which accumulates SQL output")
107 (defmethod output-sql ((expr %sql-expression) &optional
108 (database *default-database*))
109 (declare (ignore database))
110 (write-string +null-string+ *sql-stream*))
112 (defmethod sql-output ((expr t))
113 (declare (ignore expr))
116 (defmethod print-object ((self %sql-expression) stream)
117 (print-unreadable-object
118 (self stream :type t)
119 (write-string (sql-output self) stream)))
122 ;; Methods for translating high-level table classes to low-level functions
124 (defmethod database-list-attributes ((table sql-ident) database)
125 (database-list-attributes (string-downcase
126 (symbol-name (slot-value table 'name)))
130 (defmethod database-attribute-type (attribute (table sql-ident) database)
131 (database-attribute-type attribute (string-downcase
132 (symbol-name (slot-value table 'name)))