X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fsequences.lisp;h=3e9a2e4816f4440d6a34bcefff481ac48381268f;hb=925a29060928f773d4bc7d8e6bdd13c97e0ef65a;hp=1e3ef9ec6b75475848c320c5daf6c09662c4473f;hpb=5148be446aee32ec705beac3fbba35f499df4fd4;p=clsql.git diff --git a/sql/sequences.lisp b/sql/sequences.lisp index 1e3ef9e..3e9a2e4 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. ;;;; @@ -23,43 +21,44 @@ ;;; 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))) + (escaped + (combine-database-identifiers + (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 %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 "_CLSQL_SEQ" "")) + (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 "_CLSQL_SEQ" 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 integer) 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 +66,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))))