Revision: 3823 Author: hans URL: http://bknr.net/trac/changeset/3823
Put category and subcategory into slot of quickhoney-image for better performance.
U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/image.lisp U trunk/projects/quickhoney/src/money.lisp U trunk/projects/quickhoney/src/news.lisp U trunk/projects/quickhoney/src/quickhoney.asd
Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-06 16:38:25 UTC (rev 3823) @@ -24,7 +24,7 @@ ())
(defmethod object-handler-get-object ((handler random-image-handler)) - (random-elt (get-keywords-intersection-store-images (mapcar #'make-keyword-from-string (decoded-handler-path handler))))) + (random-elt (images-in-category (mapcar #'make-keyword-from-string (decoded-handler-path handler)))))
(defmethod handle-object ((handler random-image-handler) store-image) (redirect (format nil "/image/~A" (store-object-id store-image)))) @@ -44,14 +44,19 @@ (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")
+(defun images-in-category-sorted-by-time (cat-sub) + (sort (copy-list (images-in-category cat-sub)) + #'> :key #'blob-timestamp)) + (defmethod object-handler-get-object ((handler json-image-query-handler)) - (sort (remove-if-not (lambda (object) (subtypep (type-of object) 'quickhoney-image)) - (get-keywords-intersection-store-images (mapcar #'make-keyword-from-string (decoded-handler-path handler)))) - #'< :key #'blob-timestamp)) + (images-in-category-sorted-by-time (mapcar #'make-keyword-from-string (decoded-handler-path handler))))
(defmethod image-to-json ((image quickhoney-image)) (with-json-object () (encode-object-element "name" (store-image-name image)) + (encode-object-element "category" (quickhoney-image-category image)) + (when (quickhoney-image-subcategory image) + (encode-object-element "subcategory" (quickhoney-image-subcategory image))) (encode-object-element "id" (store-object-id image)) (encode-object-element "type" (image-content-type (blob-mime-type image))) (encode-object-element "width" (store-image-width image)) @@ -195,28 +200,25 @@ (defclass json-buttons-handler (prefix-handler quickhoney-image-handler) ())
-(defun images-sorted-by-time (&rest keywords) - (sort (remove-if-not (rcurry #'subtypep 'quickhoney-image) - (get-keywords-intersection-store-images keywords) - :key #'type-of) - #'> - :key #'blob-timestamp)) - (defun preproduced-buttons (category subcategory) (let ((images (get-keywords-intersection-store-images (list category subcategory :button)))) (when images (cons :buttons images))))
+(defun images-in-all-subcategories-sorted-by-time (category) + (sort (apply #'append (mapcar (lambda (cat-sub) + (when (eq category (car cat-sub)) + (copy-list (images-in-category cat-sub)))) + (all-categories))) + #'> :key #'blob-timestamp)) + (defun newest-images (category subcategory) - (let ((images (apply #'images-sorted-by-time - (append (unless (eq :home category) - (list category)) - (unless (eq :browseall subcategory) - (list subcategory)))))) + (let ((images (if (eq :home category) + (images-in-all-subcategories-sorted-by-time subcategory) + (images-in-category-sorted-by-time (list category subcategory))))) (when images (cons :images images))))
- (defmethod handle ((handler json-buttons-handler)) (with-json-response () (with-object-element ("buttons") @@ -252,9 +254,7 @@
(defmethod handle ((handler upload-image-handler)) (with-query-params (client spider-keywords) - (let ((uploaded-file (request-uploaded-file "image-file")) - (keywords (append (mapcar #'make-keyword-from-string (decoded-handler-path handler)) - (image-keywords-from-request-parameters)))) + (let ((uploaded-file (request-uploaded-file "image-file"))) (handler-case (progn (unless uploaded-file @@ -271,8 +271,9 @@ (cl-gd:true-color-to-palette)) (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) :class-name 'quickhoney-image - :keywords (cons :upload keywords) - :initargs (list :client client + :keywords (cons :upload (image-keywords-from-request-parameters)) + :initargs (list :cat-sub (mapcar #'make-keyword-from-string (decoded-handler-path handler)) + :client client :spider-keywords spider-keywords)))) (with-http-response () (with-http-body () @@ -321,8 +322,9 @@ (cl-gd:true-color-to-palette)) (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) :class-name 'quickhoney-news-item - :keywords (list :upload :news) - :initargs (list :title title + :keywords (list :upload) + :initargs (list :cat-sub (list :news) + :title title :text text)))) (with-http-response () (with-http-body () @@ -370,8 +372,10 @@ (image (make-store-image :name (pathname-name (upload-original-filename uploaded-image)) :type (make-keyword-from-string (pathname-type (upload-original-filename uploaded-image))) :class-name 'quickhoney-animation-image - :keywords (list :upload :pixel :animation) - :initargs `(:client ,client :animation ,animation-blob)))) + :keywords (list :upload) + :initargs (list :cat-sub (list :pixel :animation) + :client client + :animation animation-blob)))) (with-http-response () (with-http-body () (html (:html @@ -418,9 +422,9 @@ (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) :type (make-keyword-from-string (pathname-type (upload-original-filename uploaded-file))) :class-name 'store-image - :keywords (list :button - (make-keyword-from-string directory) - (make-keyword-from-string subdirectory))))) + :keywords (list :button) + :initargs (list :cat-sub (list (make-keyword-from-string directory) + (make-keyword-from-string subdirectory)))))) (with-http-response () (with-http-body () (html (:html @@ -463,6 +467,8 @@ (encode-object-element "name" (store-image-name image))) (:method ((image quickhoney-image)) (encode-object-element "type" "upload") + (encode-object-element "category" (quickhoney-image-category image)) + (encode-object-element "subcategory" (quickhoney-image-subcategory image)) (with-object-element ("keywords") (with-json-array () (dolist (keyword (store-image-keywords image)) @@ -490,10 +496,10 @@ (with-object-element ("months") (with-json-array () (dolist (month (sort (rss-channel-archived-months channel) - (lambda (a b) - (if (= (first a) (first b)) - (> (second a) (second b)) - (> (first a) (first b)))))) + (lambda (a b) + (if (= (first a) (first b)) + (> (second a) (second b)) + (> (first a) (first b)))))) (with-json-array () (encode-array-element (first month)) (encode-array-element (second month))))))))
Modified: trunk/projects/quickhoney/src/image.lisp =================================================================== --- trunk/projects/quickhoney/src/image.lisp 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/image.lisp 2008-09-06 16:38:25 UTC (rev 3823) @@ -1,12 +1,22 @@ (in-package :quickhoney)
(define-persistent-class quickhoney-image (store-image rss-item) - ((client :update :initform nil - :index-type hash-index :index-initargs (:test #'equal) - :index-reader images-for-client - :index-keys all-clients) - (spider-keywords :update :initform nil) - (products :update :initform nil))) + ((client :update + :initform nil + :index-type hash-index :index-initargs (:test #'equal) + :index-reader images-for-client + :index-keys all-clients) + (cat-sub :update + :initform nil + :index-type hash-index :index-initargs (:test #'equal) + :index-reader images-in-category + :index-keys all-categories + :documentation + "Category this image belongs to, as a list of one or two keywords") + (spider-keywords :update + :initform nil) + (products :update + :initform nil)))
(defvar *last-image-upload-timestamp* 0)
@@ -23,11 +33,18 @@ (get-keywords-intersection-store-images '(:import))))
(defmethod quickhoney-image-category ((image quickhoney-image)) - (first (intersection (store-image-keywords image) '(:pixel :vector :news :contact)))) + (car (quickhoney-image-cat-sub image)))
(defmethod quickhoney-image-subcategory ((image quickhoney-image)) - (first (set-difference (store-image-keywords image) '(:pixel :vector :news :button :contact :published :upload)))) + (cadr (quickhoney-image-cat-sub image)))
+(defun subcategories-of (category) + (loop + for cat-sub in (all-categories) + when (and (eq category (car cat-sub)) + (cadr cat-sub)) + collect (cadr cat-sub))) + (defmethod make-image-link ((image quickhoney-image) &key internal) (format nil "~@[~A~]/index#~(~A~@[/~A~]~)/~A" (unless internal
Modified: trunk/projects/quickhoney/src/money.lisp =================================================================== --- trunk/projects/quickhoney/src/money.lisp 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/money.lisp 2008-09-06 16:38:25 UTC (rev 3823) @@ -1,4 +1,4 @@ -(in-package :quickhoney) +(in-package :shop)
(defclass money () ((currency :initarg :currency
Modified: trunk/projects/quickhoney/src/news.lisp =================================================================== --- trunk/projects/quickhoney/src/news.lisp 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/news.lisp 2008-09-06 16:38:25 UTC (rev 3823) @@ -7,12 +7,11 @@ (member :explicit (store-image-keywords image)))
(defmethod rss-item-encoded-content ((image quickhoney-image)) - (let* ((category (first (intersection (store-image-keywords image) '(:vector :pixel)))) - (is-vector (eq category :vector))) + (let ((is-vector (eq (quickhoney-image-category image) :vector))) (with-output-to-string (s) (html-stream s - ((:div :class (format nil "newsentry news_~(~A~)" category)) + ((:div :class (format nil "newsentry news_~(~A~)" (quickhoney-image-category image))) ((:img :src (format nil "http://~A/image/~A" (website-host) (store-object-id image)))
Modified: trunk/projects/quickhoney/src/quickhoney.asd =================================================================== --- trunk/projects/quickhoney/src/quickhoney.asd 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/quickhoney.asd 2008-09-06 16:38:25 UTC (rev 3823) @@ -37,4 +37,9 @@ (:file "tags" :depends-on ("image")) (:file "webserver" :depends-on ("handlers")) (:file "daily" :depends-on ("config")) + + (:file "money" :depends-on ("packages")) + (:file "shop" :depends-on ("money")) + (:file "quickhoney-shop" :depends-on ("shop")) + (:file "init" :depends-on ("webserver" "daily"))))