CREATE-VIEW and DROP-VIEW

The following patch implements create-view and drop-view as specified in
the CommonSQL reference manual. The following simple example uses the
database described in the usql tutorial:

USER> (sql:create-view [lenins-group]
                 :column-list '([forename] [surname] [email])
                 :as [select [first-name] [last-name] [email]
                             :from [employee]
                             :where [= [managerid] 1]])
USER> (sql:select [forename] [surname] [email] :from [lenins-group])
(("Josef" "Stalin" "[email protected]"))
USER> (sql:drop-view [lenins-group])
USER>

Drop-view tests whether the supplied view actually exists using the
generic functions DATABASE-VIEWP and DATABASE-LIST-VIEWS (in
dbms-interface.lisp). The patch contains corresponding methods for
postgresql (in postgresql-sql.lisp) but not for the oracle or mysql
backends since I don't use those.

Cheers,
Marcus
--

cvs server: Diffing .
cvs server: Diffing dbms
cvs server: Diffing dbms/mysql
cvs server: Diffing dbms/oracle
cvs server: Diffing dbms/postgresql
Index: dbms/postgresql/postgresql-sql.lisp
===================================================================
RCS file: /cvs/usql/dbms/postgresql/postgresql-sql.lisp,v
retrieving revision 1.41
diff -u -r1.41 postgresql-sql.lisp
--- dbms/postgresql/postgresql-sql.lisp	2003/03/26 17:11:21	1.41
+++ dbms/postgresql/postgresql-sql.lisp	2004/03/07 20:54:04
@@ -359,6 +359,26 @@
 ;;(defmethod database-add-attribute (table attribute database)
 ;;  (let ((attname (slot-value attribute 'name)

+(defmethod database-list-views ((database postgresql-database)
+                                &key (system-views nil))
+  (let ((res (select [viewname] :from [pg_views] :flatp t :database database)))
+    (if (not system-views)
+        (remove-if #'(lambda (view) (equal (subseq view 0 3) "pg_")) res)
+        res)))
+
+(defmethod database-viewp ((database postgresql-database) name)
+  (let ((tref (etypecase name
+                (string (string-upcase name))
+                (sql-sys::sql-ident
+                 (sql name))
+                (symbol
+                 (sql-escape (sql name))))))
+    (when (and tref
+               (member (string-upcase (subseq tref 0 (min (length tref) (1- *max-identifier-length*))))
+                       (mapcar #'string-upcase
+                               (database-list-views database :system-views t))
+                       :test #'equal))
+      t)))

 (defmethod database-output-sql ((expr sql-sys::sql-typecast-exp) (database postgresql-database))
   (with-slots (sql-sys::modifier sql-sys::components)
cvs server: Diffing debian
cvs server: Diffing doc
cvs server: Diffing doc/refguide
cvs server: Diffing sql
Index: sql/classes.lisp
===================================================================
RCS file: /cvs/usql/sql/classes.lisp,v
retrieving revision 1.59
diff -u -r1.59 classes.lisp
--- sql/classes.lisp	2002/12/05 17:37:14	1.59
+++ sql/classes.lisp	2004/03/07 20:54:05
@@ -678,7 +678,28 @@
           (write-string (car modifier) *sql-stream*)))
       (write-char #\) *sql-stream*)))
   t)
-
+
+
+;; CREATE VIEW
+
+(defclass sql-create-view (%sql-expression)
+  ((name :initarg :name :initform nil)
+   (column-list :initarg :column-list :initform nil)
+   (query :initarg :query :initform nil)
+   (with-check-option :initarg :with-check-option :initform nil))
+  (:documentation "An SQL CREATE VIEW statement."))
+
+(defmethod output-sql ((stmt sql-create-view) &optional database)
+  (with-slots (name column-list query with-check-option) stmt
+    (write-string "CREATE VIEW " *sql-stream*)
+    (output-sql name database)
+    (when column-list (write-string " " *sql-stream*)
+          (output-sql (listify column-list) database))
+    (write-string " AS " *sql-stream*)
+    (output-sql query database)
+    (when with-check-option (write-string " WITH CHECK OPTION" *sql-stream*))))
+
+
 ;; Keep a hashtable for mapping symbols to sql generator functions,
 ;; for use by the bracketed reader syntax.

Index: sql/dbms-interface.lisp
===================================================================
RCS file: /cvs/usql/sql/dbms-interface.lisp,v
retrieving revision 1.12
diff -u -r1.12 dbms-interface.lisp
--- sql/dbms-interface.lisp	2003/01/03 05:24:08	1.12
+++ sql/dbms-interface.lisp	2004/03/07 20:54:05
@@ -120,4 +120,11 @@
 (defgeneric oid (object)
   (:documentation "Return the unique ID of a database object."))

+(defgeneric database-viewp (database view-name)
+  (:documentation
+   "If view with given name VIEW-NAME exists in DATABASE, returns true."))
+
+(defgeneric database-list-views (database &key system-views)
+  (:documentation "List all views in the given database"))
+
 )                                       ; eval-when
Index: sql/package.lisp
===================================================================
RCS file: /cvs/usql/sql/package.lisp,v
retrieving revision 1.39
diff -u -r1.39 package.lisp
--- sql/package.lisp	2002/10/30 21:47:58	1.39
+++ sql/package.lisp	2004/03/07 20:54:05
@@ -65,6 +65,8 @@
      "DATABASE-GET-TYPE-SPECIFIER"
      "DATABASE-LIST-TABLES"
      "DATABASE-TABLEP"
+     "DATABASE-LIST-VIEWS"
+     "DATABASE-VIEWP"
      "DATABASE-LIST-INDEXES"
      "DATABASE-INDEXP"
      "DATABASE-LIST-SEQUENCES"
Index: sql/table.lisp
===================================================================
RCS file: /cvs/usql/sql/table.lisp,v
retrieving revision 1.24
diff -u -r1.24 table.lisp
--- sql/table.lisp	2002/08/06 14:46:01	1.24
+++ sql/table.lisp	2004/03/07 20:54:06
@@ -111,3 +111,43 @@
 (defun rename-attribute (table oldatt newname
 			       &key (database *default-database*))
   (error "(rename-attribute ~a ~a ~a ~a) is not implemented" table oldatt newname database))
+
+(defun create-view (name &key column-list as (with-check-option nil)
+                         (database *default-database*))
+  "The CREATE-VIEW function creates a view called NAME using the AS
+query and the optional COLUMN-LIST and WITH-CHECK-OPTION. The
+COLUMN-LIST argument is a list of columns to add to the view. The
+WITH-CHECK-OPTION adds 'WITH CHECK OPTION' to the resulting SQL. The
+default value of WITH-CHECK-OPTION is NIL. The default value of
+DATABASE is *default-database*."
+  (execute-command
+   (make-instance 'sql-sys::sql-create-view
+                  :name name
+                  :column-list column-list
+                  :query as
+                  :with-check-option with-check-option)
+   :database database)
+  (values))
+
+(defun drop-view (name &key (database *default-database*)
+                       (if-does-not-exist :error))
+  "Deletes view NAME from DATABASE which defaults to *default-database*."
+  (let ((view-name (etypecase name
+                     (string name)
+                     (sql-sys::sql-ident (sql-sys::generate-sql name)))))
+    (case if-does-not-exist
+      (:ignore (unless (viewp view-name) (return-from drop-view)))
+      (t
+       (execute-command (concatenate 'string "DROP VIEW " view-name)
+                        :database database)))
+    (values)))
+
+(defun viewp (view-name &key (database *default-database*))
+  (database-viewp database view-name))
+
+(defun list-views (&key (database *default-database*)
+                        (system-views nil))
+  "Returns a list of strings representing views in DATABASE which
+defaults to *default-database*. If SYSTEM-VIEWS is true, then non-user
+views are included as well."
+  (database-list-views database :system-views system-views))
cvs server: Diffing sql/tests