X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fsequences.lisp;h=1b32f29b2056b0cdeaae4579080dee3ce6446e01;hp=b96d78d753598b4ddf9948a0cf7f09385b01a076;hb=HEAD;hpb=e567409d9fff3f7231c2a0bb69b345e19de2b246 diff --git a/sql/sequences.lisp b/sql/sequences.lisp index b96d78d..1b32f29 100644 --- a/sql/sequences.lisp +++ b/sql/sequences.lisp @@ -1,8 +1,6 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; -;;;; $Id$ -;;;; ;;;; Generic sequence implementation. Backends should use native sequences if ;;;; are available. ;;;; @@ -22,16 +20,17 @@ ;;; 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))) @@ -49,11 +48,22 @@ (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)