Revision: 3956 Author: hans URL: http://bknr.net/trac/changeset/3956
Do not display :nudes or :explicit images on home page
U trunk/projects/quickhoney/src/handlers.lisp
Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-24 11:01:30 UTC (rev 3955) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-24 13:45:25 UTC (rev 3956) @@ -61,7 +61,8 @@ (encode-object-element "height" (store-image-height image)) (encode-object-element "client" (or (quickhoney-image-client image) "")) (when (typep image 'quickhoney-animation-image) - (encode-object-element "animation_type" (image-content-type (blob-mime-type (quickhoney-animation-image-animation image))))) + (encode-object-element "animation_type" + (image-content-type (blob-mime-type (quickhoney-animation-image-animation image))))) (when (quickhoney-image-spider-keywords image) (encode-object-element "spider_keywords" (quickhoney-image-spider-keywords image))) (with-object-element ("keywords") @@ -173,12 +174,16 @@ (:default-initargs :object-class 'quickhoney-image))
(defmethod handle-object ((handler digg-image-handler) (image quickhoney-image)) - (with-query-params (from text) + (with-query-params (from to text) (cl-smtp:with-smtp-mail (smtp "localhost" "webserver@quickhoney.com" - (if (owned-object-owner image) - (list (user-email (owned-object-owner image))) - (mapcar (alexandria:compose #'user-email #'find-user) (list "n" "p")))) + (cond + ((and to (length to)) + (list to)) + ((owned-object-owner image) + (list (user-email (owned-object-owner image)))) + (t + (mapcar (alexandria:compose #'user-email #'find-user) (list "n" "p"))))) (cl-mime:print-mime smtp (make-instance @@ -233,7 +238,10 @@
(defun newest-images (category subcategory) (let ((images (if (eq :home category) - (images-in-all-subcategories-sorted-by-time subcategory) + (remove-if (lambda (image) + (or (eq :nudes (quickhoney-image-subcategory image)) + (find :explicit (store-image-keywords image)))) + (images-in-all-subcategories-sorted-by-time subcategory)) (images-in-category-sorted-by-time (list category subcategory))))) (when images (cons :images (loop with since = (- (get-universal-time) (* 60 60 24 14))