sql/sequences.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;;
   4 ;;;; $Id$
   5 ;;;;
   6 ;;;; Generic sequence implementation. Backends should use native sequences if
   7 ;;;; are available.
   8 ;;;;
   9 ;;;; This file is part of CLSQL.
  10 ;;;;
  11 ;;;; CLSQL users are granted the rights to distribute and use this software
  12 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  13 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  14 ;;;; *************************************************************************
  15
  16 (in-package #:clsql-sys)
  17
  18 (defclass generic-database (database)
  19   ()
  20   (:documentation "Encapsulate same behavior across backends."))
  21
  22
  23 ;;; Sequence functions
  24
  25 (defun %sequence-name-to-table (sequence-name database)
  26   (concatenate 'string
  27                (convert-to-db-default-case "_CLSQL_SEQ_" database)
  28                (sql-escape sequence-name)))
  29
  30 (defun %table-name-to-sequence-name (table-name database)
  31   (and (>= (length table-name) 11)
  32        (string-equal (subseq table-name 0 11)
  33                      (convert-to-db-default-case "_CLSQL_SEQ_" database))
  34        (subseq table-name 11)))
  35
  36 (defmethod database-create-sequence (sequence-name database)
  37   (let ((table-name (%sequence-name-to-table sequence-name database)))
  38     (database-execute-command
  39      (concatenate 'string "CREATE TABLE " table-name
  40                   " (last_value int NOT NULL PRIMARY KEY, increment_by int, min_value int, is_called char(1))")
  41      database)
  42     (database-execute-command
  43      (concatenate 'string "INSERT INTO " table-name
  44                   " VALUES (1,1,1,'f')")
  45      database)))
  46
  47 (defmethod database-drop-sequence (sequence-name database)
  48   (database-execute-command
  49    (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name database))
  50    database))
  51
  52 (defmethod database-list-sequences (database &key (owner nil))
  53   (declare (ignore owner))
  54   (mapcan #'(lambda (s)
  55               (let ((sn (%table-name-to-sequence-name s database)))
  56                 (and sn (list sn))))
  57           (database-list-tables-and-sequences database)))
  58
  59 (defmethod database-set-sequence-position (sequence-name position database)
  60   (database-execute-command
  61    (format nil "UPDATE ~A SET last_value=~A,is_called='t'"
  62            (%sequence-name-to-table sequence-name database)
  63            position)
  64    database)
  65   position)
  66
  67 (defmethod database-sequence-next (sequence-name database)
  68   (without-interrupts
  69    (let* ((table-name (%sequence-name-to-table sequence-name database))
  70           (tuple
  71            (car (database-query
  72                  (concatenate 'string "SELECT last_value,is_called FROM "
  73                               table-name)
  74                  database :auto nil))))
  75      (cond
  76        ((char-equal (schar (second tuple) 0) #\f)
  77         (database-execute-command
  78          (format nil "UPDATE ~A SET is_called='t'" table-name)
  79          database)
  80         (car tuple))
  81        (t
  82         (let ((new-pos (1+ (car tuple))))
  83          (database-execute-command
  84           (format nil "UPDATE ~A SET last_value=~D" table-name new-pos)
  85           database)
  86          new-pos))))))
  87
  88 (defmethod database-sequence-last (sequence-name database)
  89   (without-interrupts
  90    (caar (database-query
  91           (concatenate 'string "SELECT last_value FROM "
  92                        (%sequence-name-to-table sequence-name database))
  93           database :auto nil))))