sql/usql.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          usql.cl
   6 ;;;; Purpose:       High-level interface to SQL driver routines needed for
   7 ;;;;                UncommonSQL
   8 ;;;; Programmers:   Kevin M. Rosenberg and onShore Development Inc
   9 ;;;; Date Started:  Mar 2002
  10 ;;;;
  11 ;;;; $Id: usql.cl,v 1.6 2002/04/07 15:11:21 kevin Exp $
  12 ;;;;
  13 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  14 ;;;; and onShore Development Inc
  15 ;;;;
  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 ;;;; *************************************************************************
  20
  21
  22 ;;; Minimal high-level routines to enable low-level interface for USQL
  23
  24 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  25 (in-package :clsql-sys)
  26
  27 (defun list-tables (&key (database *default-database*)
  28                          (system-tables nil))
  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))
  34
  35
  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))
  41
  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))
  47
  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
  52 *default-database*."
  53   (database-add-attribute table attribute database))
  54
  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))
  58
  59
  60 (defclass %sql-expression ()
  61     ())
  62
  63 ;; For SQL Identifiers of generic type
  64 (defclass sql-ident (%sql-expression)
  65   ((name
  66     :initarg :name
  67     :initform "NULL"))
  68   (:documentation "An SQL identifer."))
  69
  70 (defmethod make-load-form ((sql sql-ident) &optional environment)
  71   (declare (ignore environment))
  72   (with-slots (name)
  73     sql
  74     `(make-instance 'sql-ident :name ',name)))
  75
  76
  77 ;; KMR -- change aref to more specific char
  78 (defun sql-escape (identifier)
  79   (let* ((unescaped (etypecase identifier
  80                       (symbol (symbol-name identifier))
  81                       (string identifier)))
  82          (escaped (make-string (length unescaped))))
  83     (dotimes (i (length unescaped))
  84       (setf (char escaped i)
  85             (cond ((equal (char unescaped i) #\-)
  86                    #\_)
  87                   ;; ...
  88                   (t
  89                    (char unescaped i)))))
  90     escaped))
  91
  92
  93 (defun create-sequence (name &key (database *default-database*))
  94   (database-create-sequence name database))
  95
  96 (defun drop-sequence (name &key (database *default-database*))
  97   (database-drop-sequence name database))
  98
  99 (defun sequence-next (name &key (database *default-database*))
 100   (database-sequence-next name database))
 101
 102 (defclass sql-value-exp (%sql-expression)
 103   ((modifier
 104     :initarg :modifier
 105     :initform nil)
 106    (components
 107     :initarg :components
 108     :initform nil))
 109   (:documentation
 110    "An SQL value expression.")
 111   )
 112
 113 (defclass sql-typecast-exp (sql-value-exp)
 114   ()
 115   (:documentation
 116    "An SQL typecast expression.")
 117   )
 118 (defvar +null-string+ "NULL")
 119
 120 (defvar *sql-stream* nil
 121   "stream which accumulates SQL output")
 122
 123 (defmethod output-sql ((expr %sql-expression) &optional
 124                        (database *default-database*))
 125   (declare (ignore database))
 126   (write-string +null-string+ *sql-stream*))
 127
 128 (defmethod print-object ((self %sql-expression) stream)
 129   (print-unreadable-object
 130    (self stream :type t)
 131    (write-string (sql-output self) stream)))
 132
 133
 134 ;; Methods for translating high-level table classes to low-level functions
 135
 136 (defmethod database-list-attributes ((table sql-ident) database)
 137   (database-list-attributes (string-downcase
 138                              (symbol-name (slot-value table 'name)))
 139                             database)
 140   )
 141
 142 (defmethod database-attribute-type (attribute (table sql-ident) database)
 143   (database-attribute-type attribute (string-downcase
 144                                       (symbol-name (slot-value table 'name)))
 145                            database))