* doc/csql.xml: Update def-view-class documentation
* test/test-init.lisp: Change old :db-type to :db-kind.
Remove old :nulls-ok attributes.
-
+ * sql/objects.lisp: Add new universal-time and bigint
+ types. Optimize reading of integers using parse-integer
+ rather than read-from-string.
+ * */*.lisp: Merge clsql-base-sys and clsql-base packages
+ into clsql-base package
+
1 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
* Version 2.10.5: SQLite backend now passes all result-types tests
* clsql-sqlite.asd: Depend on clsql-uffi system
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
;;; Query
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
(defclass database ()
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
;;; Conditions
(define-condition clsql-condition ()
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
(setf (documentation 'database-name 'function)
"Returns the name of a database.")
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
(defgeneric database-type-load-foreign (database-type)
(:documentation
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
(defvar *loaded-database-types* nil
"Contains a list of database types which have been defined/loaded.")
(unless in-phrase
(ansi-loop::loop-error "Missing OF or IN iteration path."))
(unless from-phrase
- (setq from-phrase '(clsql-base-sys:*default-database*)))
+ (setq from-phrase '(clsql-base:*default-database*)))
(cond
((consp variable)
(let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
'loop-record-result-set-))
(step-var (ansi-loop::loop-gentemp 'loop-record-step-)))
(push `(when ,result-set-var
- (clsql-base-sys:database-dump-result-set ,result-set-var ,db-var))
+ (clsql-base:database-dump-result-set ,result-set-var ,db-var))
ansi-loop::*loop-epilogue*)
`(((,variable nil ,@(and data-type (list data-type)))
(,query-var ,(first in-phrase))
(,result-set-var nil)
(,step-var nil))
((multiple-value-bind (%rs %cols)
- (clsql-base-sys:database-query-result-set ,query-var ,db-var)
+ (clsql-base:database-query-result-set ,query-var ,db-var)
(setq ,result-set-var %rs ,step-var (make-list %cols))))
()
()
- (not (clsql-base-sys:database-store-next-row ,result-set-var ,db-var ,step-var))
+ (not (clsql-base:database-store-next-row ,result-set-var ,db-var ,step-var))
(,variable ,step-var)
(not ,result-set-var)
()
- (not (clsql-base-sys:database-store-next-row ,result-set-var ,db-var ,step-var))
+ (not (clsql-base:database-store-next-row ,result-set-var ,db-var ,step-var))
(,variable ,step-var))))
(t
(let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
(result-set-var (ansi-loop::loop-gentemp
'loop-record-result-set-)))
(push `(when ,result-set-var
- (clsql-base-sys:database-dump-result-set ,result-set-var ,db-var))
+ (clsql-base:database-dump-result-set ,result-set-var ,db-var))
ansi-loop::*loop-epilogue*)
`(((,variable nil ,@(and data-type (list data-type)))
(,query-var ,(first in-phrase))
(,db-var ,(first from-phrase))
(,result-set-var nil))
((multiple-value-bind (%rs %cols)
- (clsql-base-sys:database-query-result-set ,query-var ,db-var)
+ (clsql-base:database-query-result-set ,query-var ,db-var)
(setq ,result-set-var %rs ,variable (make-list %cols))))
()
()
- (not (clsql-base-sys:database-store-next-row ,result-set-var ,db-var ,variable))
+ (not (clsql-base:database-store-next-row ,result-set-var ,db-var ,variable))
()
(not ,result-set-var)
()
- (not (clsql-base-sys:database-store-next-row ,result-set-var ,db-var ,variable))
+ (not (clsql-base:database-store-next-row ,result-set-var ,db-var ,variable))
()))))))
#+(or cmu scl sbcl openmcl allegro)
(unless in-phrase
(error "Missing OF or IN iteration path."))
(unless from-phrase
- (setq from-phrase '(clsql-base-sys:*default-database*)))
+ (setq from-phrase '(clsql-base:*default-database*)))
(cond
((consp iter-var)
(let ((query-var (gensym "LOOP-RECORD-"))
(,result-set-var nil)
(,step-var nil))
`((multiple-value-bind (%rs %cols)
- (clsql-base-sys:database-query-result-set ,query-var ,db-var)
+ (clsql-base:database-query-result-set ,query-var ,db-var)
(setq ,result-set-var %rs ,step-var (make-list %cols))))
()
()
- `((unless (clsql-base-sys:database-store-next-row ,result-set-var ,db-var ,step-var)
+ `((unless (clsql-base:database-store-next-row ,result-set-var ,db-var ,step-var)
(when ,result-set-var
- (clsql-base-sys:database-dump-result-set ,result-set-var ,db-var))
+ (clsql-base:database-dump-result-set ,result-set-var ,db-var))
t))
`(,iter-var ,step-var)
- `((unless (clsql-base-sys:database-store-next-row ,result-set-var ,db-var ,step-var)
+ `((unless (clsql-base:database-store-next-row ,result-set-var ,db-var ,step-var)
(when ,result-set-var
- (clsql-base-sys:database-dump-result-set ,result-set-var ,db-var))
+ (clsql-base:database-dump-result-set ,result-set-var ,db-var))
t))
`(,iter-var ,step-var)
()
(,db-var ,(first from-phrase))
(,result-set-var nil))
`((multiple-value-bind (%rs %cols)
- (clsql-base-sys:database-query-result-set ,query-var ,db-var)
+ (clsql-base:database-query-result-set ,query-var ,db-var)
(setq ,result-set-var %rs ,iter-var (make-list %cols))))
()
()
- `((unless (clsql-base-sys:database-store-next-row ,result-set-var ,db-var ,iter-var)
+ `((unless (clsql-base:database-store-next-row ,result-set-var ,db-var ,iter-var)
(when ,result-set-var
- (clsql-base-sys:database-dump-result-set ,result-set-var ,db-var))
+ (clsql-base:database-dump-result-set ,result-set-var ,db-var))
t))
()
- `((unless (clsql-base-sys:database-store-next-row ,result-set-var ,db-var ,iter-var)
+ `((unless (clsql-base:database-store-next-row ,result-set-var ,db-var ,iter-var)
(when ,result-set-var
- (clsql-base-sys:database-dump-result-set ,result-set-var ,db-var))
+ (clsql-base:database-dump-result-set ,result-set-var ,db-var))
t))
()
()
;;;; This file makes the required package definitions for CLSQL's
;;;; core packages.
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(defpackage #:clsql-base-sys
+(defpackage #:clsql-base
(:use #:cl)
(:export
- ;; "Private" exports for use by interface packages
#:check-connection-spec
#:database-type-load-foreign
#:database-type-library-loaded ;; KMR - Tests if foreign library okay
#:convert-to-db-default-case
#:ensure-keyword
- ;; Shared exports for re-export by CLSQL-BASE
- .
- #1=(#:clsql-condition
- #:clsql-error
- #:clsql-simple-error
- #:clsql-warning
- #:clsql-simple-warning
- #:clsql-invalid-spec-error
- #:clsql-invalid-spec-error-connection-spec
- #:clsql-invalid-spec-error-database-type
- #:clsql-invalid-spec-error-template
- #:clsql-access-error
- #:clsql-access-error-database-type
- #:clsql-access-error-connection-spec
- #:clsql-access-error-error
- #:clsql-connect-error
- #:clsql-connect-error-errno
- #:clsql-sql-error
- #:clsql-sql-error-database
- #:clsql-sql-error-expression
- #:clsql-sql-error-errno
- #:clsql-sql-error-error
- #:clsql-database-warning
- #:clsql-database-warning-database
- #:clsql-database-warning-message
- #:clsql-exists-condition
- #:clsql-exists-condition-new-db
- #:clsql-exists-condition-old-db
- #:clsql-exists-warning
- #:clsql-exists-error
- #:clsql-closed-error
- #:clsql-closed-error-database
- #:clsql-sql-syntax-error
- #:clsql-type-error
- #:clsql-odbc-error
- #:clsql-odbc-error-message
-
- #:*loaded-database-types*
- #:reload-database-types
- #:*default-database-type*
- #:*initialized-database-types*
- #:initialize-database-type
- #:*connect-if-exists*
- #:*default-database*
- #:connected-databases
- #:database
- #:database-name
- #:find-database
- #:database-name-from-spec
- #:is-database-open
-
- ;; accessors for database class
- #:name
- #:connection-spec
- #:transaction
- #:transaction-level
- #:conn-pool
- #:command-recording-stream
- #:result-recording-stream
- #:query-recording-stream
- #:view-classes
- #:database-type
- #:database-state
- #:attribute-cache
-
- ;; utils.lisp
- #:number-to-sql-string
- #:float-to-sql-string
- #:sql-escape-quotes
-
- ;; time.lisp
- #:bad-component
- #:current-day
- #:current-month
- #:current-year
- #:day-duration
- #:db-timestring
- #:decode-duration
- #:decode-time
- #:duration
- #:duration+
- #:duration<
- #:duration<=
- #:duration=
- #:duration>
- #:duration>=
- #:duration-day
- #:duration-hour
- #:duration-minute
- #:duration-month
- #:duration-second
- #:duration-year
- #:duration-reduce
- #:duration-timestring
- #:extract-roman
- #:format-duration
- #:format-time
- #:get-time
- #:utime->time
- #:interval-clear
- #:interval-contained
- #:interval-data
- #:interval-edit
- #:interval-end
- #:interval-match
- #:interval-push
- #:interval-relation
- #:interval-start
- #:interval-type
- #:make-duration
- #:make-interval
- #:make-time
- #:merged-time
- #:midnight
- #:month-name
- #:parse-date-time
- #:parse-timestring
- #:parse-yearstring
- #:print-date
- #:roll
- #:roll-to
- #:time
- #:time+
- #:time-
- #:time-by-adding-duration
- #:time-compare
- #:time-difference
- #:time-dow
- #:time-element
- #:time-max
- #:time-min
- #:time-mjd
- #:time-msec
- #:time-p
- #:time-sec
- #:time-well-formed
- #:time-ymd
- #:time<
- #:time<=
- #:time=
- #:time>
- #:time>=
- #:timezone
- #:universal-time
- #:wall-time
- #:wall-timestring
- #:week-containing
- #:gregorian-to-mjd
- #:mjd-to-gregorian
- x
- ;; recording.lisp -- SQL I/O Recording
- #:record-sql-action
- #:add-sql-stream ; recording xx
- #:delete-sql-stream ; recording xx
- #:list-sql-streams ; recording xx
- #:sql-recording-p ; recording xx
- #:sql-stream ; recording xx
- #:start-sql-recording ; recording xx
- #:stop-sql-recording ; recording xx
-
- ;; database.lisp -- Connection
- #:*default-database-type* ; clsql-base xx
- #:*default-database* ; classes xx
- #:connect ; database xx
- #:*connect-if-exists* ; database xx
- #:connected-databases ; database xx
- #:database ; database xx
- #:database-name ; database xx
- #:disconnect ; database xx
- #:reconnect ; database
- #:find-database ; database xx
- #:status ; database xx
- #:with-database
- #:with-default-database
- #:disconnect-pooled
- #:create-database
- #:destroy-database
- #:probe-database
- #:list-databases
-
- ;; basic-sql.lisp
- #:query
- #:execute-command
- #:write-large-object
- #:read-large-object
- #:delete-large-object
- #:do-query
- #:map-query
- #:describe-table
-
- ;; Transactions
- #:with-transaction
- #:commit-transaction
- #:rollback-transaction
- #:add-transaction-commit-hook
- #:add-transaction-rollback-hook
- #:commit ; transact xx
- #:rollback ; transact xx
- #:with-transaction ; transact xx .
- #:start-transaction ; transact xx
- #:in-transaction-p ; transact xx
- #:database-start-transaction
- #:database-abort-transaction
- #:database-commit-transaction
- #:transaction-level
- #:transaction
+ #:clsql-condition
+ #:clsql-error
+ #:clsql-simple-error
+ #:clsql-warning
+ #:clsql-simple-warning
+ #:clsql-invalid-spec-error
+ #:clsql-invalid-spec-error-connection-spec
+ #:clsql-invalid-spec-error-database-type
+ #:clsql-invalid-spec-error-template
+ #:clsql-access-error
+ #:clsql-access-error-database-type
+ #:clsql-access-error-connection-spec
+ #:clsql-access-error-error
+ #:clsql-connect-error
+ #:clsql-connect-error-errno
+ #:clsql-sql-error
+ #:clsql-sql-error-database
+ #:clsql-sql-error-expression
+ #:clsql-sql-error-errno
+ #:clsql-sql-error-error
+ #:clsql-database-warning
+ #:clsql-database-warning-database
+ #:clsql-database-warning-message
+ #:clsql-exists-condition
+ #:clsql-exists-condition-new-db
+ #:clsql-exists-condition-old-db
+ #:clsql-exists-warning
+ #:clsql-exists-error
+ #:clsql-closed-error
+ #:clsql-closed-error-database
+ #:clsql-sql-syntax-error
+ #:clsql-type-error
+ #:clsql-odbc-error
+ #:clsql-odbc-error-message
+
+ #:*loaded-database-types*
+ #:reload-database-types
+ #:*default-database-type*
+ #:*initialized-database-types*
+ #:initialize-database-type
+ #:*connect-if-exists*
+ #:*default-database*
+ #:connected-databases
+ #:database
+ #:database-name
+ #:find-database
+ #:database-name-from-spec
+ #:is-database-open
+
+ ;; accessors for database class
+ #:name
+ #:connection-spec
+ #:transaction
+ #:transaction-level
+ #:conn-pool
+ #:command-recording-stream
+ #:result-recording-stream
+ #:query-recording-stream
+ #:view-classes
+ #:database-type
+ #:database-state
+ #:attribute-cache
+
+ ;; utils.lisp
+ #:number-to-sql-string
+ #:float-to-sql-string
+ #:sql-escape-quotes
+
+ ;; time.lisp
+ #:bad-component
+ #:current-day
+ #:current-month
+ #:current-year
+ #:day-duration
+ #:db-timestring
+ #:decode-duration
+ #:decode-time
+ #:duration
+ #:duration+
+ #:duration<
+ #:duration<=
+ #:duration=
+ #:duration>
+ #:duration>=
+ #:duration-day
+ #:duration-hour
+ #:duration-minute
+ #:duration-month
+ #:duration-second
+ #:duration-year
+ #:duration-reduce
+ #:duration-timestring
+ #:extract-roman
+ #:format-duration
+ #:format-time
+ #:get-time
+ #:utime->time
+ #:interval-clear
+ #:interval-contained
+ #:interval-data
+ #:interval-edit
+ #:interval-end
+ #:interval-match
+ #:interval-push
+ #:interval-relation
+ #:interval-start
+ #:interval-type
+ #:make-duration
+ #:make-interval
+ #:make-time
+ #:merged-time
+ #:midnight
+ #:month-name
+ #:parse-date-time
+ #:parse-timestring
+ #:parse-yearstring
+ #:print-date
+ #:roll
+ #:roll-to
+ #:time
+ #:time+
+ #:time-
+ #:time-by-adding-duration
+ #:time-compare
+ #:time-difference
+ #:time-dow
+ #:time-element
+ #:time-max
+ #:time-min
+ #:time-mjd
+ #:time-msec
+ #:time-p
+ #:time-sec
+ #:time-well-formed
+ #:time-ymd
+ #:time<
+ #:time<=
+ #:time=
+ #:time>
+ #:time>=
+ #:timezone
+ #:universal-time
+ #:wall-time
+ #:wall-timestring
+ #:week-containing
+ #:gregorian-to-mjd
+ #:mjd-to-gregorian
- ;; Database features specialized by backend
- #:db-type-use-column-on-drop-index?
- #:db-type-has-views?
- #:db-type-has-subqueries?
- #:db-type-has-boolean-where?
- #:db-type-has-fancy-math?
- #:db-type-default-case
- #:db-backend-has-create/destroy-db?
- #:db-type-transaction-capable?
- ))
- (:documentation "This is the INTERNAL SQL-Interface package of CLSQL-BASE."))
+ ;; recording.lisp -- SQL I/O Recording
+ #:record-sql-action
+ #:add-sql-stream ; recording xx
+ #:delete-sql-stream ; recording xx
+ #:list-sql-streams ; recording xx
+ #:sql-recording-p ; recording xx
+ #:sql-stream ; recording xx
+ #:start-sql-recording ; recording xx
+ #:stop-sql-recording ; recording xx
-(defpackage #:clsql-base
- (:import-from #:clsql-base-sys . #1#)
- (:export . #1#)
- (:documentation "This is the SQL-Interface package of CLSQL-BASE."))
-);eval-when
+ ;; database.lisp -- Connection
+ #:*default-database-type* ; clsql-base xx
+ #:*default-database* ; classes xx
+ #:connect ; database xx
+ #:*connect-if-exists* ; database xx
+ #:connected-databases ; database xx
+ #:database ; database xx
+ #:database-name ; database xx
+ #:disconnect ; database xx
+ #:reconnect ; database
+ #:find-database ; database xx
+ #:status ; database xx
+ #:with-database
+ #:with-default-database
+ #:disconnect-pooled
+ #:create-database
+ #:destroy-database
+ #:probe-database
+ #:list-databases
+
+ ;; basic-sql.lisp
+ #:query
+ #:execute-command
+ #:write-large-object
+ #:read-large-object
+ #:delete-large-object
+ #:do-query
+ #:map-query
+ #:describe-table
+
+ ;; Transactions
+ #:with-transaction
+ #:commit-transaction
+ #:rollback-transaction
+ #:add-transaction-commit-hook
+ #:add-transaction-rollback-hook
+ #:commit ; transact xx
+ #:rollback ; transact xx
+ #:with-transaction ; transact xx .
+ #:start-transaction ; transact xx
+ #:in-transaction-p ; transact xx
+ #:database-start-transaction
+ #:database-abort-transaction
+ #:database-commit-transaction
+ #:transaction-level
+ #:transaction
+
+ ;; Database features specialized by backend
+ #:db-type-use-column-on-drop-index?
+ #:db-type-has-views?
+ #:db-type-has-subqueries?
+ #:db-type-has-boolean-where?
+ #:db-type-has-fancy-math?
+ #:db-type-default-case
+ #:db-backend-has-create/destroy-db?
+ #:db-type-transaction-capable?
+ )
+ (:documentation "This is the INTERNAL SQL-Interface package of CLSQL-BASE."))
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
(defvar *db-pool* (make-hash-table :test #'equal))
(defvar *db-pool-lock* (make-process-lock "DB Pool lock"))
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
(defun start-sql-recording (&key (type :commands) (database *default-database*))
"Begin recording SQL command or result traffic. By default the
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
;; ------------------------------------------------------------
;; Months
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
(defclass transaction ()
((commit-hooks :initform () :accessor commit-hooks)
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package #:clsql-base-sys)
+(in-package #:clsql-base)
(defun number-to-sql-string (num)
(etypecase num
(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage #:clsql-classic-sys
(:nicknames #:clsql-classic)
- (:use #:cl #:clsql-base-sys)
+ (:use #:cl #:clsql-base)
(:import-from
#:clsql-base
.
(defpackage #:clsql-aodbc
(:nicknames #:aodbc)
- (:use :cl :clsql-base-sys)
+ (:use #:cl #:clsql-base)
(:export #:aodbc-database)
(:documentation "This is the CLSQL interface to Allegro's AODBC"))
(in-package #:clsql-aodbc)
;; interface foreign library loading routines
-(defmethod clsql-base-sys:database-type-library-loaded ((database-type (eql :aodbc)))
+(defmethod clsql-base:database-type-library-loaded ((database-type (eql :aodbc)))
"T if foreign library was able to be loaded successfully. "
(when (find-package :dbi) ;; finds Allegro's DBI (AODBC) package
t))
-(defmethod clsql-base-sys:database-type-load-foreign ((databae-type (eql :aodbc)))
+(defmethod clsql-base:database-type-load-foreign ((databae-type (eql :aodbc)))
t)
(when (find-package :dbi)
- (clsql-base-sys:database-type-load-foreign :aodbc))
+ (clsql-base:database-type-load-foreign :aodbc))
(defmethod database-initialize-database-type ((database-type (eql :aodbc)))
t)
(defmethod db-backend-has-create/destroy-db? ((db-type (eql :aodbc)))
nil)
-#+ignore
-(when (clsql-base-sys:database-type-library-loaded :aodbc)
- (clsql-base-sys:initialize-database-type :database-type :aodbc))
+(defmethod database-initialize-database-type ((database-type (eql :aodbc)))
+ t)
+
+(when (clsql-base:database-type-library-loaded :aodbc)
+ (clsql-base:initialize-database-type :database-type :aodbc))
(defvar *mysql-library-loaded* nil
"T if foreign library was able to be loaded successfully")
-(defmethod clsql-base-sys:database-type-library-loaded ((database-type (eql :mysql)))
+(defmethod clsql-base:database-type-library-loaded ((database-type (eql :mysql)))
*mysql-library-loaded*)
-(defmethod clsql-base-sys:database-type-load-foreign ((database-type (eql :mysql)))
+(defmethod clsql-base:database-type-load-foreign ((database-type (eql :mysql)))
(let ((mysql-path
(uffi:find-foreign-library *mysql-library-candidate-names*
*mysql-library-candidate-directories*
(setq *mysql-library-loaded* t))
-(clsql-base-sys:database-type-load-foreign :mysql)
+(clsql-base:database-type-load-foreign :mysql)
;;;; *************************************************************************
(defpackage #:clsql-mysql
- (:use #:common-lisp #:clsql-base-sys #:mysql #:clsql-uffi)
+ (:use #:common-lisp #:clsql-base #:mysql #:clsql-uffi)
(:export #:mysql-database)
(:documentation "This is the CLSQL interface to MySQL."))
(defmethod database-create (connection-spec (type (eql :mysql)))
(destructuring-bind (host name user password) connection-spec
(multiple-value-bind (output status)
- (clsql-base-sys:command-output "mysqladmin create -u~A -p~A -h~A ~A"
+ (clsql-base:command-output "mysqladmin create -u~A -p~A -h~A ~A"
user password
(if host host "localhost")
name)
(defmethod database-destroy (connection-spec (type (eql :mysql)))
(destructuring-bind (host name user password) connection-spec
(multiple-value-bind (output status)
- (clsql-base-sys:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A"
+ (clsql-base:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A"
user password
(if host host "localhost")
name)
(let ((database (database-connect (list host "mysql" user password) type)))
(unwind-protect
(progn
- (setf (slot-value database 'clsql-base-sys::state) :open)
+ (setf (slot-value database 'clsql-base::state) :open)
(mapcar #'car (database-query "show databases" database :auto nil)))
(progn
(database-disconnect database)
- (setf (slot-value database 'clsql-base-sys::state) :closed))))))
+ (setf (slot-value database 'clsql-base::state) :closed))))))
;;; Database capabilities
(let ((tuple (car (database-query "SHOW VARIABLES LIKE 'HAVE_INNODB'" database :auto nil))))
(and tuple (string-equal "YES" (second tuple)))))
-(when (clsql-base-sys:database-type-library-loaded :mysql)
- (clsql-base-sys:initialize-database-type :database-type :mysql))
+(when (clsql-base:database-type-library-loaded :mysql)
+ (clsql-base:initialize-database-type :database-type :mysql))
(progn ,result-code ,@body))
(#.$SQL_INVALID_HANDLE
(error
- 'clsql-base-sys:clsql-odbc-error
+ 'clsql-base:clsql-odbc-error
:odbc-message "Invalid handle"))
(#.$SQL_STILL_EXECUTING
(error
- 'clsql-base-sys:clsql-odbc-error
+ 'clsql-base:clsql-odbc-error
:odbc-message "Still executing"))
(#.$SQL_ERROR
(multiple-value-bind (error-message sql-state)
(or ,hdbc +null-handle-ptr+)
(or ,hstmt +null-handle-ptr+))
(error
- 'clsql-base-sys:clsql-odbc-error
+ 'clsql-base:clsql-odbc-error
:odbc-message error-message
:sql-state sql-state)))
(otherwise
"get-free-query finds or makes a nonactive query object, and then sets it to active.
This makes the functions db-execute-command and db-query thread safe."
(with-slots (queries hdbc) database
- (or (clsql-base-sys:without-interrupts
+ (or (clsql-base:without-interrupts
(let ((inactive-query (find-if (lambda (query)
(not (query-active-p query)))
queries)))
(defvar *odbc-library-loaded* nil
"T if foreign library was able to be loaded successfully")
-(defmethod clsql-base-sys:database-type-library-loaded ((database-type (eql :odbc)))
+(defmethod clsql-base:database-type-library-loaded ((database-type (eql :odbc)))
*odbc-library-loaded*)
-(defmethod clsql-base-sys:database-type-load-foreign ((database-type (eql :odbc)))
+(defmethod clsql-base:database-type-load-foreign ((database-type (eql :odbc)))
(uffi:load-foreign-library *odbc-library-path*
:module "odbc")
(setq *odbc-library-loaded* t))
-(clsql-base-sys:database-type-load-foreign :odbc)
+(clsql-base:database-type-load-foreign :odbc)
;;;; *************************************************************************
(defpackage #:clsql-odbc
- (:use #:common-lisp #:clsql-base-sys)
+ (:use #:common-lisp #:clsql-base)
(:export #:odbc-database)
(:documentation "This is the CLSQL interface to ODBC."))
;; nothing to do
t)
-(when (clsql-base-sys:database-type-library-loaded :odbc)
- (clsql-base-sys:initialize-database-type :database-type :odbc))
+(when (clsql-base:database-type-library-loaded :odbc)
+ (clsql-base:initialize-database-type :database-type :odbc))
(:float4 700)
(:float8 701)))
-(defmethod clsql-base-sys:database-type-library-loaded ((database-type
+(defmethod clsql-base:database-type-library-loaded ((database-type
(eql :postgresql-socket)))
"T if foreign library was able to be loaded successfully. Always true for
socket interface"
t)
-(defmethod clsql-base-sys:database-type-load-foreign ((database-type (eql :postgresql-socket)))
+(defmethod clsql-base:database-type-load-foreign ((database-type (eql :postgresql-socket)))
t)
(in-package #:cl-user)
(defpackage :clsql-postgresql-socket
- (:use #:common-lisp #:clsql-base-sys #:postgresql-socket)
+ (:use #:common-lisp #:clsql-base #:postgresql-socket)
(:export #:postgresql-socket-database)
(:documentation "This is the CLSQL socket interface to PostgreSQL."))
;; interface foreign library loading routines
-(clsql-base-sys:database-type-load-foreign :postgresql-socket)
+(clsql-base:database-type-load-foreign :postgresql-socket)
;; Field type conversion
type)))
(unwind-protect
(progn
- (setf (slot-value database 'clsql-base-sys::state) :open)
+ (setf (slot-value database 'clsql-base::state) :open)
(mapcar #'car (database-query "select datname from pg_database"
database :auto nil)))
(progn
(database-disconnect database)
- (setf (slot-value database 'clsql-base-sys::state) :closed))))))
+ (setf (slot-value database 'clsql-base::state) :closed))))))
(defmethod database-describe-table ((database postgresql-socket-database)
table)
(defmethod db-type-default-case ((db-type (eql :postgresql-socket)))
:lower)
-(when (clsql-base-sys:database-type-library-loaded :postgresql-socket)
- (clsql-base-sys:initialize-database-type :database-type :postgresql-socket))
+(when (clsql-base:database-type-library-loaded :postgresql-socket)
+ (clsql-base:initialize-database-type :database-type :postgresql-socket))
(defvar *postgresql-library-loaded* nil
"T if foreign library was able to be loaded successfully")
-(defmethod clsql-base-sys:database-type-library-loaded ((database-type
+(defmethod clsql-base:database-type-library-loaded ((database-type
(eql :postgresql)))
*postgresql-library-loaded*)
-(defmethod clsql-base-sys:database-type-load-foreign ((database-type
+(defmethod clsql-base:database-type-load-foreign ((database-type
(eql :postgresql)))
(let ((libpath (uffi:find-foreign-library
"libpq"
(setq *postgresql-library-loaded* t)
(warn "Can't load PostgreSQL client library ~A" libpath))))
-(clsql-base-sys:database-type-load-foreign :postgresql)
+(clsql-base:database-type-load-foreign :postgresql)
(in-package #:cl-user)
(defpackage #:clsql-postgresql
- (:use #:common-lisp #:clsql-base-sys #:postgresql #:clsql-uffi)
+ (:use #:common-lisp #:clsql-base #:postgresql #:clsql-uffi)
(:export #:postgresql-database)
(:documentation "This is the CLSQL interface to PostgreSQL."))
(destructuring-bind (host name user password) connection-spec
(declare (ignore user password))
(multiple-value-bind (output status)
- (clsql-base-sys:command-output "createdb -h~A ~A"
+ (clsql-base:command-output "createdb -h~A ~A"
(if host host "localhost")
name)
(if (or (not (zerop status))
(destructuring-bind (host name user password) connection-spec
(declare (ignore user password))
(multiple-value-bind (output status)
- (clsql-base-sys:command-output "dropdb -h~A ~A"
+ (clsql-base:command-output "dropdb -h~A ~A"
(if host host "localhost")
name)
(if (or (not (zerop status))
type)))
(unwind-protect
(progn
- (setf (slot-value database 'clsql-base-sys::state) :open)
+ (setf (slot-value database 'clsql-base::state) :open)
(mapcar #'car (database-query "select datname from pg_database"
database nil nil)))
(progn
(database-disconnect database)
- (setf (slot-value database 'clsql-base-sys::state) :closed))))))
+ (setf (slot-value database 'clsql-base::state) :closed))))))
(defmethod database-describe-table ((database postgresql-database) table)
(database-query
(defmethod db-type-default-case ((db-type (eql :postgresql)))
:lower)
-(when (clsql-base-sys:database-type-library-loaded :postgresql)
- (clsql-base-sys:initialize-database-type :database-type :postgresql))
+(when (clsql-base:database-type-library-loaded :postgresql)
+ (clsql-base:initialize-database-type :database-type :postgresql))
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package :clsql-sqlite)
+(in-package #:clsql-sqlite)
(defvar *sqlite-supporting-libraries* '("c")
"Used only by CMU. List of library flags needed to be passed to ld
(setq *sqlite-library-loaded* t)
(warn "Can't load SQLite library ~A" libpath))))
-(clsql-base-sys:database-type-load-foreign :sqlite)
+(clsql-base:database-type-load-foreign :sqlite)
(in-package #:cl-user)
(defpackage #:clsql-sqlite
- (:use #:common-lisp #:clsql-base-sys)
+ (:use #:common-lisp #:clsql-base)
(:export #:sqlite-database))
(declare (ignore database))
(progv '(*print-circle* *print-array*) '(t t)
(let ((escaped (prin1-to-string val)))
- (clsql-base-sys::substitute-char-string
+ (clsql-base::substitute-char-string
escaped #\Null " "))))
(defmethod database-output-sql-as-type ((type (eql 'symbol)) val database)
(defmethod database-get-type-specifier (type args database)
(declare (ignore type args))
- (if (clsql-base-sys::in (database-underlying-type database)
+ (if (clsql-base::in (database-underlying-type database)
:postgresql :postgresql-socket)
"VARCHAR"
"VARCHAR(255)"))
database)
(if args
(format nil "VARCHAR(~A)" (car args))
- (if (clsql-base-sys::in (database-underlying-type database)
+ (if (clsql-base::in (database-underlying-type database)
:postgresql :postgresql-socket)
"VARCHAR"
"VARCHAR(255)")))
database)
(if args
(format nil "VARCHAR(~A)" (car args))
- (if (clsql-base-sys::in (database-underlying-type database)
+ (if (clsql-base::in (database-underlying-type database)
:postgresql :postgresql-socket)
"VARCHAR"
"VARCHAR(255)")))
(defmethod database-get-type-specifier ((type (eql 'string)) args database)
(if args
(format nil "VARCHAR(~A)" (car args))
- (if (clsql-base-sys::in (database-underlying-type database)
+ (if (clsql-base::in (database-underlying-type database)
:postgresql :postgresql-socket)
"VARCHAR"
"VARCHAR(255)")))
(declare (ignore database))
(progv '(*print-circle* *print-array*) '(t t)
(let ((escaped (prin1-to-string val)))
- (clsql-base-sys::substitute-char-string
+ (clsql-base::substitute-char-string
escaped #\Null " "))))
(defmethod database-output-sql-as-type ((type (eql 'symbol)) val database)
(defmethod read-sql-value (val (type (eql 'symbol)) database)
(declare (ignore database))
(when (< 0 (length val))
- (unless (string= val (clsql-base-sys:symbol-name-default-case "NIL"))
- (intern (clsql-base-sys:symbol-name-default-case val)
+ (unless (string= val (clsql-base:symbol-name-default-case "NIL"))
+ (intern (clsql-base:symbol-name-default-case val)
(symbol-package *update-context*)))))
(defmethod read-sql-value (val (type (eql 'integer)) database)
(declare (ignore database))
(etypecase val
(string
- (parse-integer val))
+ (unless (string-equal "NIL" val)
+ (parse-integer val)))
(number val)))
(defmethod read-sql-value (val (type (eql 'bigint)) database)
(declare (ignore database))
(etypecase val
(string
- (parse-integer val))
+ (unless (string-equal "NIL" val)
+ (parse-integer val)))
(number val)))
(defmethod read-sql-value (val (type (eql 'float)) database)
(defmethod read-sql-value (val (type (eql 'univeral-time)) database)
(declare (ignore database))
(unless (eq 'NULL val)
- (etypecase val
- (string
- (parse-intger val))
- (number val)))
+ (etypecase val
+ (string
+ (parse-integer val))
+ (number val))))
(defmethod read-sql-value (val (type (eql 'wall-time)) database)
(declare (ignore database))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage #:clsql-sys
- (:use #:common-lisp #:clsql-base-sys
+ (:use #:common-lisp #:clsql-base
#+clsql-sbcl-mop #:sb-mop
#+clsql-cmucl-mop #:mop
#+allegro #:mop
)
(:import-from
- #:clsql-base-sys
+ #:clsql-base
.
#1=(
;; conditions
(defun truncate-database (&key (database *default-database*))
(unless (typep database 'database)
- (clsql-base-sys::signal-no-database-error database))
+ (clsql-base::signal-no-database-error database))
(unless (is-database-open database)
(database-reconnect database))
(when (db-type-has-views? (database-underlying-type database))
t)
(deftest :connection/2
- (clsql-base-sys::string-to-list-connection-spec
+ (clsql-base::string-to-list-connection-spec
"localhost/dbname/user/passwd")
("localhost" "dbname" "user" "passwd"))
(deftest :connection/3
- (clsql-base-sys::string-to-list-connection-spec
+ (clsql-base::string-to-list-connection-spec
"dbname/user@hostname")
("hostname" "dbname" "user"))
t nil)
;; create a view, list its attributes and drop it
-(when (clsql-base-sys:db-type-has-views? *test-database-underlying-type*)
+(when (clsql-base:db-type-has-views? *test-database-underlying-type*)
(deftest :fddl/view/2
(progn (clsql:create-view [lenins-group]
:as [select [first-name] [last-name] [email]
(let ((test (second test-form)))
(cond
((and (null (db-type-has-views? db-underlying-type))
- (clsql-base-sys::in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4))
+ (clsql-base::in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4))
(push (cons test "views not supported") skip-tests))
((and (null (db-type-has-boolean-where? db-underlying-type))
- (clsql-base-sys::in test :fdml/select/11 :oodml/select/5))
+ (clsql-base::in test :fdml/select/11 :oodml/select/5))
(push (cons test "boolean where not supported") skip-tests))
((and (null (db-type-has-subqueries? db-underlying-type))
- (clsql-base-sys::in test :fdml/select/5 :fdml/select/10))
+ (clsql-base::in test :fdml/select/5 :fdml/select/10))
(push (cons test "subqueries not supported") skip-tests))
((and (null (db-type-transaction-capable? db-underlying-type
*default-database*))
- (clsql-base-sys::in test :fdml/transaction/1 :fdml/transaction/2 :fdml/transaction/3 :fdml/transaction/4))
+ (clsql-base::in test :fdml/transaction/1 :fdml/transaction/2 :fdml/transaction/3 :fdml/transaction/4))
(push (cons test "transactions not supported") skip-tests))
((and (null (db-type-has-fancy-math? db-underlying-type))
- (clsql-base-sys::in test :fdml/select/1))
+ (clsql-base::in test :fdml/select/1))
(push (cons test "fancy math not supported") skip-tests))
((and (eql *test-database-type* :sqlite)
- (clsql-base-sys::in test :fddl/view/4 :fdml/select/10))
+ (clsql-base::in test :fddl/view/4 :fdml/select/10))
(push (cons test "not supported by sqlite") skip-tests))
(t
(push test-form test-forms)))))
projects / clsql.git / commitdiff