X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fsequences.lisp;h=1b32f29b2056b0cdeaae4579080dee3ce6446e01;hp=b82b9b8e5a13178592bf663efe00ddecd7714e30;hb=534849c88501e0ea2ee5dbf78d13d8cb73814d71;hpb=3cf717eee40ce39ae7969fe046a53becadb117d7 diff --git a/sql/sequences.lisp b/sql/sequences.lisp index b82b9b8..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,44 +20,56 @@ ;;; 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))) (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))") + " (last_value int NOT NULL PRIMARY KEY, increment_by int, min_value int, is_called char(1))") database) - (database-execute-command + (database-execute-command (concatenate 'string "INSERT INTO " table-name - " VALUES (1,1,1,'f')") + " 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)) + (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)))) - (database-list-tables-and-sequences database))) + (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) (database-execute-command - (format nil "UPDATE ~A SET last_value=~A,is_called='t'" - (%sequence-name-to-table sequence-name database) + (format nil "UPDATE ~A SET last_value=~A,is_called='t'" + (%sequence-name-to-table sequence-name database) position) database) position) @@ -67,27 +77,27 @@ (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)))) + (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)) + (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)))))) - + (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)))) + (caar (database-query + (concatenate 'string "SELECT last_value FROM " + (%sequence-name-to-table sequence-name database)) + database :auto nil))))