12 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
- * Version 2.6.5
+ * Version 2.6.7
+ * sql/*.lisp: Remove schema versioning cruft
+ [Marcus Pearce]
+ * Makefile: Add classic subdirectory
+
+12 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
+ * Version 2.6.6
* sql/sql.lisp: Fix TRUNCATE command, bug reported
by Marcus Pearce
* sql/sql.lisp: Remove EXPLAIN function. Postgresql/Oracle
#
# CVS Id: $Id$
#
-# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+# This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
#
# CLSQL users are granted the rights to distribute and use this software
# as governed by the terms of the Lisp Lesser GNU Public License
PKG := clsql
DEBPKG := cl-sql
-SUBDIRS := sql tests uffi base db-mysql db-aodbc \
+SUBDIRS := sql tests uffi base classic db-mysql db-aodbc \
db-postgresql db-postgresql-socket db-sqlite
DOCSUBDIRS:=doc
(defvar *sql-stream* nil
"stream which accumulates SQL output")
-(defvar *default-schema* "UNCOMMONSQL")
-
-(defvar *object-schemas* (make-hash-table :test #'equal)
- "Hash of schema name to class constituent lists.")
-
-(defun in-schema (schemaname)
- (setf *default-schema* schemaname))
-
(defun sql-output (sql-expr &optional database)
(progv '(*sql-stream*)
`(,(make-string-output-stream))
:accessor object-definition
:initarg :definition
:initform nil)
- (version
- :accessor object-version
- :initarg :version
- :initform 0)
(key-slots
:accessor key-slots
:initform nil)
result))
#+lispworks
-(defconstant +extra-class-options+ '(:base-table :version :schemas))
+(defconstant +extra-class-options+ '(:base-table))
#+lispworks
(defmethod clos::canonicalize-class-options :around
(defmethod initialize-instance :around ((class standard-db-class)
&rest all-keys
&key direct-superclasses base-table
- schemas version qualifier
+ qualifier
&allow-other-keys)
(let ((root-class (find-class 'standard-db-object nil))
(vmc (find-class 'standard-db-class)))
(car base-table)
base-table))
(class-name class)))))
- (setf (object-version class) version)
- (mapc (lambda (schema)
- (pushnew (class-name class) (gethash schema *object-schemas*)))
- (if (listp schemas) schemas (list schemas)))
(register-metaclass class (nth (1+ (position :direct-slots all-keys))
all-keys))))
(defmethod reinitialize-instance :around ((class standard-db-class)
&rest all-keys
- &key base-table schemas version
+ &key base-table
direct-superclasses qualifier
&allow-other-keys)
(let ((root-class (find-class 'standard-db-object nil))
direct-superclasses)
(remove-keyword-arg all-keys :direct-superclasses)))
(call-next-method)))
- (setf (object-version class) version)
- (mapc (lambda (schema)
- (pushnew (class-name class) (gethash schema *object-schemas*)))
- (if (listp schemas) schemas (list schemas)))
(register-metaclass class (nth (1+ (position :direct-slots all-keys))
all-keys)))
#:command-recording-stream
#:result-recording-stream
#:database-view-classes
- #:database-schema
#:conn-pool
#:print-object
;; utils
#:reload-database-types ; clsql-base xx
#:database-type ; database x
#:is-database-open
- #:in-schema ; classes x
;;FDDL
#:list-views ; table xx
#:view-exists-p ; table xx
;; Tables
-(defvar *table-schemas* (make-hash-table :test #'equal)
- "Hash of schema name to table lists.")
-
(defun create-table (name description &key (database *default-database*)
(constraints nil))
"Create a table called NAME, in DATABASE which defaults to
:name table-name
:columns description
:modifiers constraints)))
- (pushnew table-name (gethash *default-schema* *table-schemas*)
- :test #'equal)
(execute-command stmt :database database)))
(defun drop-table (name &key (if-does-not-exist :error)
;; Views
-(defvar *view-schemas* (make-hash-table :test #'equal)
- "Hash of schema name to view lists.")
-
(defun create-view (name &key as column-list (with-check-option nil)
(database *default-database*))
"Creates a view called NAME using the AS query and the optional
:column-list column-list
:query as
:with-check-option with-check-option)))
- (pushnew view-name (gethash *default-schema* *view-schemas*) :test #'equal)
(execute-command stmt :database database)))
(defun drop-view (name &key (if-does-not-exist :error)
;; Indexes
-(defvar *index-schemas* (make-hash-table :test #'equal)
- "Hash of schema name to index lists.")
-
(defun create-index (name &key on (unique nil) attributes
(database *default-database*))
"Creates an index called NAME on the table specified by ON. The
(stmt (format nil "CREATE ~A INDEX ~A ON ~A (~{~A~^, ~})"
(if unique "UNIQUE" "")
index-name table-name attributes)))
- (pushnew index-name (gethash *default-schema* *index-schemas*))
(execute-command stmt :database database)))
(defun drop-index (name &key (if-does-not-exist :error)
;; Sequences
-(defvar *sequence-schemas* (make-hash-table :test #'equal)
- "Hash of schema name to sequence lists.")
-
(defun create-sequence (name &key (database *default-database*))
"Create a sequence called NAME in DATABASE which defaults to
*DEFAULT-DATABASE*."
(let ((sequence-name (database-identifier name)))
- (database-create-sequence sequence-name database)
- (pushnew sequence-name (gethash *default-schema* *sequence-schemas*)
- :test #'equal))
+ (database-create-sequence sequence-name database))
(values))
(defun drop-sequence (name &key (if-does-not-exist :error)
projects / clsql.git / commitdiff