opening it up with Common Lisp

Favorite weblogs

Lisp Related

Bill Clementson

Finding Lisp

Lemonodor

Lispmeister.com

Planet Lisp

Politics

Orcinus

Talking Points Memo

This Modern World

Working for Change

Other home

Polliblog

Recent Readings

Book review: Darwinia
Reviewed: Friday, August 11, 2006

Summer reading: Spin
Reviewed: Saturday, August 5, 2006

Runner
Reviewed: Tuesday, July 18, 2006

the Omnivoire's Delimma
Reviewed: Wednesday, July 12, 2006

the Golem's Eye
Reviewed: Wednesday, May 31, 2006





tinderbox
 width=

CLSQL and me: I feel so Microsoft Access ugly
Tuesday, May 30, 2006

I did a bunch of database stuff back when SQL 92 was exciting. I used early PC database systems like dBase IV, Foxpro, Borland's Paradox, and Microsoft's Access. Since auto-increment columns hadn't reached down to those trenches, I ended up doing the old "keep track of the maximum key in a separate key table yourself" trick. Not fun, but effective -- well, it works.

Today, I was messing with CLSQL (connecting to SQLite) and felt stymied trying to correctly get my primary keys to work. In the hopes that a wiser soul will feel my pain, here is what I did.

(def-view-class primary-key-mixin ()
  ((id :db-kind :base :type integer
       :db-constraints (:primary-key)
       :reader id :initarg :id)
   (table-name :db-kind :virtual 
	       :reader table-name
	       :initarg :table-name)))

(defmethod initialize-instance :after ((instance primary-key-mixin) &key)
  (unless (and (slot-boundp instance 'id) (id instance))
    (setf (slot-value instance 'id) (find-next-id (table-name instance)))))
					
(def-view-class sample-table (primary-key-mixin)
  ((name :db-kind :base :type (varchar 40)
	 :db-constraints (:unique :not-null)
	 :accessor name :initarg :name))
  (:default-initargs
      :table-name "managed-system"))

(def-view-class primary-key ()
  ((table-name :db-kind :base 
	       :db-constraints :primary-key
	       :type (string 20)
	       :accessor table-name
	       :initarg :table-name)
   (max-key :db-kind :base :type integer
	    :accessor max-key
	    :initarg :max-key
	    :initform 0)))

(defun recreate-tables (&key really?)
  (unless really?
    (cerror "Yes, really!" "Do you really want to trash the tables and start fresh?"))
  (clsql:drop-table [primary-key] :if-does-not-exist :ignore)
  (create-view-from-class 'primary-key)
  (clsql:drop-table [sample-table] :if-does-not-exist :ignore)
  (create-view-from-class 'sample-table)
  )

(defun find-next-id (table-name)
  (with-transaction nil
    (bind ((exists?
	    (select [max-key] 
		    :from [primary-key]
		    :where [= [table-name] table-name]
		    :flatp t))
           (next-key (if exists? (1+ (first exists?)) 0)))
      (if exists?
        (update-records [primary-key]
			:av-pairs `(([max-key] ,next-key))
			:where [= [table-name] table-name])
        (insert-records
         :into [primary-key]
         :av-pairs `(([table-name] ,table-name) ([max-key] ,next-key))))
      (values next-key))))

This defines two view-classes (and the recreate-tables function makes tables out them). The primary-key table keeps track of the highest key assigned so far; the primary-key-mixin uses it to assign keys as necessary. Since instances can be created and not added to the database, it's quite likely that we'll have gaps but that's not a big deal. This let's me execute code like:

? (setf *s* (make-instance 'sample-table :name "Gary"))
#<MANAGED-SYSTEM #x88C5F8E>
? (update-records-from-instance *s*)
; no value
? (setf *s* (make-instance 'sample-table :name "Wendy"))
#<MANAGED-SYSTEM #x88C5F9A>
? (update-records-from-instance *s*)
; no value
? (select [*] :from [managed-system])
(("cl-containers" 0) ("moptilities" 1))
("NAME" "ID")

Which, while not really exciting, is at least moderately painless. Aside from the fact that doing all of this key management myself strikes me as unbearably last decade (not to mention error prone and probably non-union), I figure that there must be a better way.

Any suggestions?


|

Home | About | Quotes | Recent | Archives

Copyright -- Gary Warren King, 2004 - 2006