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@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']