September 2008 - bknr-cvs@common-lisp.net

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3939 Author: hans URL: http://bknr.net/trac/changeset/3939 Oops, we certainly did not want to have defined a primary method for inititialize-instance on user objects. U branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp Modified: branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp 2008-09-22 18:23:36 UTC (rev 3938) +++ branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp 2008-09-22 18:31:17 UTC (rev 3939) @@ -60,7 +60,7 @@ (user-login object) "unbound")))) -(defmethod initialize-instance ((user user) &key) +(defmethod initialize-instance :after ((user user) &key) (let* ((plaintext-password (slot-value user 'password)) (password (when plaintext-password (crypt-md5 plaintext-password (make-salt))))) (setf (slot-value user 'password) password)))

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/projects/bos/
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3938 Author: hans URL: http://bknr.net/trac/changeset/3938 Application fixes for BOS to make it work with the recent store updates. U branches/anon-transaction-fixes-2/projects/bos/m2/allocation.lisp U branches/anon-transaction-fixes-2/projects/bos/m2/poi.lisp U branches/anon-transaction-fixes-2/projects/bos/web/daily.lisp Modified: branches/anon-transaction-fixes-2/projects/bos/m2/allocation.lisp =================================================================== --- branches/anon-transaction-fixes-2/projects/bos/m2/allocation.lisp 2008-09-22 15:51:49 UTC (rev 3937) +++ branches/anon-transaction-fixes-2/projects/bos/m2/allocation.lisp 2008-09-22 18:23:36 UTC (rev 3938) @@ -127,7 +127,6 @@ :top top :width width :height height - :y top :active-p nil :vertices vertices))) result))) Modified: branches/anon-transaction-fixes-2/projects/bos/m2/poi.lisp =================================================================== --- branches/anon-transaction-fixes-2/projects/bos/m2/poi.lisp 2008-09-22 15:51:49 UTC (rev 3937) +++ branches/anon-transaction-fixes-2/projects/bos/m2/poi.lisp 2008-09-22 18:23:36 UTC (rev 3938) @@ -50,7 +50,7 @@ (assert (if (or title subtitle description) language t) nil "language needs to be specified, if any of title, subtitle or description is given") - (apply #'make-instance class-name rest)) + (apply #'make-instance class-name (remove-keys '(:initargs) rest))) (defmethod initialize-instance :after ((poi-medium poi-medium) &key poi) (when poi Modified: branches/anon-transaction-fixes-2/projects/bos/web/daily.lisp =================================================================== --- branches/anon-transaction-fixes-2/projects/bos/web/daily.lisp 2008-09-22 15:51:49 UTC (rev 3937) +++ branches/anon-transaction-fixes-2/projects/bos/web/daily.lisp 2008-09-22 18:23:36 UTC (rev 3938) @@ -3,7 +3,6 @@ (defun daily-cleanup () (format t "; performing daily cleanup run~%") (bos.m2::delete-expired-contracts) - (bknr.stats::make-yesterdays-stats :delete-events t) (format t "; snapshotting datastore~%") (snapshot) (format t "; running check (consistent-p)~%")

1 0

[bknr-cvs] hans changed trunk/thirdparty/emacs/js2.el
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3937 Author: hans URL: http://bknr.net/trac/changeset/3937 copy js2 to trunk A trunk/thirdparty/emacs/js2.el Change set too large, please see URL above

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/bknr/datastore/src/data/object
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3936 Author: hans URL: http://bknr.net/trac/changeset/3936 Stop using allocate-instance method for ID allocation again. SBCL allocates an instance of every class as an optimization for object creation, and this prototype object was then made part of the class extent. Instead, the ID is now allocated in initialize-instance. Lock ID allocation against concurrent access. U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp 2008-09-22 08:06:08 UTC (rev 3935) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp 2008-09-22 10:40:42 UTC (rev 3936) @@ -144,8 +144,8 @@ (defdstest stress-test-2 () (bknr.datastore::without-sync () (format t "Creating ~A objects~%" +stress-size+) - (dotimes (i +stress-size+) - (make-instance 'store-object)) + (time (dotimes (i +stress-size+) + (make-instance 'store-object))) (format t "Deleting ~A objects~%" (length (all-store-objects))) (time (map-store-objects #'delete-object)) (test-equal (all-store-objects) nil))) @@ -169,10 +169,11 @@ (defun object-classes-and-ids () "Return a list of conses with the car being a class name and the cdr being the object id for all persistent objects in the store" - (mapcar (lambda (object) - (cons (class-name (class-of object)) - (store-object-id object))) - (all-store-objects))) + (sort (mapcar (lambda (object) + (cons (class-name (class-of object)) + (store-object-id object))) + (all-store-objects)) + #'< :key #'cdr)) (defdstest make-referenced-object-in-anon-tx () (with-transaction (:make) Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp 2008-09-22 08:06:08 UTC (rev 3935) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp 2008-09-22 10:40:42 UTC (rev 3936) @@ -163,7 +163,9 @@ (remove-if #'transient-slot-p (class-slots class))) (defclass store-object () - ((id :initarg :id :reader store-object-id + ((id :initarg :id + :reader store-object-id + :type integer :index-type unique-index :index-initargs (:test #'eql) :index-reader store-object-with-id :index-values all-store-objects @@ -220,6 +222,7 @@ (aclmop::finalize-inheritance (find-class 'store-object)) (defmethod initialize-instance :around ((object store-object) &rest initargs &key) + (setf (slot-value object 'id) (allocate-next-object-id)) (cond ((not (in-transaction-p)) (with-store-guard () @@ -242,14 +245,14 @@ (t (call-next-method)))) -(defmethod allocate-instance :around ((class persistent-class) &key) - (let* ((object (call-next-method)) - (subsystem (store-object-subsystem)) - (id (next-object-id subsystem))) - (setf (slot-value object 'id) id) - (incf (next-object-id subsystem)) - object)) +(defvar *allocate-object-id-lock* (bt:make-lock "Persistent Object ID Creation")) +(defun allocate-next-object-id () + (mp-with-lock-held (*allocate-object-id-lock*) + (let ((id (next-object-id (store-object-subsystem)))) + (incf (next-object-id (store-object-subsystem))) + id))) + (defun initialize-transient-slots (object) (dolist (slotd (class-slots (class-of object))) (when (and (typep slotd 'persistent-effective-slot-definition) @@ -493,15 +496,9 @@ ;; If the class is NIL, it was not found in the currently ;; running Lisp image and objects of this class will be ignored. (when class - ;; We set the next object ID to allocate in the store to the - ;; object ID read from the snapshot file. ALLOCATE-INSTANCE - ;; will assign this object ID to the object and increment the - ;; counter. This way, we correctly deserialze store snapshots - ;; which have holes in their ID space (because objects have - ;; been deleted). - (setf (next-object-id (store-object-subsystem)) object-id) (let ((object (allocate-instance class))) - (assert (= object-id (slot-value object 'id))) + (setf (slot-value object 'id) object-id + (next-object-id (store-object-subsystem)) (1+ object-id)) (dolist (index (class-slot-indices class 'id)) (index-add index object)))))))

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3935 Author: hans URL: http://bknr.net/trac/changeset/3935 Fix indentation U branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp 2008-09-21 21:26:39 UTC (rev 3934) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp 2008-09-22 08:06:08 UTC (rev 3935) @@ -131,17 +131,17 @@ (close-store) (make-instance 'tutorial-store :directory "/tmp/tutorial-store/" :subsystems nil) - ; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> (tutorial-store-counter *store*) - ; => 0 +; => 0 (incf-counter) - ; => 1 +; => 1 (incf-counter) - ; => 2 +; => 2 (decf-counter) - ; => 1 +; => 1 ;;; The three transactions have been logged to the transaction log in ;;; "/tmp/tutorial-store/", as we can see: @@ -149,13 +149,13 @@ (with-open-file (s "/tmp/tutorial-store/current/transaction-log" :direction :input) (file-length s)) - ; => 126 +; => 126 (incf-counter) - ; => 2 +; => 2 (with-open-file (s "/tmp/tutorial-store/current/transaction-log" :direction :input) (file-length s)) - ; => 168 +; => 168 ;;; The transaction log is kept in a directory called "current", which ;;; is where the currently active version of the snapshots and log @@ -166,29 +166,29 @@ ;;; the persistent data (the counter value). (snapshot) - ; => Error in function (METHOD SNAPSHOT-STORE NIL (STORE)): - ; => Cannot snapshot store without subsystems... - ; => [Condition of type SIMPLE-ERROR] +; => Error in function (METHOD SNAPSHOT-STORE NIL (STORE)): +; => Cannot snapshot store without subsystems... +; => [Condition of type SIMPLE-ERROR] ;;; We can close the store by using the function `CLOSE-STORE'. *store* - ; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> (close-store) - ; => NIL +; => NIL (boundp '*store*) - ; => NIL +; => NIL ;;; The store can then be recreated, and the transaction log will be ;;; read and executed upon restore. (make-instance 'tutorial-store :directory "/tmp/tutorial-store/" :subsystems nil) - ; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; Warning: loading transaction log - ; /tmp/tutorial-store/current/transaction-log - ; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: loading transaction log +; /tmp/tutorial-store/current/transaction-log +; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> (tutorial-store-counter *store*) - ; => 2 +; => 2 ;;; The store can also be restored in a later LISP session. Make sure ;;; that all the code necessary to the execution of the transaction @@ -205,26 +205,26 @@ ;;; `UNTIL' argument of `RESTORE-STORE'. (setf *store-debug* t) - ; => T +; => T (restore-store *store*) - ; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; loading transaction log /tmp/tutorial-store/current/transaction-log - ; executing transaction #<TRANSACTION 21.04.2008 07:08:22 TX-INCF-COUNTER > at timestamp 3417743302 - ; executing transaction #<TRANSACTION 21.04.2008 07:08:25 TX-INCF-COUNTER > at timestamp 3417743305 - ; executing transaction #<TRANSACTION 21.04.2008 07:08:26 TX-DECF-COUNTER > at timestamp 3417743306 - ; executing transaction #<TRANSACTION 21.04.2008 07:08:34 TX-INCF-COUNTER > at timestamp 3417743314 - ; => NIL +; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; loading transaction log /tmp/tutorial-store/current/transaction-log +; executing transaction #<TRANSACTION 21.04.2008 07:08:22 TX-INCF-COUNTER > at timestamp 3417743302 +; executing transaction #<TRANSACTION 21.04.2008 07:08:25 TX-INCF-COUNTER > at timestamp 3417743305 +; executing transaction #<TRANSACTION 21.04.2008 07:08:26 TX-DECF-COUNTER > at timestamp 3417743306 +; executing transaction #<TRANSACTION 21.04.2008 07:08:34 TX-INCF-COUNTER > at timestamp 3417743314 +; => NIL (tutorial-store-counter *store*) - ; => 2 - ; !! Update the timestamp below to correspond to the fist transaction executed above !! +; => 2 +; !! Update the timestamp below to correspond to the fist transaction executed above !! (restore-store *store* :until 3417743302) ... - ; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; loading transaction log /tmp/tutorial-store/current/transaction-log - ; executing transaction #<TRANSACTION 21.04.2008 07:08:22 TX-INCF-COUNTER > at timestamp 3417743302 - ; creating log file backup: /tmp/tutorial-store/current/transaction-log.backup - ; truncating transaction log at position 42. +; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; loading transaction log /tmp/tutorial-store/current/transaction-log +; executing transaction #<TRANSACTION 21.04.2008 07:08:22 TX-INCF-COUNTER > at timestamp 3417743302 +; creating log file backup: /tmp/tutorial-store/current/transaction-log.backup +; truncating transaction log at position 42. (tutorial-store-counter *store*) - ; => 1 +; => 1 ;;;## Adding a subsystem @@ -287,22 +287,22 @@ ;;; `COUNTER-SUBSYSTEM'. (close-store) - ; => NIL +; => NIL (make-instance 'tutorial-store :directory "/tmp/tutorial-store/" :subsystems (list (make-instance 'counter-subsystem))) - ; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; Warning: Could not find store counter value, setting to 0. - ; Warning: loading transaction log - ; /tmp/tutorial-store/current/transaction-log - ; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: Could not find store counter value, setting to 0. +; Warning: loading transaction log +; /tmp/tutorial-store/current/transaction-log +; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> (snapshot) - ; Snapshotting subsystem #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; Successfully snapshotted #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; => NIL +; Snapshotting subsystem #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Successfully snapshotted #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; => NIL (restore) - ; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; Restoring the subsystem #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; => NUL +; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Restoring the subsystem #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; => NUL ;;;# An object store example @@ -340,11 +340,11 @@ :subsystems (list (make-instance 'store-object-subsystem))) - ; Warning: restoring #<MP-STORE DIR: "/tmp/object-store/"> - ; restoring #<MP-STORE DIR: "/tmp/object-store/"> - ; Restoring the subsystem #<STORE-OBJECT-SUBSYSTEM #xE63F866> of #<MP-STORE DIR: "/tmp/object-store/"> +; Warning: restoring #<MP-STORE DIR: "/tmp/object-store/"> +; restoring #<MP-STORE DIR: "/tmp/object-store/"> +; Restoring the subsystem #<STORE-OBJECT-SUBSYSTEM #xE63F866> of #<MP-STORE DIR: "/tmp/object-store/"> (all-store-objects) - ; => NIL +; => NIL ;;; We can now create a few store objects (which is not very ;;; interesting in itself). Store objects have to be created inside a @@ -354,28 +354,28 @@ ;;; separate transaction. (make-instance 'store-object) - ; => #<STORE-OBJECT ID: 0> +; => #<STORE-OBJECT ID: 0> (make-instance 'store-object) - ; => #<STORE-OBJECT ID: 1> +; => #<STORE-OBJECT ID: 1> (all-store-objects) - ; => (#<STORE-OBJECT ID: 0> #<STORE-OBJECT ID: 1>) +; => (#<STORE-OBJECT ID: 0> #<STORE-OBJECT ID: 1>) (all-store-classes) - ; => (STORE-OBJECT) +; => (STORE-OBJECT) ;;; Object deletion also has to be done through the transaction ;;; `DELETE-OBJECT', which will log the deletion of the object in the ;;; transaction log, and remove the object from all its indices. (make-instance 'store-object) - ; executing transaction #<TRANSACTION 21.04.2008 08:02:10 MAKE-INSTANCE STORE-OBJECT ID 2> at timestamp 3417746530 - ; => #<STORE-OBJECT ID: 12> +; executing transaction #<TRANSACTION 21.04.2008 08:02:10 MAKE-INSTANCE STORE-OBJECT ID 2> at timestamp 3417746530 +; => #<STORE-OBJECT ID: 12> (store-object-with-id 2) - ; => #<STORE-OBJECT ID: 2> +; => #<STORE-OBJECT ID: 2> (delete-object (store-object-with-id 2)) - ; executing transaction #<TRANSACTION 21.04.2008 08:52:14 TX-DELETE-OBJECT 2> at timestamp 3417749534 - ; => T +; executing transaction #<TRANSACTION 21.04.2008 08:52:14 TX-DELETE-OBJECT 2> at timestamp 3417749534 +; => T (store-object-with-id 2) - ; => NIL +; => NIL ;;;## Defining persistent classes @@ -412,25 +412,25 @@ ;;; We can now create a few instance of `TUTORIAL-OBJECT': (make-instance 'tutorial-object :a 2) - ; => #<TUTORIAL-OBJECT ID: 3> +; => #<TUTORIAL-OBJECT ID: 3> (make-instance 'tutorial-object :a 2) - ; => #<TUTORIAL-OBJECT ID: 4> +; => #<TUTORIAL-OBJECT ID: 4> (make-instance 'tutorial-object :a 2) - ; => #<TUTORIAL-OBJECT ID: 5> +; => #<TUTORIAL-OBJECT ID: 5> (store-object-with-id 5) - ; => #<TUTORIAL-OBJECT ID: 5> +; => #<TUTORIAL-OBJECT ID: 5> (all-store-classes) - ; => (STORE-OBJECT TUTORIAL-OBJECT) +; => (STORE-OBJECT TUTORIAL-OBJECT) (store-objects-with-class 'tutorial-object) - ; => (#<TUTORIAL-OBJECT ID: 3> #<TUTORIAL-OBJECT ID: 4> - ; #<TUTORIAL-OBJECT ID: 5>) +; => (#<TUTORIAL-OBJECT ID: 3> #<TUTORIAL-OBJECT ID: 4> +; #<TUTORIAL-OBJECT ID: 5>) (store-objects-with-class 'store-object) - ; => (#<STORE-OBJECT ID: 0> #<STORE-OBJECT ID: 1> - ; #<FOO ID: 2> #<TUTORIAL-OBJECT ID: 3> - ; #<TUTORIAL-OBJECT ID: 4> #<TUTORIAL-OBJECT ID: 5>) +; => (#<STORE-OBJECT ID: 0> #<STORE-OBJECT ID: 1> +; #<FOO ID: 2> #<TUTORIAL-OBJECT ID: 3> +; #<TUTORIAL-OBJECT ID: 4> #<TUTORIAL-OBJECT ID: 5>) ;;; In order to change the slot values of persistent object, the ;;; application needs to be in a transaction context. This can be @@ -442,16 +442,16 @@ ((b :update))) (make-instance 'tutorial-object2 :b 3) - ; executing transaction #<TRANSACTION 21.04.2008 08:03:27 MAKE-INSTANCE TUTORIAL-OBJECT2 ID 6 B 3> at timestamp 3417746607 - ; => #<TUTORIAL-OBJECT2 ID: 6> +; executing transaction #<TRANSACTION 21.04.2008 08:03:27 MAKE-INSTANCE TUTORIAL-OBJECT2 ID 6 B 3> at timestamp 3417746607 +; => #<TUTORIAL-OBJECT2 ID: 6> (setf (slot-value (store-object-with-id 6) 'b) 4) - ; => Error - ; Attempt to set persistent slot B of #<TUTORIAL-OBJECT2 ID: 6> outside of a transaction +; => Error +; Attempt to set persistent slot B of #<TUTORIAL-OBJECT2 ID: 6> outside of a transaction (with-transaction () (setf (slot-value (store-object-with-id 6) 'b) 4)) - ; => 4 +; => 4 (tutorial-object2-b (store-object-with-id 6)) - ; => 4 +; => 4 ;;;## Object creation and deletion protocol @@ -479,17 +479,17 @@ ;;; We can modify the slot `A' outside a transaction: (make-instance 'protocol-object :a 1 :b 2) - ; executing transaction #<TRANSACTION 21.04.2008 08:10:49 MAKE-INSTANCE PROTOCOL-OBJECT ID 7 A 1 B 2> at timestamp 3417747049 - ; => #<PROTOCOL-OBJECT ID: 7> +; executing transaction #<TRANSACTION 21.04.2008 08:10:49 MAKE-INSTANCE PROTOCOL-OBJECT ID 7 A 1 B 2> at timestamp 3417747049 +; => #<PROTOCOL-OBJECT ID: 7> (setf (protocol-object-a (store-object-with-id 7)) 2) - ; => 2 +; => 2 ;;; However, we cannot modify the slot `B', as it is persistent and ;;; has to be changed inside a transaction. (setf (protocol-object-b (store-object-with-id 7)) 4) - ; => Error - ; Attempt to set persistent slot B of #<PROTOCOL-OBJECT ID: 7> outside of a transaction +; => Error +; Attempt to set persistent slot B of #<PROTOCOL-OBJECT ID: 7> outside of a transaction ;;; An object can be removed from the datastore using the transaction ;;; `DELETE-OBJECT', which calls the method `DESTROY-OBJECT' on the @@ -502,19 +502,19 @@ ;;; We can snapshot the persistent state of all created objects by ;;; using `SNAPSHOT'. (snapshot) - ; Snapshotting subsystem #<STORE-OBJECT-SUBSYSTEM #xE54991E> of #<MP-STORE DIR: "/tmp/object-store/"> - ; Successfully snapshotted #<STORE-OBJECT-SUBSYSTEM #xE54991E> of #<MP-STORE DIR: "/tmp/object-store/"> +; Snapshotting subsystem #<STORE-OBJECT-SUBSYSTEM #xE54991E> of #<MP-STORE DIR: "/tmp/object-store/"> +; Successfully snapshotted #<STORE-OBJECT-SUBSYSTEM #xE54991E> of #<MP-STORE DIR: "/tmp/object-store/"> ;;; This will create a backup directory containing the old transaction ;;; log, and the creation of a snapshot file in the "current" ;;; directory. (directory "/tmp/object-store/**/*.*") - ; => (#P"/tmp/object-store/20080421T061210/random-state" - ; #P"/tmp/object-store/20080421T061210/transaction-log" - ; #P"/tmp/object-store/current/random-state" - ; #P"/tmp/object-store/current/store-object-subsystem-snapshot" - ; #P"/tmp/object-store/current/transaction-log") +; => (#P"/tmp/object-store/20080421T061210/random-state" +; #P"/tmp/object-store/20080421T061210/transaction-log" +; #P"/tmp/object-store/current/random-state" +; #P"/tmp/object-store/current/store-object-subsystem-snapshot" +; #P"/tmp/object-store/current/transaction-log") ;;; The snapshot file contains all persistent objects present at ;;; snapshotting time, and the value of their persistent @@ -538,15 +538,15 @@ :index-keys all-gorilla-moods))) (make-instance 'gorilla :name "lucy" :mood :aggressive) - ; => #<GORILLA ID: 8> +; => #<GORILLA ID: 8> (make-instance 'gorilla :name "john" :mood :playful) - ; => #<GORILLA ID: 9> +; => #<GORILLA ID: 9> (make-instance 'gorilla :name "peter" :mood :playful) - ; => #<GORILLA ID: 10> +; => #<GORILLA ID: 10> (gorilla-with-name "lucy") - ; => #<GORILLA ID: 8> +; => #<GORILLA ID: 8> (gorillas-with-mood :playful) - ; => (#<GORILLA ID: 10> #<GORILLA ID: 9>) +; => (#<GORILLA ID: 10> #<GORILLA ID: 9>) ;;;## Adding blobs @@ -606,7 +606,7 @@ (make-blob-from-file "/tmp/bla.jpg" 'photo :name "foobar" :type :jpg) - ; => #<PHOTO ID: 11, TYPE: jpg> +; => #<PHOTO ID: 11, TYPE: jpg> ;;; We can work with the photo object in the same way as when we work ;;; with a normal object. However, we can access the binary data using @@ -615,7 +615,7 @@ ;;; object. (blob-pathname (store-object-with-id 11)) - ; => #P"/tmp/object-store/blob-root/11" +; => #P"/tmp/object-store/blob-root/11" ;;; The method `BLOB-TO-FILE' and `BLOB-TO-STREAM' write the binary ;;; data of the object to the specified file or stream (the stream has @@ -642,37 +642,37 @@ ((a :update :relaxed-object-reference t))) (make-instance 'relaxed-object) - ; => #<RELAXED-OBJECT ID: 12> +; => #<RELAXED-OBJECT ID: 12> (make-instance 'relaxed-object) - ; => #<RELAXED-OBJECT ID: 13> +; => #<RELAXED-OBJECT ID: 13> (with-transaction () (setf (slot-value (store-object-with-id 12) 'a) (store-object-with-id 13))) - ; => #<RELAXED-OBJECT ID: 13> +; => #<RELAXED-OBJECT ID: 13> (delete-object (store-object-with-id 13)) - ; => T +; => T (snapshot) - ; Warning: Backup of the datastore in /tmp/object-store/20080421T064811/. - ; While executing: (:INTERNAL (SNAPSHOT-STORE (STORE))), in process worker(1750). - ; Snapshotting subsystem #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; Warning: Encoding reference to destroyed object with ID 13 from slot A of object RELAXED-OBJECT with ID 12. - ; While executing: #<STANDARD-METHOD ENCODE-OBJECT (STORE-OBJECT T)>, in process worker(1750). - ; Successfully snapshotted #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; Snapshotting subsystem #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; Successfully snapshotted #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; => NIL +; Warning: Backup of the datastore in /tmp/object-store/20080421T064811/. +; While executing: (:INTERNAL (SNAPSHOT-STORE (STORE))), in process worker(1750). +; Snapshotting subsystem #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> +; Warning: Encoding reference to destroyed object with ID 13 from slot A of object RELAXED-OBJECT with ID 12. +; While executing: #<STANDARD-METHOD ENCODE-OBJECT (STORE-OBJECT T)>, in process worker(1750). +; Successfully snapshotted #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> +; Snapshotting subsystem #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> +; Successfully snapshotted #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> +; => NIL (restore) - ; restoring #<MP-STORE DIR: "/tmp/object-store/"> - ; Restoring the subsystem #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; loading snapshot file /tmp/object-store/current/store-object-subsystem-snapshot - ; Warning: internal inconsistency during restore: can't find store object 13 in loaded store - ; While executing: %DECODE-STORE-OBJECT, in process worker(1754). - ; Warning: Reference to inexistent object with id 13 from unnamed container, returning NIL. - ; While executing: %DECODE-STORE-OBJECT, in process worker(1754). - ; Restoring the subsystem #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; loading transaction log /tmp/object-store/current/transaction-log - ; executing transaction #<ANONYMOUS-TRANSACTION 21.04.2008 08:48:48 PREPARE-FOR-SNAPSHOT NIL> at timestamp 3417749328 +; restoring #<MP-STORE DIR: "/tmp/object-store/"> +; Restoring the subsystem #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> +; loading snapshot file /tmp/object-store/current/store-object-subsystem-snapshot +; Warning: internal inconsistency during restore: can't find store object 13 in loaded store +; While executing: %DECODE-STORE-OBJECT, in process worker(1754). +; Warning: Reference to inexistent object with id 13 from unnamed container, returning NIL. +; While executing: %DECODE-STORE-OBJECT, in process worker(1754). +; Restoring the subsystem #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> +; loading transaction log /tmp/object-store/current/transaction-log +; executing transaction #<ANONYMOUS-TRANSACTION 21.04.2008 08:48:48 PREPARE-FOR-SNAPSHOT NIL> at timestamp 3417749328 (relaxed-object-a (store-object-with-id 12)) - ; => NIL +; => NIL ;;;# Store internals

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/
by BKNR Commits 21 Sep '08

21 Sep '08

Revision: 3934 Author: hans URL: http://bknr.net/trac/changeset/3934 Protocol updates U branches/anon-transaction-fixes-2/bknr/datastore/src/data/blob.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/package.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/tests.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/xml-object.lisp U branches/anon-transaction-fixes-2/bknr/modules/bug/bug-handlers.lisp U branches/anon-transaction-fixes-2/bknr/modules/comics/comics.lisp U branches/anon-transaction-fixes-2/bknr/modules/feed/edit-feed-handler.lisp U branches/anon-transaction-fixes-2/bknr/modules/feed/feed.lisp U branches/anon-transaction-fixes-2/bknr/modules/imagemap/imagemap.lisp U branches/anon-transaction-fixes-2/bknr/modules/mail/import-yahoo-group.lisp U branches/anon-transaction-fixes-2/bknr/modules/mail/mail.lisp U branches/anon-transaction-fixes-2/bknr/modules/mail/mailinglist-handlers.lisp U branches/anon-transaction-fixes-2/bknr/modules/mail/mailinglist.lisp U branches/anon-transaction-fixes-2/bknr/modules/mail/register-handler.lisp U branches/anon-transaction-fixes-2/bknr/modules/mail/registration.lisp U branches/anon-transaction-fixes-2/bknr/modules/quizz/edit-quizz-handlers.lisp U branches/anon-transaction-fixes-2/bknr/modules/stats/stats.lisp U branches/anon-transaction-fixes-2/bknr/modules/text/article-handlers.lisp U branches/anon-transaction-fixes-2/bknr/modules/text/article.lisp U branches/anon-transaction-fixes-2/bknr/modules/text/billboard-handlers.lisp U branches/anon-transaction-fixes-2/bknr/modules/text/billboard.lisp U branches/anon-transaction-fixes-2/bknr/modules/text/blog-handlers.lisp U branches/anon-transaction-fixes-2/bknr/modules/text/paste-handlers.lisp U branches/anon-transaction-fixes-2/bknr/modules/text/wiki-handlers.lisp U branches/anon-transaction-fixes-2/bknr/modules/track/track.lisp U branches/anon-transaction-fixes-2/bknr/modules/url/cached-url-handlers.lisp U branches/anon-transaction-fixes-2/bknr/modules/url/edit-url-handlers.lisp U branches/anon-transaction-fixes-2/bknr/web/src/images/image.lisp U branches/anon-transaction-fixes-2/bknr/web/src/rss/rss.lisp U branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/cron.lisp U branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/event.lisp U branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/sysparam.lisp U branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp U branches/anon-transaction-fixes-2/bknr/web/src/web/host.lisp U branches/anon-transaction-fixes-2/projects/bknr-website/src/init.lisp U branches/anon-transaction-fixes-2/projects/bos/m2/allocation.lisp U branches/anon-transaction-fixes-2/projects/bos/m2/m2.lisp U branches/anon-transaction-fixes-2/projects/bos/m2/map.lisp U branches/anon-transaction-fixes-2/projects/bos/m2/news.lisp U branches/anon-transaction-fixes-2/projects/bos/m2/poi.lisp U branches/anon-transaction-fixes-2/projects/bos/web/kml-handlers.lisp U branches/anon-transaction-fixes-2/projects/bos/web/languages-handler.lisp U branches/anon-transaction-fixes-2/projects/bos/web/poi-handlers.lisp U branches/anon-transaction-fixes-2/projects/bos/web/sat-tree.lisp U branches/anon-transaction-fixes-2/projects/hello-web/src/news.lisp U branches/anon-transaction-fixes-2/projects/lisp-ecoop/src/handlers.lisp U branches/anon-transaction-fixes-2/projects/lisp-ecoop/src/participant.lisp U branches/anon-transaction-fixes-2/projects/lisp-ecoop/src/tags.lisp U branches/anon-transaction-fixes-2/projects/quickhoney/website/static/javascript.js U branches/anon-transaction-fixes-2/projects/scrabble/src/game.lisp U branches/anon-transaction-fixes-2/projects/scrabble/src/rules.lisp U branches/anon-transaction-fixes-2/projects/scrabble/src/start-webserver.lisp U branches/anon-transaction-fixes-2/projects/unmaintained/eboy/src/dynasite-tags.lisp U branches/anon-transaction-fixes-2/projects/unmaintained/eboy/src/item-handlers.lisp U branches/anon-transaction-fixes-2/projects/unmaintained/gpn/gpn-user.lisp U branches/anon-transaction-fixes-2/projects/unmaintained/gpn/gpn-web.lisp U branches/anon-transaction-fixes-2/projects/unmaintained/gpn/zeitplan-handlers.lisp U branches/anon-transaction-fixes-2/projects/unmaintained/raw-data/mcp/bluetooth.lisp U branches/anon-transaction-fixes-2/projects/unmaintained/raw-data/mcp/isdn-operator.lisp U branches/anon-transaction-fixes-2/projects/unmaintained/raw-data/mcp/sensors.lisp U branches/anon-transaction-fixes-2/projects/unmaintained/saugnapf/src/saugnapf.lisp Change set too large, please see URL above

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/bknr/datastore/src/data/object
by BKNR Commits 21 Sep '08

21 Sep '08

Revision: 3933 Author: hans URL: http://bknr.net/trac/changeset/3933 Serialize make-instance transaction before calling initialize-instance in order to make sure that the object exists early enough during restore. Stress test with two threads. Change defdstest macro so that after each test has run, it is verified that the "same" set of objects exists when restoring from the tx log and a snapshot. U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp 2008-09-21 12:51:48 UTC (rev 3932) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp 2008-09-21 16:51:58 UTC (rev 3933) @@ -52,6 +52,17 @@ (delete-directory directory)))) (defvar *tests* (make-hash-table)) + +(defun do-run-test (thunk) + (let ((bknr.datastore::*store-verbose* nil) + initial-objects) + (funcall thunk) + (setf initial-objects (object-classes-and-ids)) + (restore) + (test-equal initial-objects (object-classes-and-ids)) + (snapshot) + (restore) + (test-equal initial-objects (object-classes-and-ids)))) (defmacro defdstest (name args &body body) (when args @@ -60,9 +71,7 @@ (make-instance 'datastore-test-class :unit :datastore :name ',name - :body (lambda () - (let ((bknr.datastore::*store-verbose* nil)) - ,@body))))) + :body (lambda () (do-run-test (lambda () ,@body)))))) (defdstest store-setup () (test-assert *store*)) @@ -121,16 +130,26 @@ (defconstant +stress-size+ 10000) (defdstest stress-test () - (format t "Creating ~a objects~%" +stress-size+) + (format t "Creating ~A objects in two threads~%" +stress-size+) (time (bknr.datastore::without-sync () - (dotimes (i +stress-size+) - (make-instance 'store-object)))) - (test-equal (length (all-store-objects)) +stress-size+) - (format t "Delete ~A objects~%" +stress-size+) - (time (bknr.datastore::without-sync () - (map-store-objects #'delete-object))) - (test-equal (all-store-objects) nil)) + (labels ((stress () + (dotimes (i +stress-size+) + (make-instance 'store-object)))) + (let ((threads (list (bt:make-thread #'stress) + (bt:make-thread #'stress)))) + (loop while (some #'bt:thread-alive-p threads) + do (sleep 1)))))) + (test-equal (length (all-store-objects)) (* 2 +stress-size+))) +(defdstest stress-test-2 () + (bknr.datastore::without-sync () + (format t "Creating ~A objects~%" +stress-size+) + (dotimes (i +stress-size+) + (make-instance 'store-object)) + (format t "Deleting ~A objects~%" (length (all-store-objects))) + (time (map-store-objects #'delete-object)) + (test-equal (all-store-objects) nil))) + (defdstest make-instance-in-anon-txn () (with-transaction () (make-instance 'store-object)) @@ -142,11 +161,23 @@ (test-assert (make-instance 'store-object)))) (define-persistent-class parent () - ((child :update :initform nil))) + ((child :update :initform nil :initarg nil))) (define-persistent-class child () ()) +(defun object-classes-and-ids () + "Return a list of conses with the car being a class name and the cdr + being the object id for all persistent objects in the store" + (mapcar (lambda (object) + (cons (class-name (class-of object)) + (store-object-id object))) + (all-store-objects))) + +(defdstest make-referenced-object-in-anon-tx () + (with-transaction (:make) + (make-instance 'parent :child (make-instance 'child)))) + (defdstest serialize-circular-in-anon-txn () (let ((parent (make-instance 'parent))) (with-transaction (:circular) @@ -227,7 +258,19 @@ (test-equal 0 (class-with-transient-slot-slot (find-store-object object-id))) (snapshot) (restore) - (test-equal 0 (class-with-transient-slot-slot (find-store-object object-id))))) + (test-equal 0 (class-with-transient-slot-slot (find-store-object object-id))))) +(define-persistent-class persistent-mixin () + ((mixin-slot :update + :initform 2))) + +(define-persistent-class inherit-multiple (persistent-mixin parent) + ()) + +(defdstest multiple-inheritance-test () + (let* ((o1 (make-instance 'inherit-multiple :child (make-instance 'child))) + (o2 (make-instance 'inherit-multiple :child o1))) + (test-equal o1 (parent-child o2)))) + (defun run-datastore-test (name) - (unit-test:run-test (gethash name *tests*))) \ No newline at end of file + (unit-test:run-test (gethash name *tests*))) Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp 2008-09-21 12:51:48 UTC (rev 3932) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp 2008-09-21 16:51:58 UTC (rev 3933) @@ -39,7 +39,7 @@ (defun store-object-subsystem () (let ((subsystem (find-if (alexandria:rcurry #'typep 'store-object-subsystem) - (store-subsystems *store*)))) + (store-subsystems *store*)))) (unless subsystem (error 'object-subsystem-not-found-in-store :store *store*)) subsystem)) @@ -47,17 +47,8 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (finalize-inheritance (defclass persistent-class (indexed-class) - ((transient-slot-initargs :initform nil - :accessor persistent-class-transient-slot-initargs))))) + ()))) -(defmethod determine-transient-slot-initargs ((class persistent-class)) - (with-slots (transient-slot-initargs) class - (setf transient-slot-initargs nil) - (dolist (slotd (class-slots class)) - (when (and (transient-slot-p slotd) - (slot-definition-initargs slotd)) - (pushnew (car (slot-definition-initargs slotd)) transient-slot-initargs))))) - (defmethod validate-superclass ((sub persistent-class) (super indexed-class)) t) @@ -68,22 +59,16 @@ (when (plusp instance-count) (unless *suppress-schema-warnings* (report-progress "~&; updating ~A instances of ~A for class changes~%" - instance-count class)) + instance-count class)) (mapc #'reinitialize-instance (class-instances class))))) -(defmethod instance :after ((class persistent-class) &rest args) - (declare (ignore args)) - (determine-transient-slot-initargs class)) - -(defmethod reinitialize-instance :after ((class persistent-class) &rest args) - (declare (ignore args)) - (determine-transient-slot-initargs class) +(defmethod reinitialize-instance :after ((class persistent-class) &key) (when (and (boundp '*store*) *store*) (update-instances-for-changed-class (class-name class)) (unless *suppress-schema-warnings* (report-progress "~&; class ~A has been changed. To ensure correct schema ~ evolution, please snapshot your datastore.~%" - (class-name class))))) + (class-name class))))) (defclass persistent-direct-slot-definition (index-direct-slot-definition) ((relaxed-object-reference :initarg :relaxed-object-reference @@ -194,7 +179,7 @@ :slots (id)))) (defun class-instances (class) - (find-class class) ; make sure that the class exists + (find-class class) ; make sure that the class exists (store-objects-with-class class)) (deftransaction store-object-touch (object) @@ -237,21 +222,23 @@ (defmethod initialize-instance :around ((object store-object) &rest initargs &key) (cond ((not (in-transaction-p)) - (let ((transaction (make-instance 'transaction - :function-symbol 'make-instance - :timestamp (get-universal-time) - :args (cons (class-name (class-of object)) initargs)))) - (with-statistics-log (*transaction-statistics* (transaction-function-symbol transaction)) - (with-transaction-log (transaction) - (call-next-method))))) + (with-store-guard () + (let ((transaction (make-instance 'transaction + :function-symbol 'make-instance + :timestamp (get-universal-time) + :args (cons (class-name (class-of object)) + (append (list :id (slot-value object 'id)) + initargs))))) + (with-statistics-log (*transaction-statistics* (transaction-function-symbol transaction)) + (with-transaction-log (transaction) + (call-next-method)))))) ((in-anonymous-transaction-p) - (prog1 - (call-next-method) - (encode (make-instance 'transaction - :function-symbol 'make-instance - :timestamp (transaction-timestamp *current-transaction*) - :args (cons (class-name (class-of object)) initargs)) - (anonymous-transaction-log-buffer *current-transaction*)))) + (encode (make-instance 'transaction + :function-symbol 'make-instance + :timestamp (transaction-timestamp *current-transaction*) + :args (cons (class-name (class-of object)) initargs)) + (anonymous-transaction-log-buffer *current-transaction*)) + (call-next-method)) (t (call-next-method)))) @@ -272,12 +259,12 @@ (funcall (slot-definition-initfunction slotd)))))) (defmethod initialize-instance :after ((object store-object) &key) - ;; This is called only when initially creating the (persistent) - ;; instance, not during restore. During restore, the - ;; INITIALIZE-TRANSIENT-INSTANCE function is called for all - ;; persistent objects after the snapshot has been read, but before - ;; running the transaction log. - (initialize-transient-instance object)) + ;; This is called only when initially creating the (persistent) + ;; instance, not during restore. During restore, the + ;; INITIALIZE-TRANSIENT-INSTANCE function is called for all + ;; persistent objects after the snapshot has been read, but before + ;; running the transaction log. + (initialize-transient-instance object)) (defmethod print-object ((object store-object) stream) (print-unreadable-object (object stream :type t) @@ -345,22 +332,6 @@ ,@(unless metaclass '((:metaclass persistent-class))) ,@class-options)))) -#+nil -(define-persistent-class foo () - ((a :read))) -#+nil -(let ((foo (make-object 'foo :a 2))) - (foo-a foo)) - -;;; test fuer multiple inheritance -#+nil -(progn - (define-persistent-class bar () - ((b :read))) - (define-persistent-class blorg (foo bar) - ((c :read))) - (make-object 'blorg :a 2 :b 3 :c 4)) - ;;; binary snapshot (defvar *current-object-slot* nil) @@ -580,6 +551,12 @@ (let ((*current-object-slot* nil)) (%decode-store-object stream))) +(define-condition invalid-reference (warning) + ((id :initarg :id)) + (:report (lambda (e stream) + (format stream "internal inconsistency during restore - store object with ID ~A could not be found" + (slot-value e 'id))))) + (defun %decode-store-object (stream) ;; This is actually called in two contexts, when a slot-value is to ;; be filled with a reference to a store object and when a list of @@ -595,8 +572,7 @@ ;; lists in slots). (let* ((id (%decode-integer stream)) (object (or (store-object-with-id id) - (warn "internal inconsistency during restore: can't find store object ~A in loaded store" - id))) + (warn 'invalid-reference :id id))) (container (first *current-object-slot*)) (slot-name (second *current-object-slot*))) (cond (object object) @@ -689,13 +665,6 @@ (clear-class-indices class-name))) class-layouts)))))))) -(defun make-object (class-name &rest initargs) - "Make a persistent object of class named CLASS-NAME. Calls MAKE-INSTANCE with INITARGS." - (if (in-transaction-p) - (apply #'make-instance class-name initargs) - (with-store-guard () - (apply #'make-instance class-name initargs)))) - (defun tx-delete-object (id) (destroy-object (store-object-with-id id)))

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/thirdparty/emacs/js2.el
by BKNR Commits 21 Sep '08

21 Sep '08

Revision: 3932 Author: hans URL: http://bknr.net/trac/changeset/3932 add js2-mode version 2008016a A branches/anon-transaction-fixes-2/thirdparty/emacs/js2.el Change set too large, please see URL above

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/
by BKNR Commits 21 Sep '08

21 Sep '08

Revision: 3931 Author: hans URL: http://bknr.net/trac/changeset/3931 Initialized merge tracking via "svnmerge" with revisions "1-3928" from svn+ssh://bknr.net/svn/trunk _U branches/anon-transaction-fixes-2/ Property changes on: branches/anon-transaction-fixes-2 ___________________________________________________________________ Name: svnmerge-integrated + /trunk:1-3928

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/
by BKNR Commits 21 Sep '08

21 Sep '08

Revision: 3930 Author: hans URL: http://bknr.net/trac/changeset/3930 Fixes for anonymous transactions. Objects can be deleted in anonymous transactions now. Generalized and fixed transient slot handling. Added more test cases. U branches/anon-transaction-fixes-2/bknr/datastore/src/bknr.datastore.asd U branches/anon-transaction-fixes-2/bknr/datastore/src/data/blob.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/package.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/txn.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/indices/indexed-class.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/indices/indices.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/utils/class.lisp U branches/anon-transaction-fixes-2/bknr/modules/bknr.modules.asd U branches/anon-transaction-fixes-2/bknr/modules/stats/stats.lisp U branches/anon-transaction-fixes-2/projects/quickhoney/src/daily.lisp Change set too large, please see URL above

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/
by BKNR Commits 21 Sep '08

21 Sep '08

Revision: 3929 Author: hans URL: http://bknr.net/trac/changeset/3929 New branch with fixes for problems in anonymous transactions. A branches/anon-transaction-fixes-2/ Copied: branches/anon-transaction-fixes-2 (from rev 3928, trunk)

1 0

[bknr-cvs] hans changed trunk/projects/pch/src/pch
by BKNR Commits 21 Sep '08

21 Sep '08

Revision: 3928 Author: hans URL: http://bknr.net/trac/changeset/3928 Checkpoint some old changes from weeks ago. U trunk/projects/pch/src/pch.erl U trunk/projects/pch/src/pch_cache_mgr.erl U trunk/projects/pch/src/pch_front.erl Modified: trunk/projects/pch/src/pch.erl =================================================================== --- trunk/projects/pch/src/pch.erl 2008-09-19 06:24:57 UTC (rev 3927) +++ trunk/projects/pch/src/pch.erl 2008-09-21 05:13:44 UTC (rev 3928) @@ -2,16 +2,16 @@ %%% http://www.rsaccon.com/2007/09/mochiweb-erlang-based-webserver-toolkit.html -module(pch). --export([start/0, loop/2, stop/0]). +-export([start/0, stop/0]). -define(HTTP_PORT, 9888). -define(MANAGEMENT_PORT, 9889). start() -> Cache = ets:new(table, [set, public]), - pch_cache_mgr:start(?MANAGEMENT_PORT, Cache), +%% pch_cache_mgr:start(?MANAGEMENT_PORT, Cache), pch_front:start(?HTTP_PORT, Cache). stop() -> - pch_front:stop(), - pch_cache_mgr:stop(). + pch_front:stop(). +%% pch_cache_mgr:stop(). Modified: trunk/projects/pch/src/pch_cache_mgr.erl =================================================================== --- trunk/projects/pch/src/pch_cache_mgr.erl 2008-09-19 06:24:57 UTC (rev 3927) +++ trunk/projects/pch/src/pch_cache_mgr.erl 2008-09-21 05:13:44 UTC (rev 3928) @@ -1,5 +1,5 @@ -module(pch_cache_mgr). --export([start/1, loop/2, stop/0]). +-export([start/2, loop/2, stop/0]). start(Port, Cache) -> mochiweb_http:start([{loop, fun (Req) -> @@ -10,10 +10,30 @@ stop() -> mochiweb_http:stop(?MODULE). +fetch_from_backend(Path) -> + io:format("Fetching ~p~n", [Path]), + {ok, {{_Version, 200, _ReasonPhrase}, Headers, Body}} = + http:request("http://127.0.0.1:8080" ++ Path), + io:format("Got ~p~n", [Headers]), + {ok, Headers, Body}. + +backend_request(Req, Cache) -> + Path = Req:get(path), + case ets:lookup(Cache, Path) of + [{Path, Headers, Body}] -> + io:format("cache HIT for ~p~n", [Path]), + Req:respond({200, Headers, Body}); + _ -> + io:format("cache MISS for ~p~n", [Path]), + {ok, Headers, Body} = fetch_from_backend(Path), + ets:insert(Cache, {Path, Headers, Body}), + Req:respond({200, Headers, Body}) + end. + loop(Req, Cache) -> case Req:get(method) of - M when M =:= 'GET' -> - backend_request(Req, Cache); +%% M when M =:= 'GET' -> +%% backend_request(Req, Cache); _ -> Req:respond({501, [], ""}) end. Modified: trunk/projects/pch/src/pch_front.erl =================================================================== --- trunk/projects/pch/src/pch_front.erl 2008-09-19 06:24:57 UTC (rev 3927) +++ trunk/projects/pch/src/pch_front.erl 2008-09-21 05:13:44 UTC (rev 3928) @@ -1,5 +1,5 @@ -module(pch_front). --export([start/0, loop/2, stop/0]). +-export([start/2, loop/2, stop/0]). start(Port, Cache) -> mochiweb_http:start([{loop, fun (Req) -> @@ -8,26 +8,8 @@ {name, ?MODULE}]). stop() -> - mochiweb_http:stop(?MODULE), + mochiweb_http:stop(?MODULE). -fetch_from_backend(Path) -> - {ok, {{_Version, 200, _ReasonPhrase}, Headers, Body}} = - http:request("http://test.createrainforest.org" ++ Path), - {ok, Headers, Body}. - -backend_request(Req, Cache) -> - Path = Req:get(path), - case ets:lookup(Cache, Path) of - [{Path, Headers, Body}] -> - io:format("cache HIT for ~p~n", [Path]), - Req:respond({200, Headers, Body}); - _ -> - io:format("cache MISS for ~p~n", [Path]), - {ok, Headers, Body} = fetch_from_backend(Path), - ets:insert(Cache, {Path, Headers, Body}), - Req:respond({200, Headers, Body}) - end. - loop(Req, Cache) -> case Req:get(method) of M when M =:= 'GET' ->

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/static/
by BKNR Commits 19 Sep '08

19 Sep '08

Revision: 3927 Author: hans URL: http://bknr.net/trac/changeset/3927 Revert action button box CSS change as it did no good for IE U trunk/projects/quickhoney/website/static/index.css U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/index.css =================================================================== --- trunk/projects/quickhoney/website/static/index.css 2008-09-19 06:24:24 UTC (rev 3926) +++ trunk/projects/quickhoney/website/static/index.css 2008-09-19 06:24:57 UTC (rev 3927) @@ -592,9 +592,6 @@ .buttonbox .button-section-items a { padding: 0px 5px 0px 27px; color: black; -} - -.buttonbox .button-section-items span { vertical-align: -3px; } Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-19 06:24:24 UTC (rev 3926) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-19 06:24:57 UTC (rev 3927) @@ -1675,7 +1675,7 @@ function make_image_action_button(keyword, title, action) { var item = LI({ style: 'background-image: url(' + recolored_image_path(keyword) + ')' }, - A({ href: '#' }, SPAN(null, title))); + A({ href: '#' }, title)); item.onclick = function() { action(); return false; }; return item; }

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/templates/index.xml
by BKNR Commits 19 Sep '08

19 Sep '08

Revision: 3926 Author: hans URL: http://bknr.net/trac/changeset/3926 Commit google admin meta tag U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-09-19 06:23:38 UTC (rev 3925) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-09-19 06:24:24 UTC (rev 3926) @@ -6,6 +6,7 @@ xmlns:bknr="http://bknr.net/" xmlns:quickhoney="http://quickhoney.com/"> <head> + <meta name="verify-v1" content="0lfE42KxaTLpCzUEkuTA7V2a9Ojdwk9BG2XSaZGPaoA=" /> <link rel="stylesheet" href="/static/yui/reset-fonts/reset-fonts.css" /> <link rel="stylesheet" href="/static/quickhoney.css" /> <link rel="stylesheet" href="/static/index.css" />

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/webserver.lisp
by BKNR Commits 19 Sep '08

19 Sep '08

Revision: 3925 Author: hans URL: http://bknr.net/trac/changeset/3925 Remove quickhoney-image-handler, we don't need it. U trunk/projects/quickhoney/src/webserver.lisp Modified: trunk/projects/quickhoney/src/webserver.lisp =================================================================== --- trunk/projects/quickhoney/src/webserver.lisp 2008-09-19 06:16:37 UTC (rev 3924) +++ trunk/projects/quickhoney/src/webserver.lisp 2008-09-19 06:23:38 UTC (rev 3925) @@ -38,7 +38,6 @@ ("/json-news-archive" json-news-archive-handler) ("/json-news" json-news-handler) ("/shutdown" shutdown-handler) - ("/image" quickhoney-image-handler) user images ("/static" directory-handler

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/static/index.css
by BKNR Commits 19 Sep '08

19 Sep '08

Revision: 3924 Author: hans URL: http://bknr.net/trac/changeset/3924 fix news styles U trunk/projects/quickhoney/website/static/index.css Modified: trunk/projects/quickhoney/website/static/index.css =================================================================== --- trunk/projects/quickhoney/website/static/index.css 2008-09-18 17:33:21 UTC (rev 3923) +++ trunk/projects/quickhoney/website/static/index.css 2008-09-19 06:16:37 UTC (rev 3924) @@ -346,7 +346,7 @@ } .newsentry h1 { - margin: 10px 0px 5px 0px; + margin: 10px 0px 10px 0px; font-size: 120%; font-weight: normal; color: #30be01 @@ -356,10 +356,6 @@ margin: 10px 0px 5px 0px; } -.newsentry .item-text { - margin-top: 1em; -} - .autonews { height: 106px; color: #000; border-width: 1px; border-style: solid

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/static/
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3923 Author: hans URL: http://bknr.net/trac/changeset/3923 Fix for Opera and (hopefully) IE. U trunk/projects/quickhoney/website/static/index.css U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/index.css =================================================================== --- trunk/projects/quickhoney/website/static/index.css 2008-09-18 16:57:54 UTC (rev 3922) +++ trunk/projects/quickhoney/website/static/index.css 2008-09-18 17:33:21 UTC (rev 3923) @@ -595,11 +595,13 @@ .buttonbox .button-section-items a { padding: 0px 5px 0px 27px; - vertical-align: -3px; color: black; - line-height: 0; } +.buttonbox .button-section-items span { + vertical-align: -3px; +} + .buttonbox .button-section-items.last { border-bottom-width: 1px; } Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-18 16:57:54 UTC (rev 3922) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-18 17:33:21 UTC (rev 3923) @@ -1675,8 +1675,7 @@ function make_image_action_button(keyword, title, action) { var item = LI({ style: 'background-image: url(' + recolored_image_path(keyword) + ')' }, - A({ href: '#' }, - title)); + A({ href: '#' }, SPAN(null, title))); item.onclick = function() { action(); return false; }; return item; }

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/static/javascript.js
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3922 Author: hans URL: http://bknr.net/trac/changeset/3922 update page title to reflect current navigational position. U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-18 15:38:02 UTC (rev 3921) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-18 16:57:54 UTC (rev 3922) @@ -562,6 +562,8 @@ function show_page(pagename, subpath) { + document.title = "QuickHoney " + pagename + (subpath ? "/" + subpath : ''); + if (!pages[pagename]) { document.location.href = '/'; return false; @@ -1009,7 +1011,7 @@ index = index - 0; // ensure integer query_position = index; current_image = query_result[index]; - + log('display_image index ' + index); overlay_remove();

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/payment-website/templates/da/satmap.xml
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3921 Author: ksprotte URL: http://bknr.net/trac/changeset/3921 /da/satmap.xml new text in danish U trunk/projects/bos/payment-website/templates/da/satmap.xml Modified: trunk/projects/bos/payment-website/templates/da/satmap.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/satmap.xml 2008-09-18 11:56:35 UTC (rev 3920) +++ trunk/projects/bos/payment-website/templates/da/satmap.xml 2008-09-18 15:38:02 UTC (rev 3921) @@ -16,7 +16,7 @@ <tr> <td colspan="2"> <span class="headline"> - Satellite Map + Satellit kort </span> </td> <td align="center" valign="top"> @@ -32,9 +32,9 @@ </tr> <tr> <td colspan="3"> - Take a look at our + Se vores <a shape="rect" title="Satellitenkarte" class="titlegreen" href="javascript:window_infosys()"> - Satellite Map</a>. + Satellit kort</a>. </td> </tr>  @@ -46,7 +46,7 @@ <tr> <td colspan="3"> <span class="headline"> - Visit Samboja Lestari in Google Earth + Besøg Samboja Lestari via Google Earth </span> </td> </tr> @@ -56,12 +56,13 @@ </tr> <tr> <td colspan="3"> - If the Google Earth Software + Når du har installeret Google Earths software <a href='http://earth.google.de/' target='_blank' shape='rect' class='titlegreen'>http://earth.google.de/</a> - is installed on your computer, you can view the project area with - satellite images from 2002 and 2007 plus a lot of additional - information. For an optimal viewing experience, you can also use the - above link to upgrade your Google Earth installation if needed. + på din computer, kan du se et + udvalg af satellitbilleder fra projektområdet fra perioden + 2000 til 2007 plus en masse ekstra information. For + optimale oplevelse kan du, om nødtvendigt, bruge + ovenstående link til at opgradere din Google Earth. </td> </tr> <tr> @@ -70,7 +71,8 @@ </tr> <tr> <td colspan="3"> - Your Google Earth application will be started via the following link: + Din Google Earth applikation vil starte ved hjælp af + flg. link: </td> </tr> <tr>

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/image.lisp
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3920 Author: hans URL: http://bknr.net/trac/changeset/3920 Change image link to not include /index U trunk/projects/quickhoney/src/image.lisp Modified: trunk/projects/quickhoney/src/image.lisp =================================================================== --- trunk/projects/quickhoney/src/image.lisp 2008-09-18 10:25:17 UTC (rev 3919) +++ trunk/projects/quickhoney/src/image.lisp 2008-09-18 11:56:35 UTC (rev 3920) @@ -46,7 +46,7 @@ collect (cadr cat-sub))) (defmethod make-image-link ((image quickhoney-image) &key internal) - (format nil "~@[~A~]/index#~(~A~@[/~A~]~)/~A" + (format nil "~@[~A~]/#~(~A~@[/~A~]~)/~A" (unless internal (format nil "http://~A" (website-host))) (quickhoney-image-category image) (quickhoney-image-subcategory image) (store-image-name image)))

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/handlers.lisp
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3919 Author: hans URL: http://bknr.net/trac/changeset/3919 remove ffffound redirection again, as it does not work because of the caching. U trunk/projects/quickhoney/src/handlers.lisp Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:18:19 UTC (rev 3918) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:25:17 UTC (rev 3919) @@ -23,14 +23,6 @@ (header-out :cache-control) "max-age=15")) (call-next-method)) -;;; redirect users coming from ffffound to the image page. -(defmethod handle-object :before ((handler imageproc-handler) (image quickhoney-image)) - (when (cl-ppcre:scan "^http://ffffound.com/image/" (hunchentoot:header-in* :referer)) - (redirect (format nil "/~(~A/~A~)/~A" - (quickhoney-image-category image) - (quickhoney-image-subcategory image) - (store-image-name image))))) - (defclass random-image-handler (object-handler) ())

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/handlers.lisp
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3918 Author: hans URL: http://bknr.net/trac/changeset/3918 Simplify U trunk/projects/quickhoney/src/handlers.lisp Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:11:50 UTC (rev 3917) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:18:19 UTC (rev 3918) @@ -23,12 +23,8 @@ (header-out :cache-control) "max-age=15")) (call-next-method)) -(defclass quickhoney-image-handler (image-handler) - () - (:documentation "Application dependent image handler with specific - referer based actions.")) - -(defmethod handle-object :before ((handler quickhoney-image-handler) (image quickhoney-image)) +;;; redirect users coming from ffffound to the image page. +(defmethod handle-object :before ((handler imageproc-handler) (image quickhoney-image)) (when (cl-ppcre:scan "^http://ffffound.com/image/" (hunchentoot:header-in* :referer)) (redirect (format nil "/~(~A/~A~)/~A" (quickhoney-image-category image)

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3917 Author: hans URL: http://bknr.net/trac/changeset/3917 Redirect visitors coming to an image from ffffound to the image HTML page. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/webserver.lisp Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 06:12:23 UTC (rev 3916) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-18 10:11:50 UTC (rev 3917) @@ -5,7 +5,7 @@ (defparameter *editable-keywords* '(:explicit :buy-file :buy-print :buy-t-shirt) "List of keywords that are image keywords which can be edited through the CMS") -(defclass quickhoney-image-handler (page-handler) +(defclass quickhoney-image-dependent-handler (page-handler) () (:documentation "Mixin for handlers whose response only depend on quickhoney images. The HANDLE :AROUND method of this handler @@ -16,13 +16,25 @@ single-object handlers. Deletion is not properly handled presently.")) -(defmethod handle :around ((handler quickhoney-image-handler)) +(defmethod handle :around ((handler quickhoney-image-dependent-handler)) (let ((time (last-image-upload-timestamp))) (handle-if-modified-since time) (setf (header-out :last-modified) (rfc-1123-date time) (header-out :cache-control) "max-age=15")) (call-next-method)) +(defclass quickhoney-image-handler (image-handler) + () + (:documentation "Application dependent image handler with specific + referer based actions.")) + +(defmethod handle-object :before ((handler quickhoney-image-handler) (image quickhoney-image)) + (when (cl-ppcre:scan "^http://ffffound.com/image/" (hunchentoot:header-in* :referer)) + (redirect (format nil "/~(~A/~A~)/~A" + (quickhoney-image-category image) + (quickhoney-image-subcategory image) + (store-image-name image))))) + (defclass random-image-handler (object-handler) ()) @@ -41,7 +53,7 @@ (blob-to-stream (quickhoney-animation-image-animation animation) (send-headers))))) -(defclass json-image-info-handler (object-handler quickhoney-image-handler) +(defclass json-image-info-handler (object-handler quickhoney-image-dependent-handler) () (:default-initargs :query-function #'store-image-with-name)) @@ -74,7 +86,7 @@ (with-object-element ("image") (image-to-json image)))) -(defclass json-image-query-handler (object-handler quickhoney-image-handler) +(defclass json-image-query-handler (object-handler quickhoney-image-dependent-handler) ()) (defun images-in-category-sorted-by-time (cat-sub) @@ -216,7 +228,7 @@ (blob-to-stream image s))))) t t)))) -(defclass json-buttons-handler (prefix-handler quickhoney-image-handler) +(defclass json-buttons-handler (prefix-handler quickhoney-image-dependent-handler) ()) (defun preproduced-buttons (category subcategory) Modified: trunk/projects/quickhoney/src/webserver.lisp =================================================================== --- trunk/projects/quickhoney/src/webserver.lisp 2008-09-18 06:12:23 UTC (rev 3916) +++ trunk/projects/quickhoney/src/webserver.lisp 2008-09-18 10:11:50 UTC (rev 3917) @@ -38,6 +38,7 @@ ("/json-news-archive" json-news-archive-handler) ("/json-news" json-news-handler) ("/shutdown" shutdown-handler) + ("/image" quickhoney-image-handler) user images ("/static" directory-handler

1 0

[bknr-cvs] hans changed trunk/bknr/web/src/images/imageproc-handler.lisp
by BKNR Commits 18 Sep '08

18 Sep '08

Revision: 3916 Author: hans URL: http://bknr.net/trac/changeset/3916 When an image is being served unprocessed, send the blob data instead of instantiating the image into memory and then serving it. This way, the original picture quality will be preserved. U trunk/bknr/web/src/images/imageproc-handler.lisp Modified: trunk/bknr/web/src/images/imageproc-handler.lisp =================================================================== --- trunk/bknr/web/src/images/imageproc-handler.lisp 2008-09-17 20:32:10 UTC (rev 3915) +++ trunk/bknr/web/src/images/imageproc-handler.lisp 2008-09-18 06:12:23 UTC (rev 3916) @@ -171,8 +171,13 @@ (error-404)) (defmethod handle-object ((page-handler imageproc-handler) image) - (with-http-response (:content-type (image-content-type (image-type-keyword image))) - (handle-if-modified-since (blob-timestamp image)) - (setf (header-out "Last-Modified") (rfc-1123-date (blob-timestamp image))) - (imageproc image (cdr (decoded-handler-path page-handler))))) + (handle-if-modified-since (blob-timestamp image)) + (setf (header-out :last-modified) (rfc-1123-date (blob-timestamp image))) + (let ((operations (cdr (decoded-handler-path page-handler)))) + (if operations + (imageproc image operations) + (with-http-response (:content-type (image-content-type (image-type-keyword image))) + (setf (header-out :content-length) (blob-size image)) + (with-open-file (blob-data (blob-pathname image) :element-type '(unsigned-byte 8)) + (copy-stream blob-data (send-headers) '(unsigned-byte 8)))))))

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/templates/index.xml
by BKNR Commits 17 Sep '08

17 Sep '08

Revision: 3915 Author: hans URL: http://bknr.net/trac/changeset/3915 Make spider keywords entry field larger. U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-09-17 20:20:54 UTC (rev 3914) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-09-17 20:32:10 UTC (rev 3915) @@ -191,7 +191,7 @@ </span> <br /> Keywords:<br /> - <input type="text" id="upload_keywords" name="spider-keywords" value="" /><br /> + <input type="text" id="upload_keywords" name="spider-keywords" value="" size="60" /><br /> <input type="checkbox" id="explicit" name="explicit" value="1" /> Explicit<br/> <!-- shop disabled for now <input type="checkbox" name="buy-file" value="1"/> Sell as file<br/> @@ -262,7 +262,7 @@ </span> <br /> Keywords:<br /> - <input type="text" id="edit_keywords" name="spider-keywords" value="" /><br /> + <input type="text" id="edit_keywords" name="spider-keywords" value="" size="60" /><br /> <input type="checkbox" id="edit_explicit" name="explicit" value="1" /> Explicit<br/> <!-- shop disabled for now <input type="checkbox" id="edit_buy-file" name="buy-file" value="1"/> Sell as file<br/>

1 0