r8973: add makefiles, remove explain function, fix truncate

[clsql.git] / sql / sql.lisp

diff --git a/sql/sql.lisp b/sql/sql.lisp
index 4ed2e81e72cd725fe1849811667ed7f478e90bb6..28d5a922b857a4f9dd9387f497ddcc02d5a7c2f1 100644 (file)
--- a/sql/sql.lisp
+++ b/sql/sql.lisp
@@ -1,26 +1,26 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; ======================================================================
-;;;; File:    sql.lisp
-;;;; Updated: <04/04/2004 12:05:32 marcusp>
-;;;; ======================================================================
+;;;; *************************************************************************
 ;;;;
-;;;; Description ==========================================================
-;;;; ======================================================================
+;;;; $Id$
 ;;;;
-;;;; The CLSQL-USQL Functional Data Manipulation Language (FDML). 
+;;;; The CLSQL Functional Data Manipulation Language (FDML). 
 ;;;;
-;;;; ======================================================================
+;;;; This file is part of CLSQL.
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
 
 (in-package #:clsql-sys)
-
   
 ;;; Basic operations on databases
 
 
 (defmethod database-query-result-set ((expr %sql-expression) database
-                                      &key full-set types)
+                                      &key full-set result-types)
   (database-query-result-set (sql-output expr database) database
-                             :full-set full-set :types types))
+                             :full-set full-set :result-types result-types))
 
 (defmethod execute-command ((expr %sql-expression)
                             &key (database *default-database*))
@@ -28,12 +28,23 @@
   (values))
 
 
-
 (defmethod query ((expr %sql-expression) &key (database *default-database*)
                   (result-types nil) (flatp nil))
   (query (sql-output expr database) :database database :flatp flatp
          :result-types result-types))
 
+(defun truncate-database (database)
+  (unless (typep database 'database)
+    (clsql-base-sys::signal-no-database-error database))
+  (unless (is-database-open database)
+    (database-reconnect database))
+  (dolist (table (list-tables database))
+    (drop-table table :database database))
+  (dolist (index (list-indexes database))
+    (drop-index index :database database))
+  (dolist (seq (list-sequences database))
+    (drop-sequence seq :database database)))
+
 (defun print-query (query-exp &key titles (formats t) (sizes t) (stream t)
                              (database *default-database*))
   "The PRINT-QUERY function takes a symbolic SQL query expression and
@@ -91,11 +102,11 @@ table INTO. The default value of DATABASE is *DEFAULT-DATABASE*."
                            (vals nil)
                            (av-pairs nil)
                            (subquery nil))
-  (if (null into)
+  (unless into
       (error 'clsql-sql-syntax-error :reason ":into keyword not supplied"))
-  (let ((ins (make-instance 'sql-insert :into into)))
+  (let ((insert (make-instance 'sql-insert :into into)))
     (with-slots (attributes values query)
-      ins
+      insert
       (cond ((and vals (not attrs) (not query) (not av-pairs))
             (setf values vals))
            ((and vals attrs (not subquery) (not av-pairs))
@@ -112,7 +123,7 @@ table INTO. The default value of DATABASE is *DEFAULT-DATABASE*."
            (t
             (error 'clsql-sql-syntax-error
                     :reason "bad or ambiguous keyword combination.")))
-      ins)))
+      insert)))
     
 (defun delete-records (&key (from nil)
                             (where nil)
@@ -124,12 +135,11 @@ from which the records are to be removed, and defaults to
   (let ((stmt (make-instance 'sql-delete :from from :where where)))
     (execute-command stmt :database database)))
 
-(defun update-records (table &key
-                          (attributes nil)
-                          (values nil)
-                          (av-pairs nil)
-                          (where nil)
-                          (database *default-database*))
+(defun update-records (table &key (attributes nil)
+                           (values nil)
+                           (av-pairs nil)
+                           (where nil)
+                           (database *default-database*))
   "Changes the values of existing fields in TABLE with columns
 specified by ATTRIBUTES and VALUES (or AV-PAIRS) where the WHERE
 condition is true."
@@ -216,6 +226,7 @@ condition is true."
            "No type conversion to SQL for ~A is defined for DB ~A."
            :format-arguments (list (type-of thing) (type-of database)))))
 
+
 (defmethod output-sql-hash-key ((arg vector) &optional database)
   (list 'vector (map 'list (lambda (arg)
                              (or (output-sql-hash-key arg database)
@@ -224,7 +235,7 @@ condition is true."
 
 (defmethod output-sql (expr &optional (database *default-database*))
   (write-string (database-output-sql expr database) *sql-stream*)
-  t)
+  (values))
 
 (defmethod output-sql ((expr list) &optional (database *default-database*))
   (if (null expr)
@@ -239,4 +250,17 @@ condition is true."
         (write-char #\) *sql-stream*)))
   t)
 
+(defmethod describe-table ((table sql-create-table)
+                          &key (database *default-database*))
+  (database-describe-table
+   database
+   (string-downcase (symbol-name (slot-value table 'name)))))
 
+#+nil
+(defmethod add-storage-class ((self database) (class symbol) &key (sequence t))
+  (let ((tablename (view-table (find-class class))))
+    (unless (tablep tablename)
+      (create-view-from-class class)
+      (when sequence
+        (create-sequence-from-class class)))))
+