[bknr-cvs] hans changed trunk/
BKNR Commits
bknr at bknr.net
Fri Aug 1 06:57:30 UTC 2008
Revision: 3716
Author: hans
URL: http://bknr.net/trac/changeset/3716
more news work.
make owned-object have only one instead of multiple owners.
U trunk/bknr/modules/album/album.lisp
U trunk/bknr/web/src/images/image.lisp
U trunk/bknr/web/src/packages.lisp
U trunk/bknr/web/src/rss/rss.lisp
U trunk/bknr/web/src/sysclasses/user.lisp
U trunk/projects/quickhoney/src/handlers.lisp
U trunk/projects/quickhoney/src/quickhoney.asd
U trunk/projects/quickhoney/website/static/javascript.js
Modified: trunk/bknr/modules/album/album.lisp
===================================================================
--- trunk/bknr/modules/album/album.lisp 2008-08-01 06:19:07 UTC (rev 3715)
+++ trunk/bknr/modules/album/album.lisp 2008-08-01 06:57:30 UTC (rev 3716)
@@ -6,7 +6,7 @@
(let* ((user (find-user username))
(images (when user
(remove-if-not #'(lambda (image)
- (member user (owned-object-owners image)))
+ (eq user (owned-object-owner image)))
(get-keyword-store-images
(make-keyword-from-string album))))))
(html (:ul (dolist (image images)
Modified: trunk/bknr/web/src/images/image.lisp
===================================================================
--- trunk/bknr/web/src/images/image.lisp 2008-08-01 06:19:07 UTC (rev 3715)
+++ trunk/bknr/web/src/images/image.lisp 2008-08-01 06:57:30 UTC (rev 3716)
@@ -123,7 +123,7 @@
;; xxx not tx safe.
(let ((store-image (apply #'make-object
class-name
- :owners (list user)
+ :owner user
:timestamp (get-universal-time)
:name name
:type (make-keyword-from-string type)
Modified: trunk/bknr/web/src/packages.lisp
===================================================================
--- trunk/bknr/web/src/packages.lisp 2008-08-01 06:19:07 UTC (rev 3715)
+++ trunk/bknr/web/src/packages.lisp 2008-08-01 06:57:30 UTC (rev 3716)
@@ -136,7 +136,7 @@
#:set-user-last-login
#:owned-object
- #:owned-object-owners
+ #:owned-object-owner
#:store-objects-owned-by
#:store-object-owners
Modified: trunk/bknr/web/src/rss/rss.lisp
===================================================================
--- trunk/bknr/web/src/rss/rss.lisp 2008-08-01 06:19:07 UTC (rev 3715)
+++ trunk/bknr/web/src/rss/rss.lisp 2008-08-01 06:57:30 UTC (rev 3716)
@@ -179,7 +179,7 @@
(:documentation "Add ITEM to CHANNEL. May only be called within
transaction context.")
(:method ((channel rss-channel) item)
- (setf (slot-value channel 'items) (cons item (rss-channel-items channel))))
+ (push item (slot-value channel 'items)))
(:method ((channel string) item)
(aif (find-rss-channel channel)
(add-item it item)
Modified: trunk/bknr/web/src/sysclasses/user.lisp
===================================================================
--- trunk/bknr/web/src/sysclasses/user.lisp 2008-08-01 06:19:07 UTC (rev 3715)
+++ trunk/bknr/web/src/sysclasses/user.lisp 2008-08-01 06:57:30 UTC (rev 3716)
@@ -190,24 +190,23 @@
;;; owned objects
(define-persistent-class owned-object (store-object)
- ((owners :update :initform nil
- :index-type hash-list-index
- :index-reader store-object-owners)))
+ ((owner :update :initform nil
+ :index-type hash-index
+ :index-reader store-object-owner)))
-(deftransaction owned-object-remove-owner (object owner)
- (setf (owned-object-owners object)
- (remove owner (owned-object-owners object))))
+(defmethod convert-slot-value-while-restoring ((object owned-object) (slot-name (eql 'owners)) owners)
+ (when owners
+ (unless (= 1 (length owners))
+ (warn "object ~A has more than one owner ~S, using first" object owners))
+ (setf (slot-value object 'owner) (car owners))))
-(deftransaction owned-object-add-owner (object owner)
- (pushnew owner (owned-object-owners object)))
-
(defgeneric user-owns-object-p (user object))
-(defmethod user-owns-object-p ((user user) object)
+(defmethod user-owns-object-p ((user user) (object t))
nil)
(defmethod user-owns-object-p ((user user) (object owned-object))
- (member user (owned-object-owners object)))
+ (eq user (owned-object-owner object)))
(define-persistent-class message-event (event)
((from :read :initform nil)
Modified: trunk/projects/quickhoney/src/handlers.lisp
===================================================================
--- trunk/projects/quickhoney/src/handlers.lisp 2008-08-01 06:19:07 UTC (rev 3715)
+++ trunk/projects/quickhoney/src/handlers.lisp 2008-08-01 06:57:30 UTC (rev 3716)
@@ -136,7 +136,7 @@
(cl-smtp:with-smtp-mail (smtp "localhost"
"webserver at quickhoney.com"
(remove-duplicates (mapcar #'user-email
- (or (owned-object-owners image)
+ (or (owned-object-owner image)
(list (find-user "n") (find-user "p"))))))
(cl-mime:print-mime
smtp
@@ -438,13 +438,18 @@
(:method ((item t))
; do nothing
)
+ (:method :before ((image quickhoney-image))
+ (when (owned-object-owner image)
+ (encode-object-element "owner" (user-login (owned-object-owner image))))
+ (encode-object-element "date" (format-date-time (blob-timestamp image) :vms-style t :show-time nil))
+ (encode-object-element "name" (store-image-name image)))
(:method ((image quickhoney-image))
(let ((vectorp (member :vector (store-image-keywords image))))
- (encode-object-element "uploader" (if vectorp "Peter" "Nana"))
(encode-object-element "category" (if vectorp "vector" "pixel"))
- (encode-object-element "subcategory" "unknown")
- (encode-object-element "date" (format-date-time (rss-item-pub-date image) :vms-style t :show-time nil))
- (encode-object-element "name" (store-image-name image)))))
+ (encode-object-element "subcategory" "unknown")))
+ (:method ((item quickhoney-news-item))
+ (encode-object-element "title" (quickhoney-news-item-title item))
+ (encode-object-element "text" (quickhoney-news-item-text item))))
(defmethod handle-object ((handler json-news-handler) (channel rss-channel))
(with-json-response ()
Modified: trunk/projects/quickhoney/src/quickhoney.asd
===================================================================
--- trunk/projects/quickhoney/src/quickhoney.asd 2008-08-01 06:19:07 UTC (rev 3715)
+++ trunk/projects/quickhoney/src/quickhoney.asd 2008-08-01 06:57:30 UTC (rev 3716)
@@ -33,7 +33,7 @@
(:file "layout" :depends-on ("config"))
(:file "imageproc" :depends-on ("config"))
(:file "json" :depends-on ("packages"))
- (:file "handlers" :depends-on ("json" "layout" "config" "image"))
+ (:file "handlers" :depends-on ("json" "layout" "config" "image" "news"))
(:file "tags" :depends-on ("image"))
(:file "webserver" :depends-on ("handlers"))
(:file "daily" :depends-on ("config"))
Modified: trunk/projects/quickhoney/website/static/javascript.js
===================================================================
--- trunk/projects/quickhoney/website/static/javascript.js 2008-08-01 06:19:07 UTC (rev 3715)
+++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-01 06:57:30 UTC (rev 3716)
@@ -246,7 +246,7 @@
IMG({ src: "/image/" + item.name + '/cutout-button,,' + color + ',98,4'}),
DIV(null,
H1(null, item.name),
- item.date, ' by ', item.uploader, ' | ',
+ item.date, ' by ', item.owner, ' | ',
A({ href: '/index#' + item.category + '/' + item.subcategory + '/' + item.image_name }, 'permalink'),
BR(),
item.description)),
@@ -461,7 +461,7 @@
function() {
footer_hide();
loadJSONDoc('/json-news-archive/quickhoney').addCallbacks(load_news_archive, alert);
- // load_news();
+ loadJSONDoc('/json-news/quickhoney').addCallbacks(load_news, alert);
});
pages['shop']
More information about the Bknr-cvs
mailing list