[elephant-cvs] CVS elephant/src/db-bdb

[ieslick]

Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv4428/src/db-bdb

Modified Files:
	bdb-controller.lisp berkeley-db.lisp libberkeley-db.c 
Added Files:
	bdb-symbol-tables.lisp 
Log Message:
Added missing file; Henrik's fixes to ele-bdb and clsql cursor-pset

--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp	2006/12/16 19:35:10	1.14
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp	2007/01/19 21:03:29	1.15
@@ -57,16 +57,6 @@
 	 (string t)
 	 (otherwise nil))))
 
-(defmethod controller-version ((sc store-controller))
-  (let ((version (controller-version sc)))
-    (if version version
-	(let ((path (make-pathname :name "VERSION" :defaults (second (controller-spec sc)))))
-	  (if (probe-file path)
-	      (with-open-file (stream path :direction :input)
-		(read stream))
-	      (with-open-file (stream path :direction :output)
-		(write *elephant-code-version* :stream stream)))))))
-
 ;;
 ;; Open/close     
 ;;
--- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp	2006/11/11 18:43:31	1.1
+++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp	2007/01/19 21:03:29	1.2
@@ -1673,10 +1673,11 @@
   :returning :int)
 
 (def-function ("db_set_lisp_compare" %db-set-lisp-compare)
-    ((db :pointer-void))
+    ((db :pointer-void)
+     (version :int))
   :returning :int)
 
-(wrap-errno db-set-lisp-compare (db) :documentation 
+(wrap-errno db-set-lisp-compare (db version) :documentation 
 "Sets the Btree comparision function to a hand-cooked
 function for Elephant to compare lisp values.")
 
@@ -1686,10 +1687,11 @@
   :returning :int)
 
 (def-function ("db_set_lisp_dup_compare" %db-set-lisp-dup-compare)
-    ((db :pointer-void))
+    ((db :pointer-void)
+     (version :int))
   :returning :int)
 
-(wrap-errno db-set-lisp-dup-compare (db) :documentation 
+(wrap-errno db-set-lisp-dup-compare (db version) :documentation 
 "Sets the duplicate comparision function to a hand-cooked
 function for Elephant to compare lisp values.")
 
--- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c	2007/01/16 18:02:27	1.3
+++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c	2007/01/19 21:03:29	1.4
@@ -873,8 +873,8 @@
 void db_multiple_key_next(void *pointer, DBT *data,
 			  unsigned char **key, u_int32_t *ret_key_size,
 			  unsigned char **result, u_int32_t *result_size) {
-  DB_MULTIPLE_KEY_NEXT(pointer, data, 
-		       *key, *ret_key_size, 
+  DB_MULTIPLE_KEY_NEXT(pointer, data,
+		       *key, *ret_key_size,
 		       *result, *result_size);
 }
 

--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-symbol-tables.lisp	2007/01/19 21:03:30	NONE
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-symbol-tables.lisp	2007/01/19 21:03:30	1.1
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; controller.lisp -- Lisp interface to a Berkeley DB store
;;; 
;;; Initial version 8/26/2004 by Ben Lee
;;; <blee at common-lisp.net>
;;; 
;;; part of
;;;
;;; Elephant: an object-oriented database for Common Lisp
;;;
;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee
;;; <ablumberg at common-lisp.net> <blee at common-lisp.net>
;;;
;;; Elephant 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 :db-bdb)

(defmethod lookup-persistent-symbol-id ((sc bdb-store-controller) symbol)
  "Look up and create id association for symbol"
  (with-buffer-streams (keybuf valbuf)
    (buffer-write-int *symbol-to-id-table-oid* keybuf)
    (serialize-symbol-complete symbol keybuf)
    (let ((buf (db-get-key-buffered (controller-btrees sc)
				    keybuf valbuf)))
      (if buf (values (buffer-read-int buf) T)
	  (values (create-persistent-symbol sc symbol keybuf valbuf) t)))))

(defun create-persistent-symbol (sc symbol keybuf valbuf)
  "Takes an symbol->id table + symbol keybuf, allocates an ID and updates
   the persistent tables."
  (reset-buffer-stream valbuf) ;; Just to avoid any contamination
;;  (with-transaction (:txn-nosync t :dirty-read t) 
  (format t "getting next symid")
  (let ((id (next-symid sc))) ;; allocate a new unique id
    ;; Update symbol->id table
    (format t "Writing sym->id: ~A -> ~A~%" symbol id)
    (buffer-write-int id valbuf)
    (format t "Putting id into table location~%")
    (db-put-buffered (controller-btrees sc) keybuf valbuf
		     :auto-commit *auto-commit*)
    ;; Write id->symbol table
    (reset-buffer-stream keybuf)
    (reset-buffer-stream valbuf)
    (format t "Writing id->sym: ~A -> ~A~%" id symbol)
    (buffer-write-int *id-to-symbol-table-oid* keybuf)
    (buffer-write-int id keybuf)
    (serialize-symbol-complete symbol valbuf)
    (db-put-buffered (controller-btrees sc) keybuf valbuf
		     :auto-commit *auto-commit*)
    id)
;;    )
  )


(defmethod lookup-persistent-symbol ((sc bdb-store-controller) id)
  "Lookup the ID associated with a symbol"
  (with-buffer-streams (keybuf valbuf)
    (format t "Looking up: ~A~%" id)
    (buffer-write-int *id-to-symbol-table-oid* keybuf)
    (buffer-write-int id keybuf)
    (format t "Get for id: ~A~%" id)
    (let ((buf (db-get-key-buffered (controller-btrees sc)
				    keybuf valbuf)))
      (format t "Got buf: ~A~%" buf)
      (if buf (values (deserialize buf sc) T)
	  (error "Invalid ID - no persistent mapping for ID")))))

;;
;; Stress test
;;

(defun stress-test (iters syms)
    (loop for i fixnum from 0 upto iters do
	 (format t "Iteration ~A~%" i)
;;	 (with-transaction ()
;;	   (print *current-transaction*)
	   (loop for i fixnum from 0 upto (length syms) do
		(add-to-root (nth i syms) (nth i syms)))))

(defun make-syms (num &aux list)
  (loop for i fixnum from 0 below num do
       (let* ((str (format nil "test~A" i))
	      (sym (intern str)))
	 (push sym list)))
  (nreverse list))