1 files changed, 103 insertions, 0 deletions
diff --git a/sql/sequences.lisp b/sql/sequences.lisp
new file mode 100644
index 0000000..1b32f29
--- /dev/null
+++ b/sql/sequences.lisp
@@ -0,0 +1,103 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;;
+;;;; 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
+
+(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 %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))")
+     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))
+
+(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)
+              (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)
+           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))))