22 May 2004 Kevin Rosenberg
* Version 2.10.21 released
+ * sql/sequences.lisp: Move generic sequence functions here from db-sqlite,
+ db-odbc, and db-aodbc.
* sql/*.lisp: Add db-type parameter to generic functions READ-SQL-VALUE,
DATABASE-GET-TYPE-SPECIFIER, and OUTPUT-SQL-VALUE-AS-TYPE. Update methods to use these.
* sql/generic-postgresql.lisp, sql/generic-odbc.lisp: New files
;;;; Author: Kevin M. Rosenberg
;;;; Created: April 2004
;;;;
-;;;; $Id: clsql-odbc.asd 8850 2004-04-07 16:07:46Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 200d42 by Kevin M. Rosenberg
;;;;
(:module :generic
:pathname ""
:components ((:file "generic-postgresql")
- (:file "generic-odbc"))
+ (:file "generic-odbc")
+ (:file "sequences"))
:depends-on (:functional))))))
-;;; Sequence functions
-
-(defun %sequence-name-to-table (sequence-name)
- (concatenate 'string "_CLSQL_SEQ_" (sql-escape sequence-name)))
-
-(defun %table-name-to-sequence-name (table-name)
- (and (>= (length table-name) 11)
- (string-equal (subseq table-name 0 11) "_CLSQL_SEQ_")
- (subseq table-name 11)))
-
-(defmethod database-create-sequence (sequence-name
- (database aodbc-database))
- (let ((table-name (%sequence-name-to-table sequence-name)))
- (database-execute-command
- (concatenate 'string "CREATE TABLE " table-name
- " (last_value int NOT NULL PRIMARY KEY, increment_by int, min_value int, is_called char(1))")
- database)
- (database-execute-command
- (concatenate 'string "INSERT INTO " table-name
- " VALUES (1,1,1,'f')")
- database)))
-
-(defmethod database-drop-sequence (sequence-name
- (database aodbc-database))
- (database-execute-command
- (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
- database))
-
-(defmethod database-list-sequences ((database aodbc-database)
- &key (owner nil))
- (declare (ignore owner))
- (warn "database-list-sequences not implemented for AODBC.")
- nil)
-
-
-(defmethod database-list-indexes ((database aodbc-database)
- &key (owner nil))
- (warn "database-list-indexes not implemented for AODBC.")
- nil)
-
-(defmethod database-set-sequence-position (sequence-name
- (position integer)
- (database aodbc-database))
- (database-execute-command
- (format nil "UPDATE ~A SET last_value=~A,is_called='t'"
- (%sequence-name-to-table sequence-name)
- position)
- database)
- position)
-
-(defmethod database-sequence-next (sequence-name (database aodbc-database))
- (without-interrupts
- (let* ((table-name (%sequence-name-to-table sequence-name))
- (tuple
- (car (database-query
- (concatenate 'string "SELECT last_value,is_called FROM "
- table-name)
- database :auto nil))))
- (cond
- ((char-equal (schar (second tuple) 0) #\f)
- (database-execute-command
- (format nil "UPDATE ~A SET is_called='t'" table-name)
- database)
- (car tuple))
- (t
- (let ((new-pos (1+ (car tuple))))
- (database-execute-command
- (format nil "UPDATE ~A SET last_value=~D" table-name new-pos)
- database)
- new-pos))))))
-
-(defmethod database-sequence-last (sequence-name (database aodbc-database))
- (without-interrupts
- (caar (database-query
- (concatenate 'string "SELECT last_value FROM "
- (%sequence-name-to-table sequence-name))
- database :auto nil))))
-
(defmethod database-create (connection-spec (type (eql :aodbc)))
(warn "Not implemented."))
;;;; Purpose: CLSQL Object layer for MySQL
;;;; Created: May 2004
;;;;
-;;;; $Id: mysql-sql.lisp 9403 2004-05-19 23:46:45Z kevin $
+;;;; $Id$
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
# Programer: Kevin M. Rosenberg
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile 8153 2003-11-11 15:28:36Z kevin $
+# CVS Id: $Id$
#
# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
#
;;;; Purpose: Low-level ODBC API using UFFI
;;;; Authors: Kevin M. Rosenberg and Paul Meurer
;;;;
-;;;; $Id: odbc-package.lisp 7061 2003-09-07 06:34:45Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2004 by Kevin M. Rosenberg
;;;; and Copyright (C) Paul Meurer 1999 - 2001. All rights reserved.
;;;; Purpose: Constants for UFFI interface to ODBC
;;;; Authors: Kevin M. Rosenberg and Paul Meurer
;;;;
-;;;; $Id: odbc-package.lisp 7061 2003-09-07 06:34:45Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2004 by Kevin M. Rosenberg
;;;; and Copyright (C) Paul Meurer 1999 - 2001. All rights reserved.
;;;; Author: Kevin M. Rosenberg
;;;; Create: April 2004
;;;;
-;;;; $Id: odbc-sql.lisp 8983 2004-04-12 21:16:48Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; Purpose: Function definitions for UFFI interface to ODBC
;;;; Author: Kevin M. Rosenberg
;;;;
-;;;; $Id: odbc-package.lisp 7061 2003-09-07 06:34:45Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2004 by Kevin M. Rosenberg
;;;; and Copyright (C) Paul Meurer 1999 - 2001. All rights reserved.
;;;; Programmers: Kevin M. Rosenberg
;;;; Date Started: April 2004
;;;;
-;;;; $Id: odbc-loader.lisp 8270 2003-11-25 06:37:14Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2004 by Kevin M. Rosenberg
;;;;
;;;; Author: Kevin M. Rosenberg
;;;; Created: April 2004
;;;;
-;;;; $Id: odbc-package.lisp 7061 2003-09-07 06:34:45Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2004 by Kevin M. Rosenberg
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: odbc-sql.lisp 8983 2004-04-12 21:16:48Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
-
-;;; Sequence functions
-
-(defun %sequence-name-to-table (sequence-name)
- (concatenate 'string "_CLSQL_SEQ_" (sql-escape sequence-name)))
-
-(defun %table-name-to-sequence-name (table-name)
- (and (>= (length table-name) 11)
- (string-equal (subseq table-name 0 11) "_CLSQL_SEQ_")
- (subseq table-name 11)))
-
-(defmethod database-create-sequence (sequence-name
- (database odbc-database))
- (let ((table-name (%sequence-name-to-table sequence-name)))
- (database-execute-command
- (concatenate 'string "CREATE TABLE " table-name
- " (last_value int NOT NULL PRIMARY KEY, increment_by int, min_value int, is_called char(1))")
- database)
- (database-execute-command
- (concatenate 'string "INSERT INTO " table-name
- " VALUES (1,1,1,'f')")
- database)))
-
-(defmethod database-drop-sequence (sequence-name
- (database odbc-database))
- (database-execute-command
- (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
- database))
-
-(defmethod database-list-sequences ((database odbc-database)
- &key (owner nil))
- (declare (ignore owner))
- ;; FIXME: Underlying database backend stuff should come from that backend
-
- (case (database-odbc-db-type database)
- (:mysql
- (mapcan #'(lambda (s)
- (let ((sn (%table-name-to-sequence-name (car s))))
- (and sn (list sn))))
- (database-query "SHOW TABLES" database nil nil)))
- ((:postgresql :postgresql-socket)
- (mapcar #'(lambda (s) (%table-name-to-sequence-name (car s)))
- (database-query "SELECT RELNAME FROM pg_class WHERE RELNAME LIKE '%clsql_seq%'"
- database nil nil)))))
-
-
-(defmethod database-set-sequence-position (sequence-name
- (position integer)
- (database odbc-database))
- (database-execute-command
- (format nil "UPDATE ~A SET last_value=~A,is_called='t'"
- (%sequence-name-to-table sequence-name)
- position)
- database)
- position)
-
-(defmethod database-sequence-next (sequence-name (database odbc-database))
- (without-interrupts
- (let* ((table-name (%sequence-name-to-table sequence-name))
- (tuple
- (car (database-query
- (concatenate 'string "SELECT last_value,is_called FROM "
- table-name)
- database :auto nil))))
- (cond
- ((char-equal (schar (second tuple) 0) #\f)
- (database-execute-command
- (format nil "UPDATE ~A SET is_called='t'" table-name)
- database)
- (car tuple))
- (t
- (let ((new-pos (1+ (car tuple))))
- (database-execute-command
- (format nil "UPDATE ~A SET last_value=~D" table-name new-pos)
- database)
- new-pos))))))
-
-(defmethod database-sequence-last (sequence-name (database odbc-database))
- (without-interrupts
- (caar (database-query
- (concatenate 'string "SELECT last_value FROM "
- (%sequence-name-to-table sequence-name))
- database :auto nil))))
-
(defmethod database-create (connection-spec (type (eql :odbc)))
(declare (ignore connection-spec))
(warn "Not implemented."))
# Programer: Kevin M. Rosenberg
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile 8153 2003-11-11 15:28:36Z kevin $
+# CVS Id: $Id$
#
# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
#
;;; Object listing
-(defmethod database-list-tables ((database sqlite-database) &key owner)
+(defmethod database-list-tables-and-sequences ((database sqlite-database) &key owner)
(declare (ignore owner))
;; Query is copied from .table command of sqlite comamnd line utility.
+ (mapcar #'car (database-query
+ "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name"
+ database nil nil)))
+
+(defmethod database-list-tables ((database sqlite-database) &key owner)
(remove-if #'(lambda (s)
(and (>= (length s) 11)
(string-equal (subseq s 0 11) "_CLSQL_SEQ_")))
- (mapcar #'car (database-query
- "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name"
- database nil nil))))
+ (database-list-tables-and-sequences database :owner owner)))
(defmethod database-list-views ((database sqlite-database)
&key (owner nil))
(if (string-equal (fourth field-info) "0")
1 0)))))
-(defun %sequence-name-to-table-name (sequence-name)
- (concatenate 'string "_CLSQL_SEQ_" (sql-escape sequence-name)))
-
-(defun %table-name-to-sequence-name (table-name)
- (and (>= (length table-name) 11)
- (string= (subseq table-name 0 11) "_CLSQL_SEQ_")
- (subseq table-name 11)))
-
-
-(defmethod database-create-sequence (sequence-name
- (database sqlite-database))
- (let ((table-name (%sequence-name-to-table-name sequence-name)))
- (database-execute-command
- (concatenate 'string "CREATE TABLE " table-name
- " (last_value integer PRIMARY KEY, increment_by integer, min_value integer, is_called char(1))")
- database)
- (database-execute-command
- (concatenate 'string "INSERT INTO " table-name
- " VALUES (1,1,1,'f')")
- database)))
-
-(defmethod database-drop-sequence (sequence-name
- (database sqlite-database))
- (database-execute-command
- (concatenate 'string "DROP TABLE " (%sequence-name-to-table-name sequence-name))
- database))
-
-(defmethod database-list-sequences ((database sqlite-database)
- &key (owner nil))
- (declare (ignore owner))
- (mapcan #'(lambda (s)
- (let ((sn (%table-name-to-sequence-name (car s))))
- (and sn (list sn))))
- (database-query
- "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name"
- database nil nil)))
-
-(defmethod database-sequence-next (sequence-name (database sqlite-database))
- (without-interrupts
- (let* ((table-name (%sequence-name-to-table-name sequence-name))
- (tuple
- (car (database-query
- (concatenate 'string "SELECT last_value,is_called FROM "
- table-name)
- database :auto nil))))
- (cond
- ((char-equal (schar (second tuple) 0) #\f)
- (database-execute-command
- (format nil "UPDATE ~A SET is_called='t'" table-name)
- database)
- (car tuple))
- (t
- (let ((new-pos (1+ (car tuple))))
- (database-execute-command
- (format nil "UPDATE ~A SET last_value=~D" table-name new-pos)
- database)
- new-pos))))))
-
-(defmethod database-sequence-last (sequence-name (database sqlite-database))
- (without-interrupts
- (caar (database-query
- (concatenate 'string "SELECT last_value FROM "
- (%sequence-name-to-table-name sequence-name))
- database :auto nil))))
-
-(defmethod database-set-sequence-position (sequence-name
- (position integer)
- (database sqlite-database))
- (database-execute-command
- (format nil "UPDATE ~A SET last_value=~A,is_called='t'"
- (%sequence-name-to-table-name sequence-name)
- position)
- database)
- position)
-
(defmethod database-create (connection-spec (type (eql :sqlite)))
(declare (ignore connection-spec))
;; databases are created automatically by SQLite
+cl-sql (2.10.21-1) unstable; urgency=low
+
+ * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Sun, 23 May 2004 04:50:44 -0600
+
cl-sql (2.10.20-1) unstable; urgency=low
* New upstream
# Programer: Kevin M. Rosenberg
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile 8153 2003-11-11 15:28:36Z kevin $
+# CVS Id: $Id$
#
# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
#
(defgeneric database-get-type-specifier (type args database db-underlying-type)
(:documentation "Return the type SQL type specifier as a string, for
-the given lisp type and parameters.")
- (:method (type args database db-underlying-type)
- (declare (ignore type args db-type))
- (signal-no-database-error database)))
+the given lisp type and parameters."))
(defgeneric database-list-tables (database &key owner)
(:documentation "List all tables in the given database")
(:method ((database t) &key owner)
(declare (ignore owner))
(signal-no-database-error database)))
+
+(defgeneric database-list-tables-and-sequences (database &key owner)
+ (:documentation "List all tables in the given database, may include seqeneces")
+ (:method ((database t) &key owner)
+ (declare (ignore owner))
+ (signal-no-database-error database))
+ (:method ((database database) &key owner)
+ (database-list-tables database :owner owner)))
(defgeneric database-list-views (database &key owner)
(:documentation "List all views in the DATABASE.")
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;;
-;;;; $Id: $
+;;;; $Id$
;;;;
;;;; Generic ODBC layer, used by db-odbc and db-aodbc backends
;;;;
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;;
-;;;; $Id: $
+;;;; $Id$
;;;;
;;;; Generic postgresql layer, used by db-postgresql and db-postgresql-socket
;;;;
;;;; Author: Kevin M. Rosenberg based on
;;;; Created: Apr 2004
;;;;
-;;;; $Id: db-interface.lisp 9123 2004-04-21 20:34:42Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
;;;;
#:database-dump-result-set
#:database-store-next-row
#:database-list-tables
+ #:database-list-tables-and-sequences
#:database-table-exists-p
#:database-list-views
#:database-view-exists-p
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;;
+;;;; $Id:$
+;;;;
+;;;; Generic sequence implementation. Backends should use native sequences if
+;;;; are available.
+;;;;
+;;;; This file is part of CLSQL.
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package #:clsql-sys)
+
+(defclass generic-database (database)
+ ()
+ (:documentation "Encapsulate same behavior across backends."))
+
+
+;;; Sequence functions
+
+(defun %sequence-name-to-table (sequence-name database)
+ (concatenate 'string
+ (convert-to-db-default-case "_CLSQL_SEQ_" database)
+ (sql-escape sequence-name)))
+
+(defun %table-name-to-sequence-name (table-name database)
+ (and (>= (length table-name) 11)
+ (string-equal (subseq table-name 0 11)
+ (convert-to-db-default-case "_CLSQL_SEQ_" database))
+ (subseq table-name 11)))
+
+(defmethod database-create-sequence (sequence-name database)
+ (let ((table-name (%sequence-name-to-table sequence-name database)))
+ (database-execute-command
+ (concatenate 'string "CREATE TABLE " table-name
+ " (last_value int NOT NULL PRIMARY KEY, increment_by int, min_value int, is_called char(1))")
+ database)
+ (database-execute-command
+ (concatenate 'string "INSERT INTO " table-name
+ " VALUES (1,1,1,'f')")
+ database)))
+
+(defmethod database-drop-sequence (sequence-name database)
+ (database-execute-command
+ (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name database))
+ database))
+
+(defmethod database-list-sequences (database &key (owner nil))
+ (declare (ignore owner))
+ (mapcan #'(lambda (s)
+ (let ((sn (%table-name-to-sequence-name s database)))
+ (and sn (list sn))))
+ (database-list-tables-and-sequences database)))
+
+(defmethod database-set-sequence-position (sequence-name (position integer) database)
+ (database-execute-command
+ (format nil "UPDATE ~A SET last_value=~A,is_called='t'"
+ (%sequence-name-to-table sequence-name database)
+ position)
+ database)
+ position)
+
+(defmethod database-sequence-next (sequence-name database)
+ (without-interrupts
+ (let* ((table-name (%sequence-name-to-table sequence-name database))
+ (tuple
+ (car (database-query
+ (concatenate 'string "SELECT last_value,is_called FROM "
+ table-name)
+ database :auto nil))))
+ (cond
+ ((char-equal (schar (second tuple) 0) #\f)
+ (database-execute-command
+ (format nil "UPDATE ~A SET is_called='t'" table-name)
+ database)
+ (car tuple))
+ (t
+ (let ((new-pos (1+ (car tuple))))
+ (database-execute-command
+ (format nil "UPDATE ~A SET last_value=~D" table-name new-pos)
+ database)
+ new-pos))))))
+
+(defmethod database-sequence-last (sequence-name database)
+ (without-interrupts
+ (caar (database-query
+ (concatenate 'string "SELECT last_value FROM "
+ (%sequence-name-to-table sequence-name database))
+ database :auto nil))))
# Programer: Kevin M. Rosenberg
# Date Started: Mar 2002
#
-# CVS Id: $Id: Makefile 8153 2003-11-11 15:28:36Z kevin $
+# CVS Id: $Id$
#
# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
#
;;;; File: benchmarks.lisp
;;;; Authors: Kevin Rosenberg
;;;; Created: 03/05/2004
-;;;; Updated: $Id: test-init.lisp 9212 2004-05-03 18:44:03Z kevin $
+;;;; Updated: $Id$
;;;;
;;;; Benchmark suite
;;;;
;;;; Author: Kevin M. Rosenberg
;;;; Created: Mar 2002
;;;;
-;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
;;;;
;;; -*- Mode: Lisp -*-
-;;; $Id: test-time.lisp,v 1.10 2004/03/08 18:00:53 jesse Exp $
+;;; $Id$
;;;
;;; Copyright (c) 2000, 2001 onShore Development, Inc.
;;;
;;;; Author: Kevin M. Rosenberg
;;;; Created: Mar 2002
;;;;
-;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $
+;;;; $Id$
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
;;;;