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.6 2002/04/07 15:11:21 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 ;; KMR -- change aref to more specific char
78 (defun sql-escape (identifier)
79 (let* ((unescaped (etypecase identifier
80 (symbol (symbol-name identifier))
82 (escaped (make-string (length unescaped))))
83 (dotimes (i (length unescaped))
84 (setf (char escaped i)
85 (cond ((equal (char unescaped i) #\-)
89 (char unescaped i)))))
93 (defun create-sequence (name &key (database *default-database*))
94 (database-create-sequence name database))
96 (defun drop-sequence (name &key (database *default-database*))
97 (database-drop-sequence name database))
99 (defun sequence-next (name &key (database *default-database*))
100 (database-sequence-next name database))
102 (defclass sql-value-exp (%sql-expression)
110 "An SQL value expression.")
113 (defclass sql-typecast-exp (sql-value-exp)
116 "An SQL typecast expression.")
118 (defvar +null-string+ "NULL")
120 (defvar *sql-stream* nil
121 "stream which accumulates SQL output")
123 (defmethod output-sql ((expr %sql-expression) &optional
124 (database *default-database*))
125 (declare (ignore database))
126 (write-string +null-string+ *sql-stream*))
128 (defmethod print-object ((self %sql-expression) stream)
129 (print-unreadable-object
130 (self stream :type t)
131 (write-string (sql-output self) stream)))
134 ;; Methods for translating high-level table classes to low-level functions
136 (defmethod database-list-attributes ((table sql-ident) database)
137 (database-list-attributes (string-downcase
138 (symbol-name (slot-value table 'name)))
142 (defmethod database-attribute-type (attribute (table sql-ident) database)
143 (database-attribute-type attribute (string-downcase
144 (symbol-name (slot-value table 'name)))