From rread at common-lisp.net Wed Mar 1 18:57:34 2006 From: rread at common-lisp.net (rread) Date: Wed, 1 Mar 2006 13:57:34 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/db-clsql Message-ID: <20060301185734.6FBAD4A082@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv22716/src/db-clsql Modified Files: sql-controller.lisp Log Message: Workaround for SBCL 0.9.9 weirdness and making the tests repeatably runnable. --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/02/25 20:53:57 1.8 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/03/01 18:57:34 1.9 @@ -131,7 +131,8 @@ (remhash index-name (indices-cache bt)) (let ((indices (indices bt))) (remhash index-name indices) - (setf (indices bt) indices))) + (setf (indices bt) indices)) + ) (defmethod add-index ((bt sql-indexed-btree) &key index-name key-form populate) (let* ((sc (get-con bt)) From rread at common-lisp.net Wed Mar 1 18:57:34 2006 From: rread at common-lisp.net (rread) Date: Wed, 1 Mar 2006 13:57:34 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20060301185734.B72FA4A082@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv22716/src/elephant Modified Files: classes.lisp classindex-utils.lisp classindex.lisp elephant.lisp serializer.lisp Log Message: Workaround for SBCL 0.9.9 weirdness and making the tests repeatably runnable. --- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2006/02/25 20:53:57 1.7 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2006/03/01 18:57:34 1.8 @@ -130,6 +130,7 @@ ;; situation where we write the class or index page that we are currently reading ;; via a cursor without going through the cursor abstraction. There has to be a ;; better way to do this. + (when (and (indexed class) (not from-oid)) (let ((class-index (find-class-index class))) (when class-index --- /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp 2006/02/19 04:53:00 1.1 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp 2006/03/01 18:57:34 1.2 @@ -139,5 +139,29 @@ (disable-class-indexing name) (flush-instance-cache *store-controller*) (setf (find-class name) nil))) - - + + +;; Rob created this just for some debugging. +;; It seesm theoretically possible that we could make +;; a function that fully checks the consinstency of the index; +;; that is, that the indexed classes indeed exist in the store. +(defun dump-class-index (c) + (let ((idx (find-class-index c))) + (dump-btree + idx) + ) +) +(defun report-indexed-classes (&key (class nil) (sc *store-controller*)) + (format t "indexed-classes:~%") + (let ((bt (controller-class-root sc))) + (declare (type btree bt)) + (dump-btree bt) + (if class + (dump-class-index class) + (map-btree + #'(lambda (k v) + (dump-class-index k) + ) + bt)) + ) + ) --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/02/25 20:53:57 1.5 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/03/01 18:57:34 1.6 @@ -98,6 +98,9 @@ (defmethod find-class-index ((class-name symbol) &key (sc *store-controller*) (errorp t)) (find-class-index (find-class class-name) :sc sc :errorp errorp)) +(defmethod class-indexedp-by-name ((class-name symbol) &key (sc *store-controller*) (errorp t)) + (get-value class-name (controller-class-root sc))) + (defmethod find-class-index ((class persistent-metaclass) &key (sc *store-controller*) (errorp t)) (ensure-finalized class) (if (not (indexed class)) --- /project/elephant/cvsroot/elephant/src/elephant/elephant.lisp 2006/02/21 19:40:03 1.2 +++ /project/elephant/cvsroot/elephant/src/elephant/elephant.lisp 2006/03/01 18:57:34 1.3 @@ -70,6 +70,8 @@ #:add-class-slot-index #:remove-class-slot-index #:add-class-derived-index #:remove-class-derived-index #:describe-db-class-index + #:report-indexed-classes + #:class-indexedp-by-name ;; Low level cursor API #:make-inverted-cursor #:make-class-cursor --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/02/19 04:53:00 1.1 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/03/01 18:57:34 1.2 @@ -69,7 +69,7 @@ (labels ((%serialize (frob) (declare (optimize (speed 3) (safety 0))) - (etypecase frob + (typecase frob (fixnum (buffer-write-byte +fixnum+ bs) (buffer-write-int frob bs)) @@ -115,7 +115,17 @@ (persistent (buffer-write-byte +persistent+ bs) (buffer-write-int (oid frob) bs) - (%serialize (type-of frob))) + ;; This circumlocution is necessitated by + ;; an apparent bug in SBCL 9.9 --- type-of sometimes + ;; does NOT return the "proper name" of the class as the + ;; CLHS says it should, but gives the class object itself, + ;; which cannot be directly serialized.... + (let ((tp (type-of frob))) + #+(or sbcl) + (if (not (symbolp tp)) + (setf tp (class-name (class-of frob)))) + (%serialize tp)) + ) #-(and :lispworks (or :win32 :linux)) (single-float (buffer-write-byte +single-float+ bs) From rread at common-lisp.net Wed Mar 1 18:57:34 2006 From: rread at common-lisp.net (rread) Date: Wed, 1 Mar 2006 13:57:34 -0500 (EST) Subject: [elephant-cvs] CVS elephant/tests Message-ID: <20060301185734.E7B564C001@common-lisp.net> Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv22716/tests Modified Files: testindexing.lisp Log Message: Workaround for SBCL 0.9.9 weirdness and making the tests repeatably runnable. --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/27 16:49:49 1.14 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/03/01 18:57:34 1.15 @@ -24,51 +24,83 @@ (defvar inst2) (defvar inst3) -(deftest indexing-basic-trivial +(deftest disable-class-indexing-test (progn - (disable-class-indexing 'idx-one :sc *store-controller* :errorp nil) + (when (find-class 'idx-one nil) + (disable-class-indexing 'idx-one :errorp nil) + (setf (find-class 'idx-one) nil)) + + (defclass idx-one () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) + (:metaclass persistent-metaclass)) + + + (disable-class-indexing 'idx-one :errorp nil) + (disable-class-indexing 'idx-one :errorp nil) (setf (find-class 'idx-one) nil) + t) +t) + +(deftest indexing-basic-trivial + (progn + (when (class-indexedp-by-name 'idx-one) + (disable-class-indexing 'idx-one :errorp nil) + (setf (find-class 'idx-one) nil)) (defclass idx-one () ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) (:metaclass persistent-metaclass)) - (length (get-instances-by-class 'idx-one)) + (defmethod print-object ((obj idx-one) stream) + (if (slot-boundp obj 'slot1) + (format stream "slot1 = ~A~%" (slot1 obj)) + (format stream "slot1 unbound~&") + )) (with-transaction (:store-controller *store-controller*) - (setq inst1 (make-instance 'idx-one :slot1 1 :sc *store-controller*))) + (setq inst1 (make-instance 'idx-one :slot1 101 :sc *store-controller*)) + (setq inst1 (make-instance 'idx-one :slot1 101 :sc *store-controller*)) + ) ;; The real problem is that this call doesn't seem to see it, and the make-instance ;; doesn't seem to think it needs to write anything! (length (get-instances-by-class 'idx-one)) - (length (get-instances-by-class 'idx-one)) + (disable-class-indexing 'idx-one :sc *store-controller* :errorp nil) + (setf (find-class 'idx-one) nil) + (signals-error (get-instances-by-class 'idx-one)) ) - 1) + t) ;; put list of objects, retrieve on value, range and by class (deftest indexing-basic - (progn + (let ((n 105)) ;;(format t "Global vars:~%") ;;(format t "~%basic store: ~A ~A~%" *store-controller* (elephant::controller-spec *store-controller*)) ;; (format t "auto-commit: ~A~%" *auto-commit*) - (when (find-class 'idx-one nil) + (when (class-indexedp-by-name 'idx-one ) (disable-class-indexing 'idx-one :errorp nil) (setf (find-class 'idx-one nil) nil)) (defclass idx-one () ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) (:metaclass persistent-metaclass)) + (defmethod print-object ((obj idx-one) stream) + (if (slot-boundp obj 'slot1) + (format stream "slot1 = ~A~%" (slot1 obj)) + (format stream "slot1 unbound~&") + )) (progn (with-transaction (:store-controller *store-controller*) - (setq inst1 (make-instance 'idx-one :slot1 40 :sc *store-controller*)) - (setq inst2 (make-instance 'idx-one :slot1 40 :sc *store-controller*)) - (setq inst3 (make-instance 'idx-one :slot1 41 :sc *store-controller*))) + (setq inst1 (make-instance 'idx-one :slot1 n :sc *store-controller*)) + (setq inst2 (make-instance 'idx-one :slot1 n :sc *store-controller*)) + (setq inst3 (make-instance 'idx-one :slot1 (+ 1 n) :sc *store-controller*))) ;; (format t "Starting gathering of instances~%") - (values (length (get-instances-by-class 'idx-one)) - (length (get-instances-by-value 'idx-one 'slot1 40)) - (length (get-instances-by-value 'idx-one 'slot1 41)) - (equal (first (get-instances-by-value 'idx-one 'slot1 41)) inst3) - (length (get-instances-by-range 'idx-one 'slot1 40 41))))) + (values (length (get-instances-by-class 'idx-one)) + (length (get-instances-by-value 'idx-one 'slot1 n)) + (length (get-instances-by-value 'idx-one 'slot1 (+ 1 n))) + (equal (first (get-instances-by-value 'idx-one 'slot1 (+ 1 n))) inst3) + (length (get-instances-by-range 'idx-one 'slot1 n (+ 1 n)))) + )) 3 2 1 t 3) ;; test inherited slots @@ -76,11 +108,11 @@ (progn ;; (format t "inherit store: ~A ~A~%" *store-controller* (controller-path *store-controller*)) - (when (find-class 'idx-two nil) + (when (class-indexedp-by-name 'idx-two ) (disable-class-indexing 'idx-two :sc *store-controller* :errorp nil) (setf (find-class 'idx-two) nil)) - (when (find-class 'idx-three nil) + (when (class-indexedp-by-name 'idx-three ) (disable-class-indexing 'idx-three :sc *store-controller* :errorp nil) (setf (find-class 'idx-three) nil)) @@ -120,13 +152,17 @@ (deftest indexing-range (progn ;; (format t "range store: ~A ~A~%" *store-controller* (controller-path *store-controller*)) - (when (find-class 'idx-four nil) + (when (class-indexedp-by-name 'idx-four ) + (defclass idx-four () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) + (:metaclass persistent-metaclass)) (disable-class-indexing 'idx-four :errorp nil) (setf (find-class 'idx-four nil) nil)) - - (defclass idx-four () + + (defclass idx-four () ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) (:metaclass persistent-metaclass)) + (defun make-idx-four (val) (make-instance 'idx-four :slot1 val)) @@ -153,9 +189,9 @@ (deftest indexing-wipe-index (progn - (when (find-class 'idx-five-del nil) - (disable-class-indexing 'idx-five :errorp nil) - (setf (find-class 'idx-five) nil)) + (when (class-indexedp-by-name 'idx-five-del ) + (disable-class-indexing 'idx-five-del :errorp nil) + (setf (find-class 'idx-five-del) nil)) (defclass idx-five-del () ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) @@ -178,7 +214,12 @@ (deftest indexing-reconnect-db (progn - (when (find-class 'idx-five nil) + (when (class-indexedp-by-name 'idx-five) + (defclass idx-five () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t) + (slot2 :initarg :slot2 :initform 2 :accessor slot2) + (slot3 :initarg :slot3 :initform 3 :accessor slot3 :index t)) + (:metaclass persistent-metaclass)) (disable-class-indexing 'idx-five :errorp nil) (setf (find-class 'idx-five) nil)) @@ -215,10 +256,19 @@ (deftest indexing-change-class (progn - (when (find-class 'idx-six nil) + (when (class-indexedp-by-name 'idx-six) + (defclass idx-six () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t) + (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t)) + (:metaclass persistent-metaclass)) (disable-class-indexing 'idx-six :errorp nil) (setf (find-class 'idx-six) nil)) - (when (find-class 'idx-seven nil) + (when (class-indexedp-by-name 'idx-seven) + (defclass idx-seven () + ((slot1 :initarg :slot1 :initform 10 :accessor slot1 :index nil) + (slot3 :initarg :slot3 :initform 30 :accessor slot3 :index t) + (slot4 :initarg :slot4 :initform 40 :accessor slot4 :index t)) + (:metaclass persistent-metaclass)) (disable-class-indexing 'idx-seven :errorp nil) (setf (find-class 'idx-seven) nil)) @@ -265,7 +315,14 @@ (deftest indexing-redef-class (progn - (when (find-class 'idx-eight nil) + (when (class-indexedp-by-name 'idx-eight) + (defclass idx-eight () + ((slot1 :accessor slot1 :initarg :slot1 :index t) + (slot2 :accessor slot2 :initarg :slot2) + (slot3 :accessor slot3 :initarg :slot3 :transient t) + (slot4 :accessor slot4 :initarg :slot4 :index t) + (slot5 :accessor slot5 :initarg :slot5)) + (:metaclass persistent-metaclass)) (disable-class-indexing 'idx-eight :errorp nil) (setf (find-class 'idx-eight nil) nil)) From rread at common-lisp.net Thu Mar 2 14:44:49 2006 From: rread at common-lisp.net (rread) Date: Thu, 2 Mar 2006 09:44:49 -0500 (EST) Subject: [elephant-cvs] CVS elephant/doc Message-ID: <20060302144449.0540F7800C@common-lisp.net> Update of /project/elephant/cvsroot/elephant/doc In directory clnet:/tmp/cvs-serv6190 Modified Files: copying.texinfo elephant.texinfo intro.texinfo tutorial.texinfo Log Message: An attempt to improve the documentation, especially around class indexing. --- /project/elephant/cvsroot/elephant/doc/copying.texinfo 2004/09/19 17:44:43 1.1 +++ /project/elephant/cvsroot/elephant/doc/copying.texinfo 2006/03/02 14:44:49 1.2 @@ -11,342 +11,27 @@ Homepage: @uref{http://www.common-lisp.net/project/elephant} -Copyright (c) 2004 by Andrew Blumberg and Ben Lee +Elephant users are granted the rights to distribute and use this software +as governed by the terms of the Lisp Lesser GNU Public License + at uref{http://opensource.franz.com/preamble.html}, also known as the LLGPL. -This program is released under the following license -("GPL"). For differenct licensing terms, contact the -copyright holders. -Portions of this program (namely the C unicode string -sorter) are derived from IBM's @b{ICU}: - at uref{http://oss.software.ibm.com/icu/} +Copyrights include: -whose copyright and license follows the GPL below. +Copyright (c) 2004 by Andrew Blumberg and Ben Lee -The GNU General Public License (GPL) -Version 2, June 1991 +Copyright (c) 2006 by Ian Eslick -Copyright (C) 1989, 1991 Free Software Foundation, Inc. -59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +Copyright (c) 2005,2006 by Robert L. Read -Everyone is permitted to copy and distribute verbatim copies -of this license document, but changing it is not allowed. -Preamble - -The licenses for most software are designed to take away -your freedom to share and change it. By contrast, the GNU -General Public License is intended to guarantee your freedom -to share and change free software--to make sure the software -is free for all its users. This General Public License -applies to most of the Free Software Foundation's software -and to any other program whose authors commit to using -it. (Some other Free Software Foundation software is covered -by the GNU Library General Public License instead.) You can -apply it to your programs, too. - -When we speak of free software, we are referring to freedom, -not price. Our General Public Licenses are designed to make -sure that you have the freedom to distribute copies of free -software (and charge for this service if you wish), that you -receive source code or can get it if you want it, that you -can change the software or use pieces of it in new free -programs; and that you know you can do these things. - -To protect your rights, we need to make restrictions that -forbid anyone to deny you these rights or to ask you to -surrender the rights. These restrictions translate to -certain responsibilities for you if you distribute copies of -the software, or if you modify it. - -For example, if you distribute copies of such a program, -whether gratis or for a fee, you must give the recipients -all the rights that you have. You must make sure that they, -too, receive or can get the source code. And you must show -them these terms so they know their rights. - -We protect your rights with two steps: (1) copyright the -software, and (2) offer you this license which gives you -legal permission to copy, distribute and/or modify the -software. - -Also, for each author's protection and ours, we want to make -certain that everyone understands that there is no warranty -for this free software. If the software is modified by -someone else and passed on, we want its recipients to know -that what they have is not the original, so that any -problems introduced by others will not reflect on the -original authors' reputations. - -Finally, any free program is threatened constantly by -software patents. We wish to avoid the danger that -redistributors of a free program will individually obtain -patent licenses, in effect making the program -proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not -licensed at all. - -The precise terms and conditions for copying, distribution -and modification follow. - -TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - -0. This License applies to any program or other work which -contains a notice placed by the copyright holder saying it -may be distributed under the terms of this General Public -License. The "Program", below, refers to any such program or -work, and a "work based on the Program" means either the -Program or any derivative work under copyright law: that is -to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into -another language. (Hereinafter, translation is included -without limitation in the term "modification".) Each -licensee is addressed as "you". - -Activities other than copying, distribution and modification -are not covered by this License; they are outside its -scope. The act of running the Program is not restricted, and -the output from the Program is covered only if its contents -constitute a work based on the Program (independent of -having been made by running the Program). Whether that is -true depends on what the Program does. - -1. You may copy and distribute verbatim copies of the -Program's source code as you receive it, in any medium, -provided that you conspicuously and appropriately publish on -each copy an appropriate copyright notice and disclaimer of -warranty; keep intact all the notices that refer to this -License and to the absence of any warranty; and give any -other recipients of the Program a copy of this License along -with the Program. - -You may charge a fee for the physical act of transferring a -copy, and you may at your option offer warranty protection -in exchange for a fee. - -2. You may modify your copy or copies of the Program or any -portion of it, thus forming a work based on the Program, and -copy and distribute such modifications or work under the -terms of Section 1 above, provided that you also meet all of -these conditions: - - a) You must cause the modified files to carry prominent -notices stating that you changed the files and the date of -any change. - - b) You must cause any work that you distribute or -publish, that in whole or in part contains or is derived -from the Program or any part thereof, to be licensed as a -whole at no charge to all third parties under the terms of -this License. - - c) If the modified program normally reads commands -interactively when run, you must cause it, when started -running for such interactive use in the most ordinary way, -to print or display an announcement including an appropriate -copyright notice and a notice that there is no warranty (or -else, saying that you provide a warranty) and that users may -redistribute the program under these conditions, and telling -the user how to view a copy of this License. (Exception: if -the Program itself is interactive but does not normally -print such an announcement, your work based on the Program -is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the -Program, and can be reasonably considered independent and -separate works in themselves, then this License, and its -terms, do not apply to those sections when you distribute -them as separate works. But when you distribute the same -sections as part of a whole which is a work based on the -Program, the distribution of the whole must be on the terms -of this License, whose permissions for other licensees -extend to the entire whole, and thus to each and every part -regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights -or contest your rights to work written entirely by you; -rather, the intent is to exercise the right to control the -distribution of derivative or collective works based on the -Program. - -In addition, mere aggregation of another work not based on -the Program with the Program (or with a work based on the -Program) on a volume of a storage or distribution medium -does not bring the other work under the scope of this -License. - -3. You may copy and distribute the Program (or a work based -on it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you -also do one of the following: - - a) Accompany it with the complete corresponding -machine-readable source code, which must be distributed -under the terms of Sections 1 and 2 above on a medium -customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least -three years, to give any third party, for a charge no more -than your cost of physically performing source distribution, -a complete machine-readable copy of the corresponding source -code, to be distributed under the terms of Sections 1 and 2 -above on a medium customarily used for software interchange; -or, - - c) Accompany it with the information you received as to -the offer to distribute corresponding source code. (This -alternative is allowed only for noncommercial distribution -and only if you received the program in object code or -executable form with such an offer, in accord with -Subsection b above.) - -The source code for a work means the preferred form of the -work for making modifications to it. For an executable work, -complete source code means all the source code for all -modules it contains, plus any associated interface -definition files, plus the scripts used to control -compilation and installation of the executable. However, as -a special exception, the source code distributed need not -include anything that is normally distributed (in either -source or binary form) with the major components (compiler, -kernel, and so on) of the operating system on which the -executable runs, unless that component itself accompanies -the executable. - -If distribution of executable or object code is made by -offering access to copy from a designated place, then -offering equivalent access to copy the source code from the -same place counts as distribution of the source code, even -though third parties are not compelled to copy the source -along with the object code. - -4. You may not copy, modify, sublicense, or distribute the -Program except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense or distribute -the Program is void, and will automatically terminate your -rights under this License. However, parties who have -received copies, or rights, from you under this License will -not have their licenses terminated so long as such parties -remain in full compliance. - -5. You are not required to accept this License, since you -have not signed it. However, nothing else grants you -permission to modify or distribute the Program or its -derivative works. These actions are prohibited by law if you -do not accept this License. Therefore, by modifying or -distributing the Program (or any work based on the Program), -you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or -modifying the Program or works based on it. - -6. Each time you redistribute the Program (or any work based -on the Program), the recipient automatically receives a -license from the original licensor to copy, distribute or -modify the Program subject to these terms and -conditions. You may not impose any further restrictions on -the recipients' exercise of the rights granted herein. You -are not responsible for enforcing compliance by third -parties to this License. - -7. If, as a consequence of a court judgment or allegation of -patent infringement or for any other reason (not limited to -patent issues), conditions are imposed on you (whether by -court order, agreement or otherwise) that contradict the -conditions of this License, they do not excuse you from the -conditions of this License. If you cannot distribute so as -to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a -consequence you may not distribute the Program at all. For -example, if a patent license would not permit royalty-free -redistribution of the Program by all those who receive -copies directly or indirectly through you, then the only way -you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or -unenforceable under any particular circumstance, the balance -of the section is intended to apply and the section as a -whole is intended to apply in other circumstances. - -It is not the purpose of this section to induce you to -infringe any patents or other property right claims or to -contest validity of any such claims; this section has the -sole purpose of protecting the integrity of the free -software distribution system, which is implemented by public -license practices. Many people have made generous -contributions to the wide range of software distributed -through that system in reliance on consistent application of -that system; it is up to the author/donor to decide if he or -she is willing to distribute software through any other -system and a licensee cannot impose that choice. - -This section is intended to make thoroughly clear what is -believed to be a consequence of the rest of this License. - -8. If the distribution and/or use of the Program is -restricted in certain countries either by patents or by -copyrighted interfaces, the original copyright holder who -places the Program under this License may add an explicit -geographical distribution limitation excluding those -countries, so that distribution is permitted only in or -among countries not thus excluded. In such case, this -License incorporates the limitation as if written in the -body of this License. - -9. The Free Software Foundation may publish revised and/or -new versions of the General Public License from time to -time. Such new versions will be similar in spirit to the -present version, but may differ in detail to address new -problems or concerns. - -Each version is given a distinguishing version number. If -the Program specifies a version number of this License which -applies to it and "any later version", you have the option -of following the terms and conditions either of that version -or of any later version published by the Free Software -Foundation. If the Program does not specify a version number -of this License, you may choose any version ever published -by the Free Software Foundation. - -10. If you wish to incorporate parts of the Program into -other free programs whose distribution conditions are -different, write to the author to ask for permission. For -software which is copyrighted by the Free Software -Foundation, write to the Free Software Foundation; we -sometimes make exceptions for this. Our decision will be -guided by the two goals of preserving the free status of all -derivatives of our free software and of promoting the -sharing and reuse of software generally. - -NO WARRANTY - -11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS -NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE -COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM -"AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR -IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE -OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE -DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - -12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED -TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY -WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED -ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, -SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF -THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT -LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR -LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE -PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH -HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. +Portions of this program (namely the C unicode string +sorter) are derived from IBM's @b{ICU}: -END OF TERMS AND CONDITIONS + at uref{http://oss.software.ibm.com/icu/} + +whose copyright and license follows the GPL below. --- /project/elephant/cvsroot/elephant/doc/elephant.texinfo 2006/01/24 20:37:43 1.3 +++ /project/elephant/cvsroot/elephant/doc/elephant.texinfo 2006/03/02 14:44:49 1.4 @@ -6,6 +6,7 @@ @copying Copyright @copyright{} 2004 Ben Lee and Andrew Blumberg. +Copyright @copyright{} 2006 Robert L. Read. @quotation Permission is granted to copy, distribute and/or modify this document @@ -18,7 +19,7 @@ @titlepage @title Elephant User Manual - at subtitle Elephant version 0.2 + at subtitle Elephant version 0.6 @author Ben Lee @c The following two commands --- /project/elephant/cvsroot/elephant/doc/intro.texinfo 2005/11/23 18:14:11 1.2 +++ /project/elephant/cvsroot/elephant/doc/intro.texinfo 2006/03/02 14:44:49 1.3 @@ -7,17 +7,16 @@ Elephant is an object database for Common Lisp. It supports storing CLOS objects and most lisp primitives, and access to -BTrees. It uses Sleepycat / Berkeley DB, a +BTrees. It can use the Sleepycat / Berkeley DB, a widely-distributed embedded database; many unix systems have it installed by default. Sleepycat is server-less, ACID compliant, transactional, process and thread safe, and fast relative to relational databases; hopefully Elephant inherits these properties. -This release, Elephant 0.3, also provieds support for -relational backends. It has been tested with Postgres and SQLite 3. -It is back-compatible with any code that ran against previous -versions of Elephant, but also supports simultaneous multi-repository +It also provieds support for relational backends. +It has been tested with Postgres and SQLite 3. +It supports simultaneous multi-repository operation and convenient migration of data between repositories. This hopefully allows decisions about the prefered back-end storage mechanism to be delayed and changed, even after @@ -41,8 +40,14 @@ @item Performance: leverage Sleepycat performance and reliability. In addition to fast concurrent / transactional modes, elephant will (eventually) offer an accellerated single-user mode. + + at item License Flexibility: Elephant is released under the LLGPL. +Because it supports multiple implementation of the backend, one +can choose a backend with licensing and other features appropriate to your needs. @end itemize + + Join the Elephant mailing lists to ask your questions and receive updates. They're on the Elephant website at --- /project/elephant/cvsroot/elephant/doc/tutorial.texinfo 2006/01/24 20:37:43 1.4 +++ /project/elephant/cvsroot/elephant/doc/tutorial.texinfo 2006/03/02 14:44:49 1.5 @@ -8,6 +8,7 @@ @menu * Preliminaries:: Some general remarks. * Getting Started:: Accessing a store. +* Running the Tests:: Gaining confidence. * The Root:: Staying alive. * Serialization:: Lisp -> (char *). * Persistent Classes:: CLOS the Elephant way. @@ -15,6 +16,7 @@ * Using Transactions:: Using ACID. * Using BTrees:: Storing lots of things. * Using Cursors:: Tranversing BTrees. +* Class Indices:: Speed and Convenience. * Secondary Indices:: by any other name... * The Store Controller:: behind the curtain. * Threading:: Playing nice with others. @@ -25,51 +27,122 @@ @comment node-name, next, previous, up @section Preliminaries +Elephant isa Common Lisp OODB. It solves the problem of +making Lisp data persistent. It does this through two mechanisms: +a very simple API, and the ability to declare a CLOS class to be +persistent. It offers simple and powerful functional indexes +as well as convenient slot-based indexes. It represents + Elephant is an Common Lisp OODB, as opposed to a language-neutral -(e.g. language-unspecific) RDBMS. This means it can store most Lisp -values without programmer intervention, special syntax or laborious +(e.g. language-unspecific) RDBMS. This means it can store and efficient index +most Lisp values without programmer intervention, special syntax or laborious conversion. In that way it is similar to prevalence, but it is actually a database: it is not in-memory (though it can be.) When someone says "database," most people think of SQL RDBMSs (oracle, -postgresql, mysql). Elephant uses Berekely DB (Sleepycat) which is -much simpler: there is no special SQL relational syntax, just access -to BTrees and other datatypes. It is a C library, not a server. On +postgresql, mysql). Elephant uses RDBMSs or Berekely DB (Sleepycat) as +a data repository, but simply uses LISP as its data manipulation system. +Unlike systems such as Hibernate for Java, the user does not need to +construct or worry about a mapping from the object space into +the database. Elephant is a very convenient system for the +programmer. + +Elephant can employ several different data repositories as a ``back-ends''. +It also supports easy migration of data between these repositories, +which allows the user to flexibly choose, or to late-bind, which +repository will use at a particular point in time. + + +Berkeley DB/Sleepycat is a very fast database that is well-matched +to Elephant. +Berkeley DB is a C library, not a server. On the other hand it is quite robust, and has many features, like transactions and replication. While you don't need to understand -Sleepycat to use Elephant, reading the docs will certainly help you. -They can be found at @uref{http://www.sleepycat.com}. +a specific backend to use Elephant, reading the docs will certainly help you. +For the Sleepycat backend, they can be found at @uref{http://www.sleepycat.com}. - at node Getting Started - at comment node-name, next, previous, up - at section Getting Started +Elephant can also employ relational databases, based on the excellent CL-SQL +package. It has been tested with Postgres and SQLite3, and can probably easily +work with others. -Make a directory to put your database store in. (This is called the -environment in Sleepycat terminology.) That's all you need to set up -your store! We'll assume in this tutorial you created a folder - at code{testdb} in the current directory. + at node Running the Tests + at comment node-name, next, previous, up + at section Running the Tests -Assuming you've managed to install Elephant properly, and -are using a BerkeleyDB installation. +There are three files in the directory @code{tests} that make running +the automated tests particularly easy. @code{BerkeleyDB-tests.lisp} is +for running against the BerkeleyDB backend, and @code{SQLDB-tests.lisp} is +for running agains the CL-SQL backend. @code{MigrationTests.lisp} is +for testing data migration functions, and can be used with either or both backends. +The normal way to execute the tests, following the instruction in the file + at code{INSTALL}, is to open a listener and execute the lines found in +one of these files, such as: @lisp -* (asdf:operate 'asdf:load-op :elephant) -* (asdf:operate 'asdf:load-op :ele-bdb) - at end lisp +(asdf:operate 'asdf:load-op :elephant-tests) -will load the relevant files. +(in-package "ELEPHANT-TESTS") + +(setf *default-spec* *testbdb-spec*) + +(do-backend-tests) + at end lisp +The SQL test file differs only in using a different ``controller spec'': + at lisp(setf *default-spec* *testpg-spec*) + at end lisp +These default parameters are set in @file{tests/elephant-tests.lisp}, +they will looks something like this in a default distribution: + at lisp +(:BDB "/home/read/projects/sql-back-end/elephant/tests/testdb/") + at end lisp +and for postgres: @lisp -* (use-package "ELE") +(:CLSQL (:POSTGRESQL "localhost.localdomain" "test" "postgres" "")) @end lisp -will make all the necessary symbols available. -To make your store available to Lisp, do + at node Getting Started + at comment node-name, next, previous, up + at section Getting Started + +In order to use Elephant, you have to have an open store controller. +To obtain an open store controller, you have to decide which back-end +you will use and properly install that back-end system. The actual +use of Elephant once you have an open store controller is almost +completely independent of what the actual back-end choice is; Elephant +attempts to abstract away all such details. + +The chapter ``SQL back-end'' has information about setting up a +SQL based backend; this tutorial will assume that you are using +Berkeley-DB as a backend. - at lisp -* (open-store "testdb") -=> # +Make a directory to put your database store in. (This is called the +environment in Sleepycat terminology.) That's all you need to set up +your store! We'll assume in this tutorial you created a folder + at code{testdb} in the current directory. + +It is strongly recommended that you run the automated tests @xref{Running the Tests} that +come with Elephant before you begin this tutorial; this takes less +than five minutes and if will give you both confidence and clarity +and your continued work. Since the default distribution comes +with a directory structure set up, this is actually the easiest +way to get started with Elephant before beginning this tutorial. +If the tests fail for you, the Elephant developers will help you +solve the problem, but will want to know the outcome of the tests +as a starting point. + +If you have run the tests successfully, you can just do: + at lisp +(open-store *default-spec*) + at end lisp +But if not you might have to set up your own controller specifier like this: + at lisp +(asdf:operate 'asdf:load-op :elephant) +(use-package "ELE") +(setf *testbdb-spec* +'(:BDB "/home/read/projects/sql-back-end/elephant/tests/testdb/")) +(open-store *testbdb-spec*) @end lisp When you're done with your session, don't forget to @@ -484,6 +557,89 @@ @code{map-btree} function, which functions analogously to the @code{maphash} CL function. + + at node Class Indices + at comment node-name, next, previous, up + at section Class Indices + +Class indices are a very convenient way of gaining the efficiency +that indexes provide. If a given object is most often sought by +the value of one of its slots, which is of course quite common, +it is convenient to define a class index on that slot, although +the same functionality can be gained in a more complicated way through +the use fo secondary indices. + +The file @file{tests/testindexing.lisp} provides many useful examples +of both declaring class indexes and using the API to seek objects using them. + +The following code from that file in the test ``indexing-range'' demonstrates +the convenience of a class indexes and the function ``get-instances-by-range''. +Note in the definiton of the ``slot1'' the keyword ``:index'' is used to +specify that this slot should be indexed. + + at lisp + (defclass idx-four () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) + (:metaclass persistent-metaclass)) + + + (defun make-idx-four (val) + (make-instance 'idx-four :slot1 val)) + + (with-transaction () + (mapc #'make-idx-four '(1 1 1 2 2 4 5 5 5 6 10))) + + (let ((x1 (get-instances-by-range 'idx-four 'slot1 2 6)) + (x2 (get-instances-by-range 'idx-four 'slot1 0 2)) + (x3 (get-instances-by-range 'idx-four 'slot1 6 15)) + ) + (format t " x1 = ~A~%" (mapcar #'slot1 x1)) + (format t " x2 = ~A~%" (mapcar #'slot1 x2)) + (format t " x3 = ~A~%" (mapcar #'slot1 x3)) + at end lisp + +Additionally, the test + at lisp +(do-test 'INDEXING-TIMING) + at end lisp +Can be used to judge the performance of indexing a large dataset. + +The file @file{src/elephant/classindex.lisp} provides the source code and +some crisp documentation of the class indexing system. + +Note that for retrieving items, the API is provided by three functions: + + at lisp +(defgeneric get-instances-by-class (persistent-metaclass)) +(defgeneric get-instances-by-value (persistent-metaclass slot-name value)) +(defgeneric get-instances-by-range (persistent-metaclass slot-name start end)) + at end lisp + +By using these functions, any class that is a subclass of persistent-metaclass +can also be thought of a as a container of all of its instances, which are +persistent in the database between lisp invocations. Morover an individual +object can be looked up on O(log n) time via a value which is indexed. + +At the top of this same file, you will find the a description of the API +which can be used to dynamically add and remove indexes. (Adding and +removing indexes can also be performed by a re-execution of the ``defclass'' +macro with different values.) + +Thus, the question of if and how a given class should be indexed is +very flexible and dynamic, and does not need to be determined at the +beginning of your development. This represents the ability to ``late bind'' +the and change the decision of what to index for efficiencty. + +In general, there is always a tradeoff: an index makes reads in a +particular way fast, but makes writes slower. The Elephant system +makes it simple to choose where and when one wants to utilize this tradeoff. + +Finally, that file @file{src/elephant/classindex-utils.lisp} documents +tools for handling class redefinitions and the policy that should be +used for synchronizing the classes with the database. + +Thanks to Ian Eslick for this functionality. + @node Secondary Indices @comment node-name, next, previous, up @section Secondary Indices From ieslick at common-lisp.net Tue Mar 7 14:12:22 2006 From: ieslick at common-lisp.net (ieslick) Date: Tue, 7 Mar 2006 09:12:22 -0500 (EST) Subject: [elephant-cvs] CVS elephant Message-ID: <20060307141222.2587732005@common-lisp.net> Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv556 Modified Files: TODO Log Message: Added legacy upgrade support, fixed some store-controller base class functionality for SQL to properly delete connections on close --- /project/elephant/cvsroot/elephant/TODO 2006/02/25 22:06:13 1.20 +++ /project/elephant/cvsroot/elephant/TODO 2006/03/07 14:12:22 1.21 @@ -19,7 +19,8 @@ - Port elephant to closer-to-MOP to make it easier to support additional lisps (Both) - (From Ben's e-mail) We are storing persistent objects incorrectly. They should be stored only as OIDs, and we should have a separate OID->class table. This way - change-class can be handled correctly (Ian) ??? + change-class can be handled correctly. This also non-trivially compresses storage + in the database as we only need to store oids rather than serialized class names. - Delete persistent slot values from the slot store with remove-kv to ensure that there's no data left lying around if you define then redefine a class and add back a persistent slot name that you thought was deleted and it gets the old From ieslick at common-lisp.net Tue Mar 7 14:12:22 2006 From: ieslick at common-lisp.net (ieslick) Date: Tue, 7 Mar 2006 09:12:22 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/db-bdb Message-ID: <20060307141222.5B47233006@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv556/src/db-bdb Modified Files: bdb-controller.lisp Log Message: Added legacy upgrade support, fixed some store-controller base class functionality for SQL to properly delete connections on close --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/02/22 21:03:47 1.5 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/03/07 14:12:22 1.6 @@ -103,10 +103,10 @@ :auto-commit t :create t :thread t) (setf (controller-oid-seq sc) oid-seq))) - (setf (slot-value sc 'root) + (setf (slot-value sc 'root) (make-instance 'bdb-btree :from-oid -1 :sc sc)) - (setf (slot-value sc 'class-root) + (setf (slot-value sc 'class-root) (make-instance 'bdb-btree :from-oid -2 :sc sc)) sc))) @@ -133,10 +133,7 @@ (setf (controller-db sc) nil) (db-env-close (controller-environment sc)) (setf (controller-environment sc) nil) - nil) - ;; Delete connection spec so object ops on cached db info fail - (remhash (controller-spec sc) *dbconnection-spec*)) - + nil)) (defmethod next-oid ((sc bdb-store-controller)) "Get the next OID." From ieslick at common-lisp.net Tue Mar 7 14:12:22 2006 From: ieslick at common-lisp.net (ieslick) Date: Tue, 7 Mar 2006 09:12:22 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20060307141222.8E7B933006@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv556/src/elephant Modified Files: classindex.lisp controller.lisp Log Message: Added legacy upgrade support, fixed some store-controller base class functionality for SQL to properly delete connections on close --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/03/01 18:57:34 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/03/07 14:12:22 1.7 @@ -368,9 +368,9 @@ (get-instances-by-value (find-class class) slot-name value)) (defmethod get-instances-by-value ((class persistent-metaclass) slot-name value) - (declare - (optimize (speed 3) (safety 1) (space 1)) - (type (or string symbol) slot-name)) +;; (declare +;; (optimize (speed 3) (safety 1) (space 1)) +;; (type (or string symbol) slot-name)) (let ((instances nil)) (with-btree-cursor (cur (find-inverted-index class slot-name)) (multiple-value-bind (exists? skey val pkey) (cursor-pset cur value) @@ -388,9 +388,9 @@ (get-instances-by-range (find-class class) slot-name start end)) (defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end) - (declare (optimize speed (safety 1) (space 1)) - (type fixnum start end) - (type string idx-name)) +;; (declare (optimize speed (safety 1) (space 1)) +;; (type fixnum start end) +;; (type string idx-name)) (with-inverted-cursor (cur class idx-name) (labels ((next-range (instances) (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur) --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/02/21 19:40:03 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/03/07 14:12:22 1.7 @@ -178,7 +178,8 @@ (let ((obj (get-cache oid (instance-cache sc)))) (if obj obj ;; Should get cached since make-instance calls cache-instance - (make-instance class-name :from-oid oid :sc sc)))) + (make-instance (handle-legacy-classes class-name) + :from-oid oid :sc sc)))) (defmethod flush-instance-cache ((sc store-controller)) "Reset the instance cache (flush object lookups). Useful @@ -187,6 +188,24 @@ (setf (instance-cache sc) (make-cache-table :test 'eql))) +(defun handle-legacy-classes (name) + (let ((entry (assoc (symbol->string-pair name) *legacy-conversions-db* :test #'equal))) + (if entry + (string-pair->symbol (cdr entry)) + name))) + +(defun symbol->string-pair (name) + (cons (string-downcase (package-name (symbol-package name))) + (string-downcase (symbol-name name)))) + +(defun string-pair->symbol (name) + (intern (string-upcase (cdr name)) (car name))) + +(defparameter *legacy-conversions-db* + '((("elephant" . "bdb-btree") . ("sleepycat" . "bdb-btree")) + (("elephant" . "bdb-indexed-btree") . ("sleepycat" . "bdb-indexed-btree")) + (("elephant" . "bdb-btree-index") . ("sleepycat" . "bdb-btree-index")))) + ;; ;; STORE CONTROLLER PROTOCOL ;; @@ -212,6 +231,12 @@ (:documentation "Provides a persistent source of unique id's")) +;; Handling dbconnection specs + +(defmethod close-controller :after ((sc store-controller)) + "Delete connection spec so object ops on cached db info fail" + (remhash (controller-spec sc) *dbconnection-spec*)) + ;; Low-level support for metaclass protocol (defgeneric persistent-slot-reader (sc instance name) @@ -262,4 +287,23 @@ "Map over all key-value pairs in the root" (map-btree fn (controller-root store-controller))) +;; +;; Explicit storage reclamation +;; + +(defmethod drop-pobject ((inst persistent-object)) + "Reclaim persistent object storage by unbinding slot values. + This also drops references to the instance from any index + it partipates in. This does not delete the cached object + instance or any serialized references still in the db. + Need a migration or GC for that!" + (when (indexed (class-of inst)) + (drop-instances (list inst))) + (let ((pslots (persistent-slots (class-of inst)))) + (dolist (slot pslots) + (slot-makunbound inst slot)))) +;; (slot-makunbound-using-class (class-of inst) +;; inst +;; (find-effective-slot-def (class-of inst) slot))))) + From ieslick at common-lisp.net Tue Mar 7 14:12:22 2006 From: ieslick at common-lisp.net (ieslick) Date: Tue, 7 Mar 2006 09:12:22 -0500 (EST) Subject: [elephant-cvs] CVS elephant/tests Message-ID: <20060307141222.C28773A001@common-lisp.net> Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv556/tests Modified Files: elephant-tests.lisp testmigration.lisp Log Message: Added legacy upgrade support, fixed some store-controller base class functionality for SQL to properly delete connections on close --- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/22 22:01:45 1.19 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/03/07 14:12:22 1.20 @@ -83,6 +83,10 @@ '(:clsql (:sqlite3 "sqlite3-test.db")) "This is of the form '(filename &optional init-function),") +(defvar *testsqlite3-spec2* + '(:clsql (:sqlite3 "sqlite3-test2.db")) + "This is of the form '(filename &optional init-function),") + (defvar *testsqlite3-memory-spec* '(:clsql (:sqlite3 :memory)) "Using :memory: as a file name will get you an completely in-memory system") --- /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/02/21 19:40:08 1.10 +++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/03/07 14:12:22 1.11 @@ -181,6 +181,8 @@ (setf (elephant::%index-cache (find-class 'ipfoo)) nil) (find-class-index 'ipfoo :sc sc1) ;; (format t "Making objects~%") + (with-transaction (:store-controller sc2) + (drop-instances (get-instances-by-class 'ipfoo) :sc sc2)) (with-transaction (:store-controller sc1) (drop-instances (get-instances-by-class 'ipfoo) :sc sc1) (make-instance 'ipfoo :slot1 1 :sc sc1) @@ -197,10 +199,10 @@ (fm3 (get-instances-by-value 'ipfoo 'slot1 20)) (all (get-instances-by-class 'ipfoo))) ;; (format t "Clear & return~%") - (let ((insts (get-instances-by-class 'ipfoo))) - (with-transaction (:store-controller sc2) +;; (let ((insts (get-instances-by-class 'ipfoo))) +;; (with-transaction (:store-controller sc2) ;; (format t "Dropping instances~%") - (drop-instances insts :sc sc2))) +;; (drop-instances insts :sc sc2))) (values (length all) (length fm1) From rread at common-lisp.net Mon Mar 27 20:36:27 2006 From: rread at common-lisp.net (rread) Date: Mon, 27 Mar 2006 15:36:27 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/db-clsql Message-ID: <20060327203627.CF0084D00D@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv1800/src/db-clsql Modified Files: sql-controller.lisp Log Message: Subtle bug and performance improvement --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/03/01 18:57:34 1.9 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/03/27 20:36:27 1.10 @@ -515,33 +515,46 @@ (assert (integerp clcn)) (let* ( (kbs (serialize-to-base64-string key)) - ;; We want to remove the FIRST value, based on our ordering. - ;; have little choice but to read everything in and delete based on - ;; the "value field". - (tuples - (clsql::select [value] - :from [keyvalue] - :where [and [= [clctn_id] clcn] [= [key] kbs]] - :database con - ))) - (if (< (length tuples) 1) + ;; We want to remove the FIRST value, based on our ordering. + ;; have little choice but to read everything in and delete based on + ;; the "value field". + (tuples + (clsql::select [value] + :from [keyvalue] + :where [and [= [clctn_id] clcn] [= [key] kbs]] + :database con + )) + (n (length tuples))) +;; (format t "num tuples = ~A~%" n) + (if (< n 1) nil - (let ((to-remove - (serialize-to-base64-string - (nth 0 (sort - (mapcar - #'(lambda (x) - (deserialize-from-base64-string (car x) :sc sc)) - tuples) - #'my-generic-less-than))))) + (let ((to-remove nil)) + (dolist (tuple tuples) + (if (or (null to-remove) + (my-generic-less-than (car tuple) to-remove)) + (setf to-remove (car tuple)))) +;; (nth 0 (sort +;; (mapcar +;; #'(lambda (x) +;; (deserialize-from-base64-string (car x) :sc sc)) +;; tuples) +;; #'my-generic-less-than))))) +;; (format t "to-remove = ~A~%" to-remove) (clsql::delete-records :from [keyvalue] - :where [and [= [clctn_id] clcn] [= [key] kbs] - [= [value] to-remove]] - :database con - ) + :where [and [= [clctn_id] clcn] [= [key] kbs] + [= [value] to-remove]] + :database con + ) +;; (format t "After deletion = ~A~%" +;; (clsql::select [value] +;; :from [keyvalue] +;; :where [and [= [clctn_id] clcn] [= [key] kbs]] +;; :database con +;; )) ) ) - )) + ) + ) (defun sql-remove-key-and-value-from-clcn (clcn key value con) (assert (integerp clcn)) From rread at common-lisp.net Mon Mar 27 20:36:28 2006 From: rread at common-lisp.net (rread) Date: Mon, 27 Mar 2006 15:36:28 -0500 (EST) Subject: [elephant-cvs] CVS elephant/src/elephant Message-ID: <20060327203628.1B36E4D013@common-lisp.net> Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv1800/src/elephant Modified Files: classindex.lisp controller.lisp Log Message: Subtle bug and performance improvement --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/03/07 14:12:22 1.7 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/03/27 20:36:27 1.8 @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; -;;; indexing.lisp -- use btree collections to track objects by slot values +;;; classindex.lisp -- use btree collections to track objects by slot values ;;; via metaclass options or accessor :after methods ;;; ;;; Initial version 1/24/2006 Ian Eslick --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/03/07 14:12:22 1.7 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/03/27 20:36:28 1.8 @@ -1,4 +1,4 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; controller.lisp -- Lisp interface to a Berkeley DB store ;;;