From 8a8ee2d7d791b7a3efaed06420802a925d16fca3 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 13 May 2004 06:55:48 +0000 Subject: [PATCH] r9336: 12 May 2004 Kevin Rosenberg (kevin@rosenberg.net) * sql/sql.lisp: Add FOR-EACH-ROW macro from clsql-classic/sql.lisp * clsql-classic: Remove system and subdirectory * clsql-base: Remove system and subdirectory and fold into clsql system --- ChangeLog | 6 + Makefile | 2 +- TODO | 1 + base/.gitignore | 14 - base/Makefile | 6 - base/package.lisp | 305 -------- classic/.gitignore | 14 - classic/Makefile | 6 - classic/functional.lisp | 77 -- classic/package.lisp | 147 ---- classic/sql.lisp | 126 ---- clsql-aodbc.asd | 2 +- clsql-base.asd | 52 -- clsql-classic.asd | 42 -- clsql-mysql.asd | 2 +- clsql-odbc.asd | 2 +- clsql-oracle.asd | 2 +- clsql-postgresql-socket.asd | 2 +- clsql-postgresql.asd | 2 +- clsql-sqlite.asd | 2 +- clsql-uffi.asd | 2 +- clsql.asd | 40 +- db-aodbc/aodbc-package.lisp | 2 +- db-mysql/mysql-loader.lisp | 6 +- db-mysql/mysql-package.lisp | 2 +- db-mysql/mysql-sql.lisp | 14 +- db-odbc/odbc-api.lisp | 12 +- db-odbc/odbc-dbi.lisp | 2 +- db-odbc/odbc-loader.lisp | 6 +- db-odbc/odbc-sql.lisp | 6 +- db-oracle/oracle-package.lisp | 2 +- .../postgresql-socket-api.lisp | 6 +- .../postgresql-socket-sql.lisp | 12 +- db-postgresql/postgresql-loader.lisp | 6 +- db-postgresql/postgresql-sql.lisp | 14 +- db-sqlite/sqlite-loader.lisp | 2 +- db-sqlite/sqlite-package.lisp | 2 +- debian/control | 36 +- debian/rules | 21 +- base/classes.lisp => sql/base-classes.lisp | 2 +- {base => sql}/basic-sql.lisp | 2 +- sql/classes.lisp | 2 +- {base => sql}/cmucl-compat.lisp | 0 {base => sql}/conditions.lisp | 2 +- {base => sql}/database.lisp | 2 +- {base => sql}/db-interface.lisp | 2 +- sql/generics.lisp | 2 +- {base => sql}/initialize.lisp | 2 +- sql/kmr-mop.lisp | 2 +- {base => sql}/loop-extension.lisp | 26 +- sql/metaclasses.lisp | 2 +- sql/objects.lisp | 20 +- sql/operations.lisp | 2 +- sql/package.lisp | 709 +++++++++--------- {base => sql}/pool.lisp | 2 +- {base => sql}/recording.lisp | 2 +- sql/sql.lisp | 76 +- sql/syntax.lisp | 2 +- sql/table.lisp | 2 +- {base => sql}/time.lisp | 2 +- {base => sql}/transaction.lisp | 2 +- {base => sql}/utils.lisp | 2 +- tests/benchmarks.lisp | 6 +- tests/test-basic.lisp | 6 +- tests/test-connection.lisp | 8 +- tests/test-fddl.lisp | 2 +- tests/test-fdml.lisp | 2 +- tests/test-init.lisp | 30 +- tests/test-ooddl.lisp | 20 +- 69 files changed, 600 insertions(+), 1346 deletions(-) delete mode 100644 base/.gitignore delete mode 100644 base/Makefile delete mode 100644 base/package.lisp delete mode 100644 classic/.gitignore delete mode 100644 classic/Makefile delete mode 100644 classic/functional.lisp delete mode 100644 classic/package.lisp delete mode 100644 classic/sql.lisp delete mode 100644 clsql-base.asd delete mode 100644 clsql-classic.asd rename base/classes.lisp => sql/base-classes.lisp (98%) rename {base => sql}/basic-sql.lisp (99%) rename {base => sql}/cmucl-compat.lisp (100%) rename {base => sql}/conditions.lisp (99%) rename {base => sql}/database.lisp (99%) rename {base => sql}/db-interface.lisp (99%) rename {base => sql}/initialize.lisp (98%) rename {base => sql}/loop-extension.lisp (86%) rename {base => sql}/pool.lisp (99%) rename {base => sql}/recording.lisp (99%) rename {base => sql}/time.lisp (99%) rename {base => sql}/transaction.lisp (99%) rename {base => sql}/utils.lisp (99%) diff --git a/ChangeLog b/ChangeLog index 4a655b3..5e40734 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +12 May 2004 Kevin Rosenberg (kevin@rosenberg.net) + * sql/sql.lisp: Add FOR-EACH-ROW macro from clsql-classic/sql.lisp + * clsql-classic: Remove system and subdirectory + * clsql-base: Remove system and subdirectory and + fold into clsql system + 12 May 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.10.16: CLSQL now fully supports AllegroCL AMD64 * db-odbc/odbc-api.lisp: work around return-type bug [spr28889] in diff --git a/Makefile b/Makefile index 32b9722..9c3ef23 100644 --- a/Makefile +++ b/Makefile @@ -15,7 +15,7 @@ PKG := clsql DEBPKG := cl-sql -SUBDIRS := sql tests uffi base classic db-mysql db-aodbc db-odbc \ +SUBDIRS := sql tests uffi db-mysql db-aodbc db-odbc \ db-postgresql db-postgresql-socket db-sqlite DOCSUBDIRS:=doc diff --git a/TODO b/TODO index d7e470a..0beae4c 100644 --- a/TODO +++ b/TODO @@ -8,6 +8,7 @@ TESTS TO ADD * :db-constraint tests * test *db-auto-sync* * test SELECT caching +* for-each-row macro COMMONSQL SPEC diff --git a/base/.gitignore b/base/.gitignore deleted file mode 100644 index 1d27afc..0000000 --- a/base/.gitignore +++ /dev/null @@ -1,14 +0,0 @@ -clsql-uffi.so -clsql-uffi.dll -clsql-uffi.lib -clsql-uffi.dylib -.bin -*.fasl -*.pfsl -*.dfsl -*.cfsl -*.fasla16 -*.fasla8 -*.faslm16 -*.faslm8 -*.fsl diff --git a/base/Makefile b/base/Makefile deleted file mode 100644 index 31dc910..0000000 --- a/base/Makefile +++ /dev/null @@ -1,6 +0,0 @@ -SUBDIRS := - -include ../Makefile.common - -.PHONY: distclean -distclean: clean diff --git a/base/package.lisp b/base/package.lisp deleted file mode 100644 index cfed6e8..0000000 --- a/base/package.lisp +++ /dev/null @@ -1,305 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: package.lisp -;;;; Purpose: Package definition for base (low-level) SQL interface -;;;; Programmers: Kevin M. Rosenberg based on -;;;; Original code by Pierre R. Mai -;;;; Date Started: Feb 2002 -;;;; -;;;; $Id$ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg -;;;; and Copyright (c) 1999-2001 by Pierre R. Mai -;;;; -;;;; 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 #:cl-user) - -;;;; This file makes the required package definitions for CLSQL's -;;;; core packages. - -(defpackage #:clsql-base - (:use #:cl) - (:export - #:check-connection-spec - #:database-type-load-foreign - #:database-type-library-loaded ;; KMR - Tests if foreign library okay - #:database-initialize-database-type - #:database-connect - #:database-disconnect - #:database-reconnect - #:database-query - #:database-execute-command - #:database-query-result-set - #:database-dump-result-set - #:database-store-next-row - #:database-create - #:database-destroy - #:database-probe - #:database-list - #:database-describe-table - #:database-underlying-type - - #:database-list-tables - #:database-list-attributes - #:database-attribute-type - #:database-create-sequence - #:database-drop-sequence - #:database-sequence-next - #:sql-escape - #:database-sequence-last - #:database-set-sequence-position - #:database-list-attributes - #:database-list-sequences - #:database-list-indexes - #:database-list-table-indexes - #:database-list-views - - ;; Large objects - #:database-create-large-object - #:database-write-large-object - #:database-read-large-object - #:database-delete-large-object - #:create-large-object - #:write-large-object - #:read-large-object - #:delete-large-object - - #:command-output - #:make-process-lock - #:with-process-lock - #:connection-spec - #:ensure-keyword - - ;; utils.lisp - #:without-interrupts - #:make-process-lock - #:with-process-lock - #:command-output - #:symbol-name-default-case - #:convert-to-db-default-case - #:ensure-keyword - - #: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 - #:*backend-warning-behavior* - - #:*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 - #:record-caches - #: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 - - ;; recording.lisp -- SQL I/O Recording - #:record-sql-command - #:record-sql-result - #: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 - #: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.")) - - diff --git a/classic/.gitignore b/classic/.gitignore deleted file mode 100644 index 1d27afc..0000000 --- a/classic/.gitignore +++ /dev/null @@ -1,14 +0,0 @@ -clsql-uffi.so -clsql-uffi.dll -clsql-uffi.lib -clsql-uffi.dylib -.bin -*.fasl -*.pfsl -*.dfsl -*.cfsl -*.fasla16 -*.fasla8 -*.faslm16 -*.faslm8 -*.fsl diff --git a/classic/Makefile b/classic/Makefile deleted file mode 100644 index 31dc910..0000000 --- a/classic/Makefile +++ /dev/null @@ -1,6 +0,0 @@ -SUBDIRS := - -include ../Makefile.common - -.PHONY: distclean -distclean: clean diff --git a/classic/functional.lisp b/classic/functional.lisp deleted file mode 100644 index 565c40d..0000000 --- a/classic/functional.lisp +++ /dev/null @@ -1,77 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: functional.lisp -;;;; Purpose: Functional interface -;;;; -;;;; Copyright (c) 1999-2001 Pierre R. Mai -;;;; -;;;; $Id$ -;;;; -;;;; 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-classic) - -;;; This file implements the more advanced functions of the -;;; functional SQL interface, which are just nicer layers above the -;;; basic SQL interface. - -;;; These functions are no longer exported since they conflict with names -;;; exported by CLSQL - -(defun insert-records - (&key into attributes values av-pairs query (database *default-database*)) - "Insert records into the given table according to the given options." - (cond - ((and av-pairs (or attributes values)) - (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records.")) - ((and (or av-pairs values) query) - (error - "Supply either query or values/av-pairs to call of insert-records.")) - ((and attributes (not query) - (or (not (listp values)) (/= (length attributes) (length values)))) - (error "You must supply a matching values list when using attributes in call of insert-records.")) - (query - (execute-command - (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query) - :database database)) - (t - (execute-command - (multiple-value-bind (attributes values) - (if av-pairs - (values (mapcar #'first av-pairs) (mapcar #'second av-pairs)) - (values attributes values)) - (format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})" - into attributes values)) - :database database)))) - -(defun delete-records (&key from where (database *default-database*)) - "Delete the indicated records from the given database." - (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where) - :database database)) - -(defun update-records (table &key attributes values av-pairs where (database *default-database*)) - "Update the specified records in the given database." - (cond - ((and av-pairs (or attributes values)) - (error "Supply either av-pairs or values (and possibly attributes) to call of update-records.")) - ((and attributes - (or (not (listp values)) (/= (length attributes) (length values)))) - (error "You must supply a matching values list when using attributes in call of update-records.")) - ((or (and attributes (not values)) (and values (not attributes))) - (error "You must supply both values and attributes in call of update-records.")) - (t - (execute-command - (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]" - table - (or av-pairs - (mapcar #'list attributes values)) - where) - :database database)))) - diff --git a/classic/package.lisp b/classic/package.lisp deleted file mode 100644 index 004dd47..0000000 --- a/classic/package.lisp +++ /dev/null @@ -1,147 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: package.lisp -;;;; Purpose: Package definition for CLSQL-CLASSIC high-level interface -;;;; Programmers: Kevin M. Rosenberg based on -;;;; Original code by Pierre R. Mai -;;;; Date Started: Feb 2002 -;;;; -;;;; $Id$ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg -;;;; and Copyright (c) 1999-2001 by Pierre R. Mai -;;;; -;;;; 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 #:cl-user) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (defpackage #:clsql-classic - (:use #:cl #:clsql-base) - (:import-from - #: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 - - #:*loaded-database-types* - #:reload-database-types - #:*default-database-type* - #:*initialized-database-types* - #:initialize-database-type - - #:database - #:database-name - #:database-type - #:is-database-open - #:database-name-from-spec - - ;; utils.lisp - #:number-to-sql-string - #:float-to-sql-string - #:sql-escape-quotes - - ;; 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 - #:create-database - #:destroy-database - #:probe-database - - ;; basic-sql.lisp - #:query - #:execute-command - #:write-large-object - #:read-large-object - #:delete-large-object - - ;; 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 - #:disconnect-pooled - )) - (:export - ;; sql.cl - #:for-each-row - - ;; Large objects (Marc B) - #:create-large-object - #:write-large-object - #:read-large-object - #:delete-large-object - - ;; functional.lisp - ;; These are no longer export since different functions are - ;; exported by the CLSQL package - ;; #:insert-records - ;; #:delete-records - ;; #:update-records - - . - #1# - ) - (:documentation "This is the INTERNAL SQL-Interface package of CLSQL-CLASSIC.")) - - ) ;eval-when - -(defpackage #:clsql-classic-user - (:use #:common-lisp #:clsql-classic) - (:documentation "This is the user package for experimenting with CLSQL-CLASSIC.")) diff --git a/classic/sql.lisp b/classic/sql.lisp deleted file mode 100644 index 36a1196..0000000 --- a/classic/sql.lisp +++ /dev/null @@ -1,126 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: sql.lisp -;;;; Purpose: High-level SQL interface -;;;; Authors: Kevin M. Rosenberg based on code by Pierre R. Mai -;;;; Date Started: Feb 2002 -;;;; -;;;; $Id$ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg -;;;; and Copyright (c) 1999-2001 by Pierre R. Mai -;;;; -;;;; 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-classic) - - -;;; Row processing macro - -(defmacro for-each-row (((&rest fields) &key from order-by where distinct limit) &body body) - (let ((d (gensym "DISTINCT-")) - (bind-fields (loop for f in fields collect (car f))) - (w (gensym "WHERE-")) - (o (gensym "ORDER-BY-")) - (frm (gensym "FROM-")) - (l (gensym "LIMIT-")) - (q (gensym "QUERY-"))) - `(let ((,frm ,from) - (,w ,where) - (,d ,distinct) - (,l ,limit) - (,o ,order-by)) - (let ((,q (query-string ',fields ,frm ,w ,d ,o ,l))) - (loop for tuple in (query ,q) - collect (destructuring-bind ,bind-fields tuple - ,@body)))))) - -(defun query-string (fields from where distinct order-by limit) - (concatenate - 'string - (format nil "select ~A~{~A~^,~} from ~{~A~^ and ~}" - (if distinct "distinct " "") (field-names fields) - (from-names from)) - (if where (format nil " where ~{~A~^ ~}" - (where-strings where)) "") - (if order-by (format nil " order by ~{~A~^, ~}" - (order-by-strings order-by))) - (if limit (format nil " limit ~D" limit) ""))) - -(defun lisp->sql-name (field) - (typecase field - (string field) - (symbol (string-upcase (symbol-name field))) - (cons (cadr field)) - (t (format nil "~A" field)))) - -(defun field-names (field-forms) - "Return a list of field name strings from a fields form" - (loop for field-form in field-forms - collect - (lisp->sql-name - (if (cadr field-form) - (cadr field-form) - (car field-form))))) - -(defun from-names (from) - "Return a list of field name strings from a fields form" - (loop for table in (if (atom from) (list from) from) - collect (lisp->sql-name table))) - - -(defun where-strings (where) - (loop for w in (if (atom (car where)) (list where) where) - collect - (if (consp w) - (format nil "~A ~A ~A" (second w) (first w) (third w)) - (format nil "~A" w)))) - -(defun order-by-strings (order-by) - (loop for o in order-by - collect - (if (atom o) - (lisp->sql-name o) - (format nil "~A ~A" (lisp->sql-name (car o)) - (lisp->sql-name (cadr o)))))) - - - -;;; These functions are not exported. If you application depends on these -;;; functions consider using the clsql package using has further support. - -(defun list-tables (&key (database *default-database*)) - "List all tables in *default-database*, or if the :database keyword arg -is given, the specified database. If the keyword arg :system-tables -is true, then it will not filter out non-user tables. Table names are -given back as a list of strings." - (database-list-tables database)) - - -(defun list-attributes (table &key (database *default-database*)) - "List the attributes of TABLE in *default-database, or if the -:database keyword is given, the specified database. Attributes are -returned as a list of strings." - (database-list-attributes table database)) - -(defun attribute-type (attribute table &key (database *default-database*)) - "Return the field type of the ATTRIBUTE in TABLE. The optional -keyword argument :database specifies the database to query, defaulting -to *default-database*." - (database-attribute-type attribute table database)) - -(defun create-sequence (name &key (database *default-database*)) - (database-create-sequence name database)) - -(defun drop-sequence (name &key (database *default-database*)) - (database-drop-sequence name database)) - -(defun sequence-next (name &key (database *default-database*)) - (database-sequence-next name database)) - - diff --git a/clsql-aodbc.asd b/clsql-aodbc.asd index 76c8bdd..84572be 100644 --- a/clsql-aodbc.asd +++ b/clsql-aodbc.asd @@ -28,7 +28,7 @@ :description "Common Lisp SQL AODBC Driver" :long-description "cl-sql-aodbc package provides a database driver to AllegroCL's AODBC database interface." - :depends-on (clsql-base) + :depends-on (clsql) :components ((:module :db-aodbc :components diff --git a/clsql-base.asd b/clsql-base.asd deleted file mode 100644 index 7484c4c..0000000 --- a/clsql-base.asd +++ /dev/null @@ -1,52 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: clsql-base.asd -;;;; Purpose: ASDF definition file for Base CLSQL -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Feb 2002 -;;;; -;;;; $Id$ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002 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 -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. -;;;; ************************************************************************* - -(eval-when (:compile-toplevel) - (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))) - -(defpackage #:clsql-base-system (:use #:asdf #:cl)) -(in-package #:clsql-base-system) - -#+(or allegro lispworks cmu sbcl openmcl mcl scl) -(defsystem clsql-base - :name "cl-sql-base" - :author "Kevin Rosenberg " - :maintainer "Kevin M. Rosenberg " - :licence "Lessor Lisp General Public License" - :description "Common Lisp SQL Base Package" - :long-description "cl-sql-base package provides the low-level interface for the database drivers." - - :components - ((:module :base - :components - ((:file "cmucl-compat") - (:file "package") - (:file "utils" :depends-on ("package" "db-interface")) - (:file "classes" :depends-on ("package")) - (:file "conditions" :depends-on ("classes")) - (:file "db-interface" :depends-on ("conditions")) - (:file "initialize" :depends-on ("db-interface" "utils")) - (:file "loop-extension" :depends-on ("db-interface")) - (:file "time" :depends-on ("package")) - (:file "database" :depends-on ("initialize")) - (:file "recording" :depends-on ("time" "database")) - (:file "basic-sql" :depends-on ("database" "cmucl-compat")) - (:file "pool" :depends-on ("basic-sql")) - (:file "transaction" :depends-on ("basic-sql")) - )))) - diff --git a/clsql-classic.asd b/clsql-classic.asd deleted file mode 100644 index 73734df..0000000 --- a/clsql-classic.asd +++ /dev/null @@ -1,42 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: clsql-classic.asd -;;;; Purpose: System definition for CLSQL-CLASSIC -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Feb 2002 -;;;; -;;;; $Id$ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002 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 -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. -;;;; ************************************************************************* - -(defpackage #:clsql-classic-system (:use #:asdf #:cl)) -(in-package #:clsql-classic-system) - -#+(or allegro lispworks cmu sbcl openmcl mcl scl) -(defsystem clsql-classic - :name "clsql-classic" - :author "Kevin Rosenberg " - :maintainer "Kevin M. Rosenberg " - :version "2.1.x" - :licence "Lessor Lisp General Public License" - :description "Common Lisp SQL Interface Library" - :long-description "cl-sql package provides the high-level interface for the CLSQL system." - - :depends-on (clsql-base) - :components - ((:module :classic - :components - ((:file "package") - (:file "sql" :depends-on ("package")) - (:file "functional" :depends-on ("sql")))))) - -#+(or allegro lispworks cmu sbcl openmcl mcl scl) -(defmethod perform ((o test-op) (c (eql (find-system 'clsql-classic)))) - (warn "Testing is provided by the CLSQL-TESTS system")) diff --git a/clsql-mysql.asd b/clsql-mysql.asd index a229791..b20b4a0 100644 --- a/clsql-mysql.asd +++ b/clsql-mysql.asd @@ -81,7 +81,7 @@ :description "Common Lisp SQL MySQL Driver" :long-description "cl-sql-mysql package provides a database driver to the MySQL database system." - :depends-on (uffi clsql-base clsql-uffi) + :depends-on (uffi clsql clsql-uffi) :components ((:module :db-mysql :components diff --git a/clsql-odbc.asd b/clsql-odbc.asd index 3d3b1bb..82b3fbd 100644 --- a/clsql-odbc.asd +++ b/clsql-odbc.asd @@ -28,7 +28,7 @@ :description "Common Lisp SQL ODBC Driver" :long-description "cl-sql-odbc package provides a database driver to the ODBC database system." - :depends-on (uffi clsql-base clsql-uffi) + :depends-on (uffi clsql clsql-uffi) :components ((:module :db-odbc :components diff --git a/clsql-oracle.asd b/clsql-oracle.asd index b03beb4..82099fe 100644 --- a/clsql-oracle.asd +++ b/clsql-oracle.asd @@ -17,7 +17,7 @@ :description "Common Lisp SQL Oracle Driver" :long-description "cl-sql-oracle package provides a database driver to the Oracle database system." - :depends-on (clsql-base) + :depends-on (clsql) :components ((:module :db-oracle :components diff --git a/clsql-postgresql-socket.asd b/clsql-postgresql-socket.asd index f06e1ab..3862a3a 100644 --- a/clsql-postgresql-socket.asd +++ b/clsql-postgresql-socket.asd @@ -30,7 +30,7 @@ :description "Common Lisp SQL PostgreSQL Socket Driver" :long-description "cl-sql-postgresql-socket package provides a database driver to the PostgreSQL database via a socket interface." - :depends-on (clsql-base uffi md5 #+sbcl sb-bsd-sockets) + :depends-on (clsql uffi md5 #+sbcl sb-bsd-sockets) :components ((:module :db-postgresql-socket :components diff --git a/clsql-postgresql.asd b/clsql-postgresql.asd index 459a04b..81c1712 100644 --- a/clsql-postgresql.asd +++ b/clsql-postgresql.asd @@ -30,7 +30,7 @@ :description "Common Lisp PostgreSQL API Driver" :long-description "cl-sql-postgresql package provides a the database driver for the PostgreSQL API." - :depends-on (uffi clsql-base clsql-uffi) + :depends-on (uffi clsql clsql-uffi) :components ((:module :db-postgresql :components diff --git a/clsql-sqlite.asd b/clsql-sqlite.asd index 6a82c6c..bae257e 100644 --- a/clsql-sqlite.asd +++ b/clsql-sqlite.asd @@ -28,7 +28,7 @@ :long-description "cl-sql-sqlite package provides a database driver to SQLite database library." - :depends-on (clsql-base #-clisp clsql-uffi) + :depends-on (clsql #-clisp clsql-uffi) :components ((:module :db-sqlite :components diff --git a/clsql-uffi.asd b/clsql-uffi.asd index 18fcf00..215e6bc 100644 --- a/clsql-uffi.asd +++ b/clsql-uffi.asd @@ -85,7 +85,7 @@ :description "Common UFFI Helper functions for Common Lisp SQL Interface Library" :long-description "cl-sql-uffi package provides common helper functions using the UFFI for the CLSQL package." - :depends-on (uffi clsql-base) + :depends-on (uffi clsql) :components ((:module :uffi diff --git a/clsql.asd b/clsql.asd index ebfefa2..e891452 100644 --- a/clsql.asd +++ b/clsql.asd @@ -20,30 +20,42 @@ (defsystem #:clsql :name "CLSQL" - :author "" - :maintainer "" - :version "" - :licence "" - :description "A high level Common Lisp interface to SQL RDBMS." - :long-description "A high level Common Lisp interface to SQL RDBMS -based on the Xanalys CommonSQL interface for Lispworks. It depends on -the low-level database interfaces provided by CLSQL and includes both -a functional and an object oriented interface." - :depends-on (clsql-base) + :author "Kevin Rosenberg " + :maintainer "Kevin M. Rosenberg " + :licence "Lessor Lisp General Public License" + :description "Common Lisp SQL Interface library" + :long-description "A Common Lisp interface to SQL RDBMS based on +the Xanalys CommonSQL interface for Lispworks. It depends on the +low-level database interfaces as well as a functional and an object +oriented interface." :components ((:module sql :components - ((:module :package + ((:module :base :pathname "" - :components ((:file "package") - (:file "kmr-mop" :depends-on ("package")))) + :components + ((:file "cmucl-compat") + (:file "package") + (:file "utils" :depends-on ("package" "db-interface")) + (:file "base-classes" :depends-on ("package")) + (:file "conditions" :depends-on ("base-classes")) + (:file "db-interface" :depends-on ("conditions")) + (:file "initialize" :depends-on ("db-interface" "utils")) + (:file "loop-extension" :depends-on ("db-interface")) + (:file "time" :depends-on ("package")) + (:file "database" :depends-on ("initialize")) + (:file "recording" :depends-on ("time" "database")) + (:file "basic-sql" :depends-on ("database" "cmucl-compat")) + (:file "pool" :depends-on ("basic-sql")) + (:file "transaction" :depends-on ("basic-sql")) + (:file "kmr-mop" :depends-on ("package")))) (:module :core :pathname "" :components ((:file "generics") (:file "classes" :depends-on ("generics")) (:file "operations" :depends-on ("classes")) (:file "syntax" :depends-on ("operations"))) - :depends-on (:package)) + :depends-on (:base)) (:module :functional :pathname "" :components ((:file "sql") diff --git a/db-aodbc/aodbc-package.lisp b/db-aodbc/aodbc-package.lisp index 18c336a..171f547 100644 --- a/db-aodbc/aodbc-package.lisp +++ b/db-aodbc/aodbc-package.lisp @@ -25,6 +25,6 @@ (defpackage #:clsql-aodbc (:nicknames #:aodbc) - (:use #:cl #:clsql-base) + (:use #:common-lisp #:clsql-sys) (:export #:aodbc-database) (:documentation "This is the CLSQL interface to Allegro's AODBC")) diff --git a/db-mysql/mysql-loader.lisp b/db-mysql/mysql-loader.lisp index 6424e7a..d93b783 100644 --- a/db-mysql/mysql-loader.lisp +++ b/db-mysql/mysql-loader.lisp @@ -59,10 +59,10 @@ set to the right path before compiling or loading the system.") (defvar *mysql-library-loaded* nil "T if foreign library was able to be loaded successfully") -(defmethod clsql-base:database-type-library-loaded ((database-type (eql :mysql))) +(defmethod clsql-sys:database-type-library-loaded ((database-type (eql :mysql))) *mysql-library-loaded*) -(defmethod clsql-base:database-type-load-foreign ((database-type (eql :mysql))) +(defmethod clsql-sys:database-type-load-foreign ((database-type (eql :mysql))) (let ((mysql-path (uffi:find-foreign-library *mysql-library-candidate-names* *mysql-library-candidate-directories* @@ -82,5 +82,5 @@ set to the right path before compiling or loading the system.") (setq *mysql-library-loaded* t)) -(clsql-base:database-type-load-foreign :mysql) +(clsql-sys:database-type-load-foreign :mysql) diff --git a/db-mysql/mysql-package.lisp b/db-mysql/mysql-package.lisp index b841443..4ecbabf 100644 --- a/db-mysql/mysql-package.lisp +++ b/db-mysql/mysql-package.lisp @@ -19,7 +19,7 @@ (in-package #:cl-user) (defpackage #:mysql - (:use #:cl #:clsql-uffi) + (:use #:common-lisp #:clsql-uffi) (:export #:database-library-loaded diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index dd62303..cf85c59 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -14,7 +14,7 @@ ;;;; ************************************************************************* (defpackage #:clsql-mysql - (:use #:common-lisp #:clsql-base #:mysql #:clsql-uffi) + (:use #:common-lisp #:clsql-sys #:mysql #:clsql-uffi) (:export #:mysql-database) (:documentation "This is the CLSQL interface to MySQL.")) @@ -392,7 +392,7 @@ (defmethod database-create (connection-spec (type (eql :mysql))) (destructuring-bind (host name user password) connection-spec (multiple-value-bind (output status) - (clsql-base:command-output "mysqladmin create -u~A -p~A -h~A ~A" + (clsql-sys:command-output "mysqladmin create -u~A -p~A -h~A ~A" user password (if host host "localhost") name) @@ -408,7 +408,7 @@ (defmethod database-destroy (connection-spec (type (eql :mysql))) (destructuring-bind (host name user password) connection-spec (multiple-value-bind (output status) - (clsql-base:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A" + (clsql-sys:command-output "mysqladmin drop -f -u~A -p~A -h~A ~A" user password (if host host "localhost") name) @@ -432,11 +432,11 @@ (let ((database (database-connect (list host "mysql" user password) type))) (unwind-protect (progn - (setf (slot-value database 'clsql-base::state) :open) + (setf (slot-value database 'clsql-sys::state) :open) (mapcar #'car (database-query "show databases" database :auto nil))) (progn (database-disconnect database) - (setf (slot-value database 'clsql-base::state) :closed)))))) + (setf (slot-value database 'clsql-sys::state) :closed)))))) ;;; Database capabilities @@ -458,6 +458,6 @@ (let ((tuple (car (database-query "SHOW VARIABLES LIKE 'HAVE_INNODB'" database :auto nil)))) (and tuple (string-equal "YES" (second tuple))))) -(when (clsql-base:database-type-library-loaded :mysql) - (clsql-base:initialize-database-type :database-type :mysql)) +(when (clsql-sys:database-type-library-loaded :mysql) + (clsql-sys:initialize-database-type :database-type :mysql)) diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index 66c9936..c5cca32 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -27,8 +27,8 @@ May be locally bound to something else if a certain type is necessary.") (defvar *time-conversion-function* (lambda (universal-time &optional fraction) (declare (ignore fraction)) - (clsql-base:format-time - nil (clsql-base:utime->time universal-time) + (clsql-sys:format-time + nil (clsql-sys:utime->time universal-time) :format :iso) #+ignore universal-time) @@ -113,11 +113,11 @@ as possible second argument) to the desired representation of date/time/timestam (progn ,result-code ,@body)) (#.$SQL_INVALID_HANDLE (error - 'clsql-base:clsql-odbc-error + 'clsql-sys:clsql-odbc-error :odbc-message "Invalid handle")) (#.$SQL_STILL_EXECUTING (error - 'clsql-base:clsql-odbc-error + 'clsql-sys:clsql-odbc-error :odbc-message "Still executing")) (#.$SQL_ERROR (multiple-value-bind (error-message sql-state) @@ -125,7 +125,7 @@ as possible second argument) to the desired representation of date/time/timestam (or ,hdbc +null-handle-ptr+) (or ,hstmt +null-handle-ptr+)) (error - 'clsql-base:clsql-odbc-error + 'clsql-sys:clsql-odbc-error :odbc-message error-message :sql-state sql-state))) (#.$SQL_NO_DATA_FOUND @@ -138,7 +138,7 @@ as possible second argument) to the desired representation of date/time/timestam (or ,hdbc +null-handle-ptr+) (or ,hstmt +null-handle-ptr+)) (error - 'clsql-base:clsql-odbc-error + 'clsql-sys:clsql-odbc-error :odbc-message error-message :sql-state sql-state)) #+ignore diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp index 7b20556..29a44f0 100644 --- a/db-odbc/odbc-dbi.lisp +++ b/db-odbc/odbc-dbi.lisp @@ -357,7 +357,7 @@ the query against." )) "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:without-interrupts + (or (clsql-sys:without-interrupts (let ((inactive-query (find-if (lambda (query) (not (query-active-p query))) queries))) diff --git a/db-odbc/odbc-loader.lisp b/db-odbc/odbc-loader.lisp index 94206d8..52dc8f7 100644 --- a/db-odbc/odbc-loader.lisp +++ b/db-odbc/odbc-loader.lisp @@ -39,15 +39,15 @@ set to the right path before compiling or loading the system.") (defvar *odbc-library-loaded* nil "T if foreign library was able to be loaded successfully") -(defmethod clsql-base:database-type-library-loaded ((database-type (eql :odbc))) +(defmethod clsql-sys:database-type-library-loaded ((database-type (eql :odbc))) *odbc-library-loaded*) -(defmethod clsql-base:database-type-load-foreign ((database-type (eql :odbc))) +(defmethod clsql-sys:database-type-load-foreign ((database-type (eql :odbc))) (uffi:load-foreign-library *odbc-library-path* :module "odbc") (setq *odbc-library-loaded* t)) -(clsql-base:database-type-load-foreign :odbc) +(clsql-sys:database-type-load-foreign :odbc) diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp index 70e1478..656e8f4 100644 --- a/db-odbc/odbc-sql.lisp +++ b/db-odbc/odbc-sql.lisp @@ -17,7 +17,7 @@ ;;;; ************************************************************************* (defpackage #:clsql-odbc - (:use #:common-lisp #:clsql-base) + (:use #:common-lisp #:clsql-sys) (:export #:odbc-database) (:documentation "This is the CLSQL interface to ODBC.")) @@ -359,5 +359,5 @@ ;; nothing to do t) -(when (clsql-base:database-type-library-loaded :odbc) - (clsql-base:initialize-database-type :database-type :odbc)) +(when (clsql-sys:database-type-library-loaded :odbc) + (clsql-sys:initialize-database-type :database-type :odbc)) diff --git a/db-oracle/oracle-package.lisp b/db-oracle/oracle-package.lisp index 22314a2..41f174b 100644 --- a/db-oracle/oracle-package.lisp +++ b/db-oracle/oracle-package.lisp @@ -17,7 +17,7 @@ (in-package #:cl-user) (defpackage #:clsql-oracle - (:use #:common-lisp #:clsql-base) + (:use #:common-lisp #:clsql-sys) (:export #:oracle-database #:*oracle-so-load-path* #:*oracle-so-libraries*) diff --git a/db-postgresql-socket/postgresql-socket-api.lisp b/db-postgresql-socket/postgresql-socket-api.lisp index 620140e..dabaad9 100644 --- a/db-postgresql-socket/postgresql-socket-api.lisp +++ b/db-postgresql-socket/postgresql-socket-api.lisp @@ -27,13 +27,13 @@ (:float4 700) (:float8 701))) -(defmethod clsql-base:database-type-library-loaded ((database-type +(defmethod clsql-sys: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:database-type-load-foreign ((database-type (eql :postgresql-socket))) +(defmethod clsql-sys:database-type-load-foreign ((database-type (eql :postgresql-socket))) t) @@ -601,7 +601,7 @@ connection, if it is still open." :connection connection :message message)))) (#.+notice-response-message+ (let ((message (read-socket-value-string socket))) - (unless (eq :ignore clsql-base:*backend-warning-behavior*) + (unless (eq :ignore clsql-sys:*backend-warning-behavior*) (warn 'postgresql-warning :connection connection :message message)))) (#.+notification-response-message+ diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp index 24597c0..ebda22c 100644 --- a/db-postgresql-socket/postgresql-socket-sql.lisp +++ b/db-postgresql-socket/postgresql-socket-sql.lisp @@ -20,7 +20,7 @@ (in-package #:cl-user) (defpackage :clsql-postgresql-socket - (:use #:common-lisp #:clsql-base #:postgresql-socket) + (:use #:common-lisp #:clsql-sys #:postgresql-socket) (:export #:postgresql-socket-database) (:documentation "This is the CLSQL socket interface to PostgreSQL.")) @@ -29,7 +29,7 @@ ;; interface foreign library loading routines -(clsql-base:database-type-load-foreign :postgresql-socket) +(clsql-sys:database-type-load-foreign :postgresql-socket) ;; Field type conversion @@ -494,12 +494,12 @@ doesn't depend on UFFI." type))) (unwind-protect (progn - (setf (slot-value database 'clsql-base::state) :open) + (setf (slot-value database 'clsql-sys::state) :open) (mapcar #'car (database-query "select datname from pg_database" database :auto nil))) (progn (database-disconnect database) - (setf (slot-value database 'clsql-base::state) :closed)))))) + (setf (slot-value database 'clsql-sys::state) :closed)))))) (defmethod database-describe-table ((database postgresql-socket-database) table) @@ -525,5 +525,5 @@ doesn't depend on UFFI." (defmethod db-type-default-case ((db-type (eql :postgresql-socket))) :lower) -(when (clsql-base:database-type-library-loaded :postgresql-socket) - (clsql-base:initialize-database-type :database-type :postgresql-socket)) +(when (clsql-sys:database-type-library-loaded :postgresql-socket) + (clsql-sys:initialize-database-type :database-type :postgresql-socket)) diff --git a/db-postgresql/postgresql-loader.lisp b/db-postgresql/postgresql-loader.lisp index 169588f..e33f135 100644 --- a/db-postgresql/postgresql-loader.lisp +++ b/db-postgresql/postgresql-loader.lisp @@ -27,11 +27,11 @@ set to the right path before compiling or loading the system.") (defvar *postgresql-library-loaded* nil "T if foreign library was able to be loaded successfully") -(defmethod clsql-base:database-type-library-loaded ((database-type +(defmethod clsql-sys:database-type-library-loaded ((database-type (eql :postgresql))) *postgresql-library-loaded*) -(defmethod clsql-base:database-type-load-foreign ((database-type +(defmethod clsql-sys:database-type-load-foreign ((database-type (eql :postgresql))) (let ((libpath (uffi:find-foreign-library "libpq" @@ -51,5 +51,5 @@ set to the right path before compiling or loading the system.") (setq *postgresql-library-loaded* t) (warn "Can't load PostgreSQL client library ~A" libpath)))) -(clsql-base:database-type-load-foreign :postgresql) +(clsql-sys:database-type-load-foreign :postgresql) diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp index a556831..2bb7fb1 100644 --- a/db-postgresql/postgresql-sql.lisp +++ b/db-postgresql/postgresql-sql.lisp @@ -16,7 +16,7 @@ (in-package #:cl-user) (defpackage #:clsql-postgresql - (:use #:common-lisp #:clsql-base #:postgresql #:clsql-uffi) + (:use #:common-lisp #:clsql-sys #:postgresql #:clsql-uffi) (:export #:postgresql-database) (:documentation "This is the CLSQL interface to PostgreSQL.")) @@ -520,7 +520,7 @@ (destructuring-bind (host name user password) connection-spec (declare (ignore user password)) (multiple-value-bind (output status) - (clsql-base:command-output "createdb -h~A ~A" + (clsql-sys:command-output "createdb -h~A ~A" (if host host "localhost") name) (if (or (not (zerop status)) @@ -537,7 +537,7 @@ (destructuring-bind (host name user password) connection-spec (declare (ignore user password)) (multiple-value-bind (output status) - (clsql-base:command-output "dropdb -h~A ~A" + (clsql-sys:command-output "dropdb -h~A ~A" (if host host "localhost") name) (if (or (not (zerop status)) @@ -563,12 +563,12 @@ type))) (unwind-protect (progn - (setf (slot-value database 'clsql-base::state) :open) + (setf (slot-value database 'clsql-sys::state) :open) (mapcar #'car (database-query "select datname from pg_database" database nil nil))) (progn (database-disconnect database) - (setf (slot-value database 'clsql-base::state) :closed)))))) + (setf (slot-value database 'clsql-sys::state) :closed)))))) (defmethod database-describe-table ((database postgresql-database) table) (database-query @@ -618,5 +618,5 @@ (defmethod db-type-default-case ((db-type (eql :postgresql))) :lower) -(when (clsql-base:database-type-library-loaded :postgresql) - (clsql-base:initialize-database-type :database-type :postgresql)) +(when (clsql-sys:database-type-library-loaded :postgresql) + (clsql-sys:initialize-database-type :database-type :postgresql)) diff --git a/db-sqlite/sqlite-loader.lisp b/db-sqlite/sqlite-loader.lisp index 71e3385..d625473 100644 --- a/db-sqlite/sqlite-loader.lisp +++ b/db-sqlite/sqlite-loader.lisp @@ -47,7 +47,7 @@ set to the right path before compiling or loading the system.") (setq *sqlite-library-loaded* t) (warn "Can't load SQLite library ~A" libpath)))) -(clsql-base:database-type-load-foreign :sqlite) +(clsql-sys:database-type-load-foreign :sqlite) diff --git a/db-sqlite/sqlite-package.lisp b/db-sqlite/sqlite-package.lisp index 2f8e13e..c50107a 100644 --- a/db-sqlite/sqlite-package.lisp +++ b/db-sqlite/sqlite-package.lisp @@ -19,5 +19,5 @@ (in-package #:cl-user) (defpackage #:clsql-sqlite - (:use #:common-lisp #:clsql-base) + (:use #:common-lisp #:clsql-sys) (:export #:sqlite-database)) diff --git a/debian/control b/debian/control index f90a53b..1abcd05 100644 --- a/debian/control +++ b/debian/control @@ -8,25 +8,16 @@ Standards-Version: 3.6.1.0 Package: cl-sql Architecture: all -Depends: cl-sql-base +Depends: common-lisp-controller (>= 3.37) +Recommends: cl-sql-backend Description: SQL Interface for Common Lisp CLSQL is a Common Lisp interface for multiple SQL databases on multiple Common Lisp implementations. It uses the UFFI foreign language interface. -Package: cl-sql-base -Architecture: all -Depends: common-lisp-controller (>= 3.37) -Recommends: cl-sql-backend -Description: SQL Interface for Common Lisp - CLSQL uses the UFFI library to provide SQL to multiple SQL databases - on multiple Common Lisp implementations. - . - This package provides the base framework for database backends. - Package: cl-sql-uffi Architecture: any -Depends: common-lisp-controller (>= 3.37), cl-uffi, cl-sql-base +Depends: cl-uffi, cl-sql (>= ${Source-Version}) Recommends: cl-sql-backend Description: Common UFFI functions for CLSQL database backends This package provides an interface to several UFFI functions used by multiple @@ -35,7 +26,7 @@ Description: Common UFFI functions for CLSQL database backends Package: cl-sql-mysql Architecture: any -Depends: cl-sql-base (>= ${Source-Version}), libmysqlclient-dev, cl-sql-uffi (>= ${Source-Version}) +Depends: cl-sql (>= ${Source-Version}), libmysqlclient-dev, cl-sql-uffi (>= ${Source-Version}) Provides: cl-sql-backend Description: CLSQL database backend, MySQL This package enables you to use the CLSQL data access package @@ -44,7 +35,7 @@ Description: CLSQL database backend, MySQL Package: cl-sql-aodbc Architecture: all -Depends: cl-sql-base (>= ${Source-Version}), cl-sql-mysql, cl-sql-postgresql +Depends: cl-sql (>= ${Source-Version}), cl-sql-mysql, cl-sql-postgresql Provides: cl-sql-backend Suggests: acl-pro-installer Description: CLSQL database backend, AODBC @@ -54,7 +45,7 @@ Description: CLSQL database backend, AODBC Package: cl-sql-odbc Architecture: all -Depends: cl-sql-base (>= ${Source-Version}), unixodbc-dev, cl-sql-mysql, cl-sql-postgresql +Depends: cl-sql (>= ${Source-Version}), unixodbc-dev, cl-sql-mysql, cl-sql-postgresql Provides: cl-sql-backend Suggests: acl-pro-installer Description: CLSQL database backend, ODBC @@ -64,7 +55,7 @@ Description: CLSQL database backend, ODBC Package: cl-sql-postgresql Architecture: all -Depends: cl-sql-base (>= ${Source-Version}), postgresql-dev, cl-sql-uffi (>= ${Source-Version}) +Depends: cl-sql (>= ${Source-Version}), postgresql-dev, cl-sql-uffi (>= ${Source-Version}) Provides: cl-sql-backend Description: CLSQL database backend, PostgreSQL This package enables you to use the CLSQL data access package @@ -73,7 +64,7 @@ Description: CLSQL database backend, PostgreSQL Package: cl-sql-postgresql-socket Architecture: all -Depends: cl-sql-base (>= ${Source-Version}), cl-md5, cl-sql-uffi (>= ${Source-Version}), libc6-dev +Depends: cl-sql (>= ${Source-Version}), cl-md5, cl-sql-uffi (>= ${Source-Version}), libc6-dev Provides: cl-sql-backend Description: CLSQL database backend, PostgreSQL This package enables you to use the CLSQL data access package @@ -82,23 +73,16 @@ Description: CLSQL database backend, PostgreSQL Package: cl-sql-sqlite Architecture: all -Depends: cl-sql-base (>= ${Source-Version}), libsqlite0-dev, cl-sql-uffi (>= ${Source-Version}) +Depends: cl-sql (>= ${Source-Version}), libsqlite0-dev, cl-sql-uffi (>= ${Source-Version}) Provides: cl-sql-backend Description: CLSQL database backend, SQLite This package enables you to use the CLSQL data access package with SQLite databases. CLSQL is a Common Lisp interface to SQL databases. -Package: cl-sql-classic -Architecture: all -Depends: cl-sql-base (>= ${Source-Version}) -Description: Classic CLSQL high-level interface - This package provides the Classic, original high-level interface for CLSQL. - CLSQL is a Common Lisp interface to SQL databases. - Package: cl-sql-tests Architecture: all -Depends: cl-sql-base, cl-sql-postgresql, cl-sql-postgresql-socket, cl-sql-mysql, cl-rt +Depends: cl-sql, cl-sql-postgresql, cl-sql-postgresql-socket, cl-sql-mysql, cl-sqlite, cl-sql-odbc, rt Suggests: acl-installer, libmyodbc, unixodbc,cl-sql-aodbc Description: Testing suite for CLSQL This package contains a test suite for CLSQL. It requires manual diff --git a/debian/rules b/debian/rules index 6c03eae..29881dd 100755 --- a/debian/rules +++ b/debian/rules @@ -3,9 +3,7 @@ plain-pkg := clsql pkg := cl-sql -pkg-base := cl-sql-base pkg-uffi := cl-sql-uffi -pkg-classic := cl-sql-classic pkg-mysql := cl-sql-mysql pkg-pg := cl-sql-postgresql pkg-pg-socket := cl-sql-postgresql-socket @@ -13,15 +11,13 @@ pkg-aodbc := cl-sql-aodbc pkg-odbc := cl-sql-odbc pkg-sqlite := cl-sql-sqlite pkg-tests := cl-sql-tests -all-pkgs := $(pkg) $(pkg-base) $(pkg-uffi) $(pkg-mysql) $(pkg-pg) $(pkg-pg-socket) $(pkg-aodbc) $(pkg-odbc) $(pkg-sqlite) $(pkg-tests) +all-pkgs := $(pkg) $(pkg-uffi) $(pkg-mysql) $(pkg-pg) $(pkg-pg-socket) $(pkg-aodbc) $(pkg-odbc) $(pkg-sqlite) $(pkg-tests) UPSTREAM_VER := $(shell sed -n -e "s/${pkg} (\(.*\)-[0-9A-Za-z\.]).*/\1/p" < debian/changelog |head -1) ## Lisp sources srcs := $(wildcard sql/*.lisp) clsql.asd -srcs-base := $(wildcard base/*.lisp) -srcs-classic := $(wildcard classic/*.lisp) srcs-uffi := $(wildcard uffi/*.lisp) $(wildcard uffi/*.c) srcs-uffi-so := $(wildcard uffi/*.so) srcs-mysql := $(wildcard db-mysql/*.lisp) $(wildcard db-mysql/*.c) @@ -42,10 +38,6 @@ clc-clsql := $(clc-source)/$(plain-pkg) clc-sql := $(clc-source)/clsql lispdir-sql := $(clc-sql)/sql -clc-base := $(clc-source)/clsql-base -lispdir-base := $(clc-base)/base -clc-classic := $(clc-source)/clsql-classic -lispdir-classic := $(clc-classic)/classic clc-uffi := $(clc-source)/clsql-uffi lispdir-uffi := $(clc-uffi)/uffi sodir-uffi := usr/lib/clsql @@ -109,7 +101,6 @@ install: build # Add here commands to install the package into debian/uffi. dh_installdirs --all $(clc-systems) $(clc-source) dh_installdirs -p $(pkg) $(lispdir-sql) - dh_installdirs -p $(pkg-base) $(lispdir-base) dh_installdirs -p $(pkg-uffi) $(lispdir-uffi) $(sodir-uffi) dh_installdirs -p $(pkg-pg) $(lispdir-pg) dh_installdirs -p $(pkg-pg-socket) $(lispdir-pg-socket) @@ -123,14 +114,6 @@ install: build dh_install -p $(pkg) $(srcs) $(lispdir-sql) dh_install -p $(pkg) clsql.asd $(clc-clsql) - # Base - dh_install -p $(pkg-base) $(srcs-base) $(lispdir-base) - dh_install -p $(pkg-base) clsql-base.asd $(clc-base) - - # Classic - dh_install -p $(pkg-classic) $(srcs-classic) $(lispdir-classic) - dh_install -p $(pkg-classic) clsql-classic.asd $(clc-classic) - # UFFI dh_install -p $(pkg-uffi) $(srcs-uffi) $(lispdir-uffi) dh_install -p $(pkg-uffi) $(srcs-uffi-so) $(sodir-uffi) @@ -156,8 +139,6 @@ install: build # CLC Systems dh_link -p $(pkg) $(clc-clsql)/clsql.asd $(clc-systems)/clsql.asd - dh_link -p $(pkg-base) $(clc-base)/clsql-base.asd $(clc-systems)/clsql-base.asd - dh_link -p $(pkg-classic) $(clc-classic)/clsql-classic.asd $(clc-systems)/clsql-classic.asd dh_link -p $(pkg-uffi) $(clc-uffi)/clsql-uffi.asd $(clc-systems)/clsql-uffi.asd dh_link -p $(pkg-mysql) $(clc-mysql)/clsql-mysql.asd $(clc-systems)/clsql-mysql.asd dh_link -p $(pkg-pg) $(clc-pg)/clsql-postgresql.asd $(clc-systems)/clsql-postgresql.asd diff --git a/base/classes.lisp b/sql/base-classes.lisp similarity index 98% rename from base/classes.lisp rename to sql/base-classes.lisp index acae96b..98980d4 100644 --- a/base/classes.lisp +++ b/sql/base-classes.lisp @@ -18,7 +18,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) (defclass database () diff --git a/base/basic-sql.lisp b/sql/basic-sql.lisp similarity index 99% rename from base/basic-sql.lisp rename to sql/basic-sql.lisp index a7d32cf..2c61f25 100644 --- a/base/basic-sql.lisp +++ b/sql/basic-sql.lisp @@ -12,7 +12,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) ;;; Query diff --git a/sql/classes.lisp b/sql/classes.lisp index 24bd71a..f33a236 100644 --- a/sql/classes.lisp +++ b/sql/classes.lisp @@ -13,7 +13,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql) +(in-package #:clsql-sys) (defvar +empty-string+ "''") diff --git a/base/cmucl-compat.lisp b/sql/cmucl-compat.lisp similarity index 100% rename from base/cmucl-compat.lisp rename to sql/cmucl-compat.lisp diff --git a/base/conditions.lisp b/sql/conditions.lisp similarity index 99% rename from base/conditions.lisp rename to sql/conditions.lisp index 6b7d971..571054d 100644 --- a/base/conditions.lisp +++ b/sql/conditions.lisp @@ -18,7 +18,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) (defvar *backend-warning-behavior* :warn "Action to perform on warning messages from backend. Default is to :warn. May also be diff --git a/base/database.lisp b/sql/database.lisp similarity index 99% rename from base/database.lisp rename to sql/database.lisp index f5a682e..b02a75a 100644 --- a/base/database.lisp +++ b/sql/database.lisp @@ -12,7 +12,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) (setf (documentation 'database-name 'function) "Returns the name of a database.") diff --git a/base/db-interface.lisp b/sql/db-interface.lisp similarity index 99% rename from base/db-interface.lisp rename to sql/db-interface.lisp index 3ddfd89..84702b9 100644 --- a/base/db-interface.lisp +++ b/sql/db-interface.lisp @@ -19,7 +19,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) (defgeneric database-type-load-foreign (database-type) (:documentation diff --git a/sql/generics.lisp b/sql/generics.lisp index cbf2d7e..a7c8be1 100644 --- a/sql/generics.lisp +++ b/sql/generics.lisp @@ -16,7 +16,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql) +(in-package #:clsql-sys) (defgeneric update-record-from-slot (object slot &key database) (:documentation diff --git a/base/initialize.lisp b/sql/initialize.lisp similarity index 98% rename from base/initialize.lisp rename to sql/initialize.lisp index 3211512..9fad818 100644 --- a/base/initialize.lisp +++ b/sql/initialize.lisp @@ -17,7 +17,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) (defvar *loaded-database-types* nil "Contains a list of database types which have been defined/loaded.") diff --git a/sql/kmr-mop.lisp b/sql/kmr-mop.lisp index e82ac66..530bee4 100644 --- a/sql/kmr-mop.lisp +++ b/sql/kmr-mop.lisp @@ -16,7 +16,7 @@ ;;;; This file was extracted from the KMRCL utilities ;;;; ************************************************************************* -(in-package #:clsql) +(in-package #:clsql-sys) #+lispworks (defun intern-eql-specializer (slot) diff --git a/base/loop-extension.lisp b/sql/loop-extension.lisp similarity index 86% rename from base/loop-extension.lisp rename to sql/loop-extension.lisp index 1746832..701e77f 100644 --- a/base/loop-extension.lisp +++ b/sql/loop-extension.lisp @@ -48,7 +48,7 @@ (unless in-phrase (ansi-loop::loop-error "Missing OF or IN iteration path.")) (unless from-phrase - (setq from-phrase '(clsql-base:*default-database*))) + (setq from-phrase '(clsql-sys:*default-database*))) (unless (consp variable) (setq variable (list variable))) @@ -65,7 +65,7 @@ 'loop-record-result-)) (step-var (ansi-loop::loop-gentemp 'loop-record-step-))) `(((,variable nil ,@(and data-type (list data-type))) - (,result-var (clsql-base:query ,(first in-phrase))) + (,result-var (clsql-sys:query ,(first in-phrase))) (,step-var nil)) () () @@ -94,7 +94,7 @@ 'loop-record-result-set-)) (step-var (ansi-loop::loop-gentemp 'loop-record-step-))) (push `(when ,result-set-var - (clsql-base:database-dump-result-set ,result-set-var ,db-var)) + (clsql-sys: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)) @@ -102,15 +102,15 @@ (,result-set-var nil) (,step-var nil)) ((multiple-value-bind (%rs %cols) - (clsql-base:database-query-result-set ,query-var ,db-var :result-types :auto) + (clsql-sys:database-query-result-set ,query-var ,db-var :result-types :auto) (setq ,result-set-var %rs ,step-var (make-list %cols)))) () () - (not (clsql-base:database-store-next-row ,result-set-var ,db-var ,step-var)) + (not (clsql-sys:database-store-next-row ,result-set-var ,db-var ,step-var)) (,variable ,step-var) (not ,result-set-var) () - (not (clsql-base:database-store-next-row ,result-set-var ,db-var ,step-var)) + (not (clsql-sys:database-store-next-row ,result-set-var ,db-var ,step-var)) (,variable ,step-var))))))) #+(or cmu scl sbcl openmcl allegro) @@ -154,7 +154,7 @@ (unless in-phrase (error "Missing OF or IN iteration path.")) (unless from-phrase - (setq from-phrase '(clsql-base:*default-database*))) + (setq from-phrase '(clsql:*default-database*))) (unless (consp iter-var) (setq iter-var (list iter-var))) @@ -173,7 +173,7 @@ t nil `(,@(mapcar (lambda (v) `(,v nil)) iter-var) - (,result-var (clsql-base:query ,in-phrase)) + (,result-var (clsql:query ,in-phrase)) (,step-var nil)) () () @@ -210,18 +210,18 @@ (,result-set-var nil) (,step-var nil)) `((multiple-value-bind (%rs %cols) - (clsql-base:database-query-result-set ,query-var ,db-var :result-types :auto) + (clsql-sys:database-query-result-set ,query-var ,db-var :result-types :auto) (setq ,result-set-var %rs ,step-var (make-list %cols)))) () () - `((unless (clsql-base:database-store-next-row ,result-set-var ,db-var ,step-var) + `((unless (clsql-sys:database-store-next-row ,result-set-var ,db-var ,step-var) (when ,result-set-var - (clsql-base:database-dump-result-set ,result-set-var ,db-var)) + (clsql-sys:database-dump-result-set ,result-set-var ,db-var)) t)) `(,iter-var ,step-var) - `((unless (clsql-base:database-store-next-row ,result-set-var ,db-var ,step-var) + `((unless (clsql-sys:database-store-next-row ,result-set-var ,db-var ,step-var) (when ,result-set-var - (clsql-base:database-dump-result-set ,result-set-var ,db-var)) + (clsql-sys:database-dump-result-set ,result-set-var ,db-var)) t)) `(,iter-var ,step-var) () diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp index 1ab11f4..5d47ce9 100644 --- a/sql/metaclasses.lisp +++ b/sql/metaclasses.lisp @@ -12,7 +12,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql) +(in-package #:clsql-sys) (eval-when (:compile-toplevel :load-toplevel :execute) (when (>= (length (generic-function-lambda-list diff --git a/sql/objects.lisp b/sql/objects.lisp index 04951f9..ce6022c 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -13,7 +13,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql) +(in-package #:clsql-sys) (defclass standard-db-object () ((view-database :initform nil :initarg :view-database :reader view-database @@ -182,7 +182,7 @@ superclass of the newly-defined View Class." (defclass ,class ,supers ,slots ,@(if (find :metaclass `,cl-options :key #'car) `,cl-options - (cons '(:metaclass clsql::standard-db-class) `,cl-options))) + (cons '(:metaclass clsql-sys::standard-db-class) `,cl-options))) (finalize-inheritance (find-class ',class)) (find-class ',class))) @@ -423,7 +423,7 @@ superclass of the newly-defined View Class." (let ((qualifier (key-qualifier-for-instance instance :database vd))) (delete-records :from vt :where qualifier :database vd) (setf (slot-value instance 'view-database) nil)) - (error 'clsql-base::clsql-no-database-error :database nil)))) + (error 'clsql-no-database-error :database nil)))) (defmethod update-instance-from-records ((instance standard-db-object) &key (database *default-database*)) @@ -482,7 +482,7 @@ superclass of the newly-defined View Class." (defmethod database-get-type-specifier (type args database) (declare (ignore type args)) - (if (clsql-base::in (database-underlying-type database) + (if (in (database-underlying-type database) :postgresql :postgresql-socket) "VARCHAR" "VARCHAR(255)")) @@ -506,7 +506,7 @@ superclass of the newly-defined View Class." database) (if args (format nil "VARCHAR(~A)" (car args)) - (if (clsql-base::in (database-underlying-type database) + (if (in (database-underlying-type database) :postgresql :postgresql-socket) "VARCHAR" "VARCHAR(255)"))) @@ -515,7 +515,7 @@ superclass of the newly-defined View Class." database) (if args (format nil "VARCHAR(~A)" (car args)) - (if (clsql-base::in (database-underlying-type database) + (if (in (database-underlying-type database) :postgresql :postgresql-socket) "VARCHAR" "VARCHAR(255)"))) @@ -523,7 +523,7 @@ superclass of the newly-defined View Class." (defmethod database-get-type-specifier ((type (eql 'string)) args database) (if args (format nil "VARCHAR(~A)" (car args)) - (if (clsql-base::in (database-underlying-type database) + (if (in (database-underlying-type database) :postgresql :postgresql-socket) "VARCHAR" "VARCHAR(255)"))) @@ -587,7 +587,7 @@ superclass of the newly-defined View Class." (declare (ignore database)) (progv '(*print-circle* *print-array*) '(t t) (let ((escaped (prin1-to-string val))) - (clsql-base::substitute-char-string + (substitute-char-string escaped #\Null " ")))) (defmethod database-output-sql-as-type ((type (eql 'symbol)) val database) @@ -667,8 +667,8 @@ superclass of the newly-defined View Class." (defmethod read-sql-value (val (type (eql 'symbol)) database) (declare (ignore database)) (when (< 0 (length val)) - (unless (string= val (clsql-base:symbol-name-default-case "NIL")) - (intern (clsql-base:symbol-name-default-case val) + (unless (string= val (symbol-name-default-case "NIL")) + (intern (symbol-name-default-case val) (symbol-package *update-context*))))) (defmethod read-sql-value (val (type (eql 'integer)) database) diff --git a/sql/operations.lisp b/sql/operations.lisp index f05df97..9d8ef8d 100644 --- a/sql/operations.lisp +++ b/sql/operations.lisp @@ -12,7 +12,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql) +(in-package #:clsql-sys) ;; Keep a hashtable for mapping symbols to sql generator functions, ;; for use by the bracketed reader syntax. diff --git a/sql/package.lisp b/sql/package.lisp index 1b887ed..5893046 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -1,9 +1,9 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* +;;;; FILE IDENTIFICATION ;;;; -;;;; $Id$ -;;;; -;;;; Package definitions for CLSQL. +;;;; Name: package.lisp +;;;; Purpose: Package definition for SQL interface ;;;; ;;;; This file is part of CLSQL. ;;;; @@ -14,13 +14,15 @@ (in-package #:cl-user) -(eval-when (:compile-toplevel :load-toplevel :execute) +;;;; This file makes the required package definitions for CLSQL's +;;;; core packages. -#+sbcl +(eval-when (:compile-toplevel :load-toplevel :execute) + #+sbcl (if (find-package 'sb-mop) (pushnew :clsql-sbcl-mop cl:*features*) (pushnew :clsql-sbcl-pcl cl:*features*)) - + #+cmu (if (eq (symbol-package 'pcl:find-class) (find-package 'common-lisp)) @@ -29,8 +31,8 @@ (eval-when (:compile-toplevel :load-toplevel :execute) - (defpackage #:clsql - (:use #:common-lisp #:clsql-base + (defpackage #:clsql-sys + (:use #:common-lisp #+clsql-sbcl-mop #:sb-mop #+clsql-cmucl-mop #:mop #+allegro #:mop @@ -41,341 +43,194 @@ #+allegro (:shadowing-import-from #:excl) - #+lispworks - (:shadowing-import-from - #:clos) - #+clsql-sbcl-mop - (:shadowing-import-from - #:sb-pcl - #:generic-function-lambda-list) - #+clsql-sbcl-pcl - (:shadowing-import-from - #:sb-pcl - #:name - #:class-direct-slots - #:class-of #:class-name #:class-slots #:find-class - #:slot-boundp - #:standard-class - #:slot-definition-name #:finalize-inheritance - #:standard-direct-slot-definition - #:standard-effective-slot-definition #:validate-superclass - #:direct-slot-definition-class #:compute-effective-slot-definition - #:effective-slot-definition-class - #:slot-value-using-class - #:class-prototype #:generic-function-method-class #:intern-eql-specializer - #:make-method-lambda #:generic-function-lambda-list - #:class-precedence-list #:slot-definition-type - #:class-direct-superclasses - #:compute-class-precedence-list) - #+clsql-cmucl-mop - (:shadowing-import-from - #:pcl - #:generic-function-lambda-list) - #+clsql-cmucl-pcl - (:shadowing-import-from - #:pcl - #:class-direct-slots - #:name - #:class-of #:class-name #:class-slots #:find-class #:standard-class - #:slot-boundp - #:slot-definition-name #:finalize-inheritance - #:standard-direct-slot-definition #:standard-effective-slot-definition - #:validate-superclass #:direct-slot-definition-class - #:effective-slot-definition-class - #:compute-effective-slot-definition - #:slot-value-using-class - #:class-prototype #:generic-function-method-class #:intern-eql-specializer - #:make-method-lambda #:generic-function-lambda-list - #:class-precedence-list #:slot-definition-type - #:class-direct-superclasses - #:compute-class-precedence-list) - #+scl - (:shadowing-import-from - #:clos - #:class-prototype ;; note: make-method-lambda is not fbound - ) - - (:import-from - #:clsql-base - . - #1=( - ;; conditions - #: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-type-error - #:clsql-sql-syntax-error - #:*backend-warning-behavior* - - ;; db-interface - #:check-connection-spec - #:database-initialize-database-type - #:database-type-load-foreign - #:database-name-from-spec - #:database-create-sequence - #:database-drop-sequence - #:database-sequence-next - #:database-set-sequence-position - #:database-query-result-set - #:database-dump-result-set - #:database-store-next-row - #:database-get-type-specifier - #:database-list-tables - #:database-list-views - #:database-list-indexes - #:database-list-table-indexes - #:database-list-sequences - #:database-list-attributes - #:database-attribute-type - #:database-add-attribute - #:database-type - - ;; initialize - #:*loaded-database-types* - #:reload-database-types - #:*initialized-database-types* - #:initialize-database-type - ;; classes - #:database - #:database-name - #:command-recording-stream - #:result-recording-stream - #:database-view-classes - #:conn-pool - #:print-object - - ;; utils - #:sql-escape + #+lispworks + (:shadowing-import-from + #:clos) + #+clsql-sbcl-mop + (:shadowing-import-from + #:sb-pcl + #:generic-function-lambda-list) + #+clsql-sbcl-pcl + (:shadowing-import-from + #:sb-pcl + #:name + #:class-direct-slots + #:class-of #:class-name #:class-slots #:find-class + #:slot-boundp + #:standard-class + #:slot-definition-name #:finalize-inheritance + #:standard-direct-slot-definition + #:standard-effective-slot-definition #:validate-superclass + #:direct-slot-definition-class #:compute-effective-slot-definition + #:effective-slot-definition-class + #:slot-value-using-class + #:class-prototype #:generic-function-method-class #:intern-eql-specializer + #:make-method-lambda #:generic-function-lambda-list + #:class-precedence-list #:slot-definition-type + #:class-direct-superclasses + #:compute-class-precedence-list) + #+clsql-cmucl-mop + (:shadowing-import-from + #:pcl + #:generic-function-lambda-list) + #+clsql-cmucl-pcl + (:shadowing-import-from + #:pcl + #:class-direct-slots + #:name + #:class-of #:class-name #:class-slots #:find-class #:standard-class + #:slot-boundp + #:slot-definition-name #:finalize-inheritance + #:standard-direct-slot-definition #:standard-effective-slot-definition + #:validate-superclass #:direct-slot-definition-class + #:effective-slot-definition-class + #:compute-effective-slot-definition + #:slot-value-using-class + #:class-prototype #:generic-function-method-class #:intern-eql-specializer + #:make-method-lambda #:generic-function-lambda-list + #:class-precedence-list #:slot-definition-type + #:class-direct-superclasses + #:compute-class-precedence-list) + #+scl + (:shadowing-import-from + #:clos + #:class-prototype ;; note: make-method-lambda is not fbound + ) + + (:export + ;; "Private" exports for use by interface packages + #:check-connection-spec + #:database-initialize-database-type + #:database-type-load-foreign + #:database-name-from-spec + #:database-connect + #:database-disconnect + #:database-query + #:database-execute-command + #:database-create-sequence + #:database-drop-sequence + #:database-sequence-next + #:database-set-sequence-position + #:database-query-result-set + #:database-dump-result-set + #:database-store-next-row + #:database-get-type-specifier + #:database-list-tables + #:database-table-exists-p + #:database-list-views + #:database-view-exists-p + #:database-list-indexes + #:database-list-table-indexes + #:database-index-exists-p + #:database-list-sequences + #:database-sequence-exists-p + #:database-list-attributes + #:database-attribute-type + #:database-describe-table + #:database-type-library-loaded + + #:db-backend-has-create/destroy-db? + #:db-type-has-views? + #:db-type-has-subqueries? + #:db-type-has-boolean-where? + #:db-type-transaction-capable? + #:db-type-has-fancy-math? + #:db-type-default-case + #:db-type-use-column-on-drop-index? + #:database-underlying-type - ;; database.lisp -- Connection - #:*default-database-type* ; database xx - #:*default-database* ; database 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 xx - #:find-database ; database xx - #:status ; database xx - #:with-database - #:with-default-database - #:create-database - #:destroy-database - #:probe-database - - ;; pool.lisp - #:disconnect-pooled + ;; Large objects + #:database-create-large-object + #:database-write-large-object + #:database-read-large-object + #:database-delete-large-object + #:create-large-object + #:write-large-object + #:read-large-object + #:delete-large-object - ;; basic-sql.lisp - #:query - #:execute-command - #:write-large-object - #:read-large-object - #:delete-large-object - #:describe-table - #:create-large-object - #:write-large-object - #:read-large-object - #:delete-large-object + ;; accessors for database class + #:name + #:connection-spec + #:transaction + #:transaction-level + #:conn-pool + #:command-recording-stream + #:result-recording-stream + #:record-caches + #:view-classes + #:database-type + #:database-state + #:attribute-cache + - - ;; recording.lisp -- SQL I/O Recording - #:record-sql-command - #:record-sql-result - #: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 - - ;; 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 capabilities - #:db-type-use-column-on-drop-index? - #:db-backend-has-create/destroy-db? - #:db-type-has-views? - #:db-type-has-subqueries? - #:db-type-has-boolean-where? - #:db-type-transaction-capable? - #:db-type-has-fancy-math? - #:db-type-default-case - #:convert-to-db-default-case - #:database-underlying-type + ;; utils.lisp + #:without-interrupts + #:make-process-lock + #:with-process-lock + #:command-output + #:symbol-name-default-case + #:convert-to-db-default-case + #:ensure-keyword - ;; 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 - )) - (:export - ;; "Private" exports for use by interface packages - #:check-connection-spec - #:database-initialize-database-type - #:database-type-load-foreign - #:database-name-from-spec - #:database-connect - #:database-query - #:database-execute-command - #:database-create-sequence - #:database-drop-sequence - #:database-sequence-next - #:database-set-sequence-position - #:database-query-result-set - #:database-dump-result-set - #:database-store-next-row - #:database-get-type-specifier - #:database-list-tables - #:database-table-exists-p - #:database-list-views - #:database-view-exists-p - #:database-list-indexes - #:database-list-table-indexes - #:database-index-exists-p - #:database-list-sequences - #:database-sequence-exists-p - #:database-list-attributes - #:database-attribute-type - #:database-describe-table + + #: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 + #:*initialized-database-types* + #:initialize-database-type + #:*connect-if-exists* + #:*default-database* + #:connected-databases + #:database + #:find-database + #:is-database-open + #:database-type ; database x - #:db-backend-has-create/destroy-db? - #:db-type-has-views? - #:db-type-has-subqueries? - #:db-type-has-boolean-where? - #:db-type-transaction-capable? - #:db-type-has-fancy-math? - #:db-type-default-case - #:database-underlying-type - - . - ;; Shared exports for re-export by CLSQL-USER. - ;; I = Implemented, D = Documented - ;; name file ID - ;;==================================================== - #2=(;;------------------------------------------------ - ;; CommonSQL API - ;;------------------------------------------------ - ;;FDML + ;; utils.lisp + #:number-to-sql-string + #:float-to-sql-string + #:sql-escape-quotes + #:in + + . + ;; Shared exports for re-export by CLSQL package. + ;; I = Implemented, D = Documented + ;; name file ID + ;;==================================================== + #1=(;;------------------------------------------------ + ;; CommonSQL API + ;;------------------------------------------------ + ;;FDML #:select ; objects xx #:cache-table-queries ; #:*cache-table-queries-default* ; @@ -387,7 +242,9 @@ #:print-query ; sql xx #:do-query ; sql xx #:map-query ; sql xx - #:loop ; loop-ext x + #:for-each-row + #:loop + ;;FDDL #:create-table ; table xx #:drop-table ; table xx @@ -429,14 +286,6 @@ #:locally-enable-sql-reader-syntax ; syntax xx #:restore-sql-reader-syntax-state ; syntax xx - ;;------------------------------------------------ - ;; Miscellaneous Extensions - ;;------------------------------------------------ - ;;Initialization - #:*loaded-database-types* ; clsql-base xx - #:reload-database-types ; clsql-base xx - #:database-type ; database x - #:is-database-open ;;FDDL #:list-views ; table xx #:view-exists-p ; table xx @@ -463,6 +312,13 @@ #:database-get-type-specifier ; objects x #:database-output-sql ; sql/class xx + ;; conditions + #:clsql-condition + #:clsql-error + #:clsql-simple-error + #:clsql-warning + #:clsql-simple-warning + ;;----------------------------------------------- ;; Symbolic Sql Syntax ;;----------------------------------------------- @@ -505,24 +361,152 @@ #:sql-view-class #:sql_slot-value - #:do-query - #:map-query - . - #1# + + ;; 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 + + ;; recording.lisp -- SQL I/O Recording + #:record-sql-command + #:record-sql-result + #: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 + + #:describe-table + #:*backend-warning-behavior* + + ;; 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 )) (:documentation "This is the INTERNAL SQL-Interface package of CLSQL.")) -;; see http://thread.gmane.org/gmane.lisp.lispworks.general/681 -#+lispworks -(setf *packages-for-warn-on-redefinition* - (delete "SQL" *packages-for-warn-on-redefinition* :test 'string=)) +(defpackage #:clsql + (:use #:common-lisp) + (:import-from #:clsql-sys . #1#) + (:export . #1#) + (:documentation "This is the user package with CLSQL symbols.")) (defpackage #:clsql-user (:use #:common-lisp) - (:import-from #:clsql . #2#) - (:export . #2#) + (:import-from #:clsql-sys . #1#) + (:export . #1#) (:documentation "This is the user package with CLSQL symbols.")) ;; This is from USQL's pcl-patch @@ -537,8 +521,12 @@ slot-vars pv-parameters)) ,@(mapcar #'(lambda (slot-var) `(declare (ignorable ,slot-var))) slot-vars) ,@body)))) - - + +;; see http://thread.gmane.org/gmane.lisp.lispworks.general/681 +#+lispworks +(setf *packages-for-warn-on-redefinition* + (delete "SQL" *packages-for-warn-on-redefinition* :test 'string=)) + #+sbcl (if (find-package 'sb-mop) (setq cl:*features* (delete :clsql-sbcl-mop cl:*features*)) @@ -548,7 +536,6 @@ (if (find-package 'mop) (setq cl:*features* (delete :clsql-cmucl-mop cl:*features*)) (setq cl:*features* (delete :clsql-cmucl-pcl cl:*features*))) - -);eval-when +) ;eval-when diff --git a/base/pool.lisp b/sql/pool.lisp similarity index 99% rename from base/pool.lisp rename to sql/pool.lisp index 0564eb0..b0e228f 100644 --- a/base/pool.lisp +++ b/sql/pool.lisp @@ -16,7 +16,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) (defvar *db-pool* (make-hash-table :test #'equal)) (defvar *db-pool-lock* (make-process-lock "DB Pool lock")) diff --git a/base/recording.lisp b/sql/recording.lisp similarity index 99% rename from base/recording.lisp rename to sql/recording.lisp index 85620f7..7df9a8b 100644 --- a/base/recording.lisp +++ b/sql/recording.lisp @@ -13,7 +13,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) (defun start-sql-recording (&key (type :commands) (database *default-database*)) "Begin recording SQL command or result traffic. By default the diff --git a/sql/sql.lisp b/sql/sql.lisp index 0397bd0..ae4da83 100644 --- a/sql/sql.lisp +++ b/sql/sql.lisp @@ -12,7 +12,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql) +(in-package #:clsql-sys) ;;; Basic operations on databases @@ -45,7 +45,7 @@ (defun truncate-database (&key (database *default-database*)) (unless (typep database 'database) - (clsql-base::signal-no-database-error database)) + (signal-no-database-error database)) (unless (is-database-open database) (database-reconnect database)) (when (db-type-has-views? (database-underlying-type database)) @@ -413,3 +413,75 @@ MAP." (setf (aref result index) (apply function row)))) (database-dump-result-set result-set database))))) + +;;; Row processing macro from CLSQL + +(defmacro for-each-row (((&rest fields) &key from order-by where distinct limit) &body body) + (let ((d (gensym "DISTINCT-")) + (bind-fields (loop for f in fields collect (car f))) + (w (gensym "WHERE-")) + (o (gensym "ORDER-BY-")) + (frm (gensym "FROM-")) + (l (gensym "LIMIT-")) + (q (gensym "QUERY-"))) + `(let ((,frm ,from) + (,w ,where) + (,d ,distinct) + (,l ,limit) + (,o ,order-by)) + (let ((,q (query-string ',fields ,frm ,w ,d ,o ,l))) + (loop for tuple in (query ,q) + collect (destructuring-bind ,bind-fields tuple + ,@body)))))) + +(defun query-string (fields from where distinct order-by limit) + (concatenate + 'string + (format nil "select ~A~{~A~^,~} from ~{~A~^ and ~}" + (if distinct "distinct " "") (field-names fields) + (from-names from)) + (if where (format nil " where ~{~A~^ ~}" + (where-strings where)) "") + (if order-by (format nil " order by ~{~A~^, ~}" + (order-by-strings order-by))) + (if limit (format nil " limit ~D" limit) ""))) + +(defun lisp->sql-name (field) + (typecase field + (string field) + (symbol (string-upcase (symbol-name field))) + (cons (cadr field)) + (t (format nil "~A" field)))) + +(defun field-names (field-forms) + "Return a list of field name strings from a fields form" + (loop for field-form in field-forms + collect + (lisp->sql-name + (if (cadr field-form) + (cadr field-form) + (car field-form))))) + +(defun from-names (from) + "Return a list of field name strings from a fields form" + (loop for table in (if (atom from) (list from) from) + collect (lisp->sql-name table))) + + +(defun where-strings (where) + (loop for w in (if (atom (car where)) (list where) where) + collect + (if (consp w) + (format nil "~A ~A ~A" (second w) (first w) (third w)) + (format nil "~A" w)))) + +(defun order-by-strings (order-by) + (loop for o in order-by + collect + (if (atom o) + (lisp->sql-name o) + (format nil "~A ~A" (lisp->sql-name (car o)) + (lisp->sql-name (cadr o)))))) + + + diff --git a/sql/syntax.lisp b/sql/syntax.lisp index 9fca445..5a713d0 100644 --- a/sql/syntax.lisp +++ b/sql/syntax.lisp @@ -14,7 +14,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql) +(in-package #:clsql-sys) (defvar *original-reader-enter* nil) diff --git a/sql/table.lisp b/sql/table.lisp index ad8c55a..3820c19 100644 --- a/sql/table.lisp +++ b/sql/table.lisp @@ -15,7 +15,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql) +(in-package #:clsql-sys) ;; Utilities diff --git a/base/time.lisp b/sql/time.lisp similarity index 99% rename from base/time.lisp rename to sql/time.lisp index 0b70f2c..8d06846 100644 --- a/base/time.lisp +++ b/sql/time.lisp @@ -15,7 +15,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) ;; ------------------------------------------------------------ ;; Months diff --git a/base/transaction.lisp b/sql/transaction.lisp similarity index 99% rename from base/transaction.lisp rename to sql/transaction.lisp index 61438ed..0b2b63d 100644 --- a/base/transaction.lisp +++ b/sql/transaction.lisp @@ -12,7 +12,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) (defclass transaction () ((commit-hooks :initform () :accessor commit-hooks) diff --git a/base/utils.lisp b/sql/utils.lisp similarity index 99% rename from base/utils.lisp rename to sql/utils.lisp index 8a96df6..e1de857 100644 --- a/base/utils.lisp +++ b/sql/utils.lisp @@ -16,7 +16,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base) +(in-package #:clsql-sys) (defun number-to-sql-string (num) (etypecase num diff --git a/tests/benchmarks.lisp b/tests/benchmarks.lisp index c6b0be0..ec281d4 100644 --- a/tests/benchmarks.lisp +++ b/tests/benchmarks.lisp @@ -74,9 +74,9 @@ (mapcar #'(lambda (ea) (slot-value ea 'address)) (select 'employee-address :flatp t)))) (format *report-stream* "~&~%*** JOINED OBJECT QUERY RETRIEVAL DEFERRED ***~%") - (let* ((slotdef (find 'address (clsql::class-slots (find-class 'employee-address)) - :key #'clsql::slot-definition-name)) - (dbi (when slotdef (clsql::view-class-slot-db-info slotdef)))) + (let* ((slotdef (find 'address (clsql-sys::class-slots (find-class 'employee-address)) + :key #'clsql-sys::slot-definition-name)) + (dbi (when slotdef (clsql-sys::view-class-slot-db-info slotdef)))) (setf (gethash :retrieval dbi) :deferred) (time (dotimes (i (truncate n 10)) diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp index 35b3921..6a27fdd 100644 --- a/tests/test-basic.lisp +++ b/tests/test-basic.lisp @@ -3,7 +3,7 @@ ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: test-basic.lisp -;;;; Purpose: Tests for clsql-base and result types +;;;; Purpose: Tests for clsql string-based queries and result types ;;;; Author: Kevin M. Rosenberg ;;;; Created: Mar 2002 ;;;; @@ -29,9 +29,9 @@ (clsql:execute-command (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,~a,'~a')" test-int - (clsql-base:number-to-sql-string test-flt) + (clsql-sys:number-to-sql-string test-flt) (transform-bigint-1 test-int) - (clsql-base:number-to-sql-string test-flt) + (clsql-sys:number-to-sql-string test-flt) ))))) (defun test-basic-forms () diff --git a/tests/test-connection.lisp b/tests/test-connection.lisp index 11d3cc4..7f5a786 100644 --- a/tests/test-connection.lisp +++ b/tests/test-connection.lisp @@ -22,17 +22,17 @@ (deftest :connection/1 (let ((database (clsql:find-database (clsql:database-name clsql:*default-database*) - :db-type (clsql:database-type clsql:*default-database*)))) - (eql (clsql:database-type database) *test-database-type*)) + :db-type (clsql-sys:database-type clsql:*default-database*)))) + (eql (clsql-sys:database-type database) *test-database-type*)) t) (deftest :connection/2 - (clsql-base::string-to-list-connection-spec + (clsql-sys::string-to-list-connection-spec "localhost/dbname/user/passwd") ("localhost" "dbname" "user" "passwd")) (deftest :connection/3 - (clsql-base::string-to-list-connection-spec + (clsql-sys::string-to-list-connection-spec "dbname/user@hostname") ("hostname" "dbname" "user")) diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp index 2db453f..32e645b 100644 --- a/tests/test-fddl.lisp +++ b/tests/test-fddl.lisp @@ -112,7 +112,7 @@ t nil) ;; create a view, list its attributes and drop it -(when (clsql-base:db-type-has-views? *test-database-underlying-type*) +(when (clsql-sys: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] diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index 5c95fcd..0286b2d 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -248,7 +248,7 @@ ("lenin@soviet.org")) (deftest :fdml/select/6 - (if (db-type-has-fancy-math? *test-database-underlying-type*) + (if (clsql-sys:db-type-has-fancy-math? *test-database-underlying-type*) (mapcar #'(lambda (s) (parse-integer s :junk-allowed t)) (clsql:select [function "trunc" [height]] :from [employee] :result-types nil diff --git a/tests/test-init.lisp b/tests/test-init.lisp index f0ff688..10caf4c 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -164,7 +164,7 @@ (:base-table "ea_join")) (defun test-connect-to-database (db-type spec) - (when (db-backend-has-create/destroy-db? db-type) + (when (clsql-sys:db-backend-has-create/destroy-db? db-type) (ignore-errors (destroy-database spec :database-type db-type)) (ignore-errors (create-database spec :database-type db-type))) @@ -182,7 +182,7 @@ (truncate-database :database *default-database*) (setf *test-database-underlying-type* - (clsql:database-underlying-type *default-database*)) + (clsql-sys:database-underlying-type *default-database*)) *default-database*) @@ -447,7 +447,7 @@ (defun load-necessary-systems (specs) (dolist (db-type +all-db-types+) (when (db-type-spec db-type specs) - (clsql:initialize-database-type :database-type db-type)))) + (clsql-sys:initialize-database-type :database-type db-type)))) (defun write-report-banner (report-type db-type stream) (format stream @@ -522,28 +522,28 @@ *rt-ooddl* *rt-oodml* *rt-syntax*)) (let ((test (second test-form))) (cond - ((and (null (db-type-has-views? db-underlying-type)) - (clsql-base::in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4)) + ((and (null (clsql-sys:db-type-has-views? db-underlying-type)) + (clsql-sys: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::in test :fdml/select/11 :oodml/select/5)) + ((and (null (clsql-sys:db-type-has-boolean-where? db-underlying-type)) + (clsql-sys: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::in test :fdml/select/5 :fdml/select/10)) + ((and (null (clsql-sys:db-type-has-subqueries? db-underlying-type)) + (clsql-sys: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 + ((and (null (clsql-sys:db-type-transaction-capable? db-underlying-type *default-database*)) - (clsql-base::in test :fdml/transaction/1 :fdml/transaction/2 :fdml/transaction/3 :fdml/transaction/4)) + (clsql-sys: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::in test :fdml/select/1)) + ((and (null (clsql-sys:db-type-has-fancy-math? db-underlying-type)) + (clsql-sys:in test :fdml/select/1)) (push (cons test "fancy math not supported") skip-tests)) ((and (eql *test-database-type* :sqlite) - (clsql-base::in test :fddl/view/4 :fdml/select/10 + (clsql-sys:in test :fddl/view/4 :fdml/select/10 :fdml/select/21)) (push (cons test "not supported by sqlite") skip-tests)) ((and (eql *test-database-underlying-type* :mysql) - (clsql-base::in test :fdml/select/22 :fdml/query/5 + (clsql-sys:in test :fdml/select/22 :fdml/query/5 :fdml/query/7 :fdml/query/8)) (push (cons test "not supported by mysql") skip-tests)) (t diff --git a/tests/test-ooddl.lisp b/tests/test-ooddl.lisp index 48d1630..0339179 100644 --- a/tests/test-ooddl.lisp +++ b/tests/test-ooddl.lisp @@ -26,25 +26,25 @@ ;; Ensure slots inherited from standard-classes are :virtual (deftest :ooddl/metaclass/1 (values - (clsql::view-class-slot-db-kind - (clsql::slotdef-for-slot-with-class 'extraterrestrial + (clsql-sys::view-class-slot-db-kind + (clsql-sys::slotdef-for-slot-with-class 'extraterrestrial (find-class 'person))) - (clsql::view-class-slot-db-kind - (clsql::slotdef-for-slot-with-class 'hobby (find-class 'person)))) + (clsql-sys::view-class-slot-db-kind + (clsql-sys::slotdef-for-slot-with-class 'hobby (find-class 'person)))) :virtual :virtual) ;; Ensure all slots in view-class are view-class-effective-slot-definition (deftest :ooddl/metaclass/2 (values (every #'(lambda (slotd) - (typep slotd 'clsql::view-class-effective-slot-definition)) - (clsql::class-slots (find-class 'person))) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'person))) (every #'(lambda (slotd) - (typep slotd 'clsql::view-class-effective-slot-definition)) - (clsql::class-slots (find-class 'employee))) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'employee))) (every #'(lambda (slotd) - (typep slotd 'clsql::view-class-effective-slot-definition)) - (clsql::class-slots (find-class 'company)))) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'company)))) t t t) (deftest :ooddl/join/1 -- 2.34.1