Automated commit for debian release 6.7.2-1
[clsql.git] / sql / sequences.lisp
index b96d78d753598b4ddf9948a0cf7f09385b01a076..1b32f29b2056b0cdeaae4579080dee3ce6446e01 100644 (file)
@@ -1,8 +1,6 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;;
-;;;; $Id$
-;;;;
 ;;;; Generic sequence implementation. Backends should use native sequences if
 ;;;; are available.
 ;;;;
 
 ;;; Sequence functions
 
-(defun %sequence-name-to-table (sequence-name database)
-  (concatenate 'string
-               (convert-to-db-default-case "_CLSQL_SEQ_" database)
-               (sql-escape sequence-name)))
+(defvar *old-sequence-names* nil
+  "Should CLSQL use its old sequence naming scheme _CLSQL_SEQ_{table} instead
+   of the current scheme {table}_CLSQL_SEQ")
 
-(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)))
+(defun %sequence-name-to-table (sequence-name database)
+  (escaped
+   (combine-database-identifiers
+    (if *old-sequence-names*
+        (list '_CLSQL_SEQ sequence-name)
+        (list sequence-name 'CLSQL_SEQ))
+    database)))
 
 (defmethod database-create-sequence (sequence-name database)
   (let ((table-name (%sequence-name-to-table sequence-name database)))
    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name database))
    database))
 
+(defun %seq-name-key ()
+  (if *old-sequence-names*
+      "_CLSQL_SEQ_"
+      "_CLSQL_SEQ"))
+
+(defun %table-name-to-sequence-name (table-name)
+  ;; if this was escaped it still should be,
+  ;; if it wasnt it still shouldnt-be
+  (check-type table-name string)
+  (replace-all table-name (%seq-name-key) ""))
+
 (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))))
+              (and (search (%seq-name-key) s :test #'string-equal)
+                   (list (%table-name-to-sequence-name s))))
           (database-list-tables-and-sequences database)))
 
 (defmethod database-set-sequence-position (sequence-name position database)