[bknr-cvs] hans changed trunk/projects/quickhoney/src/handlers.lisp

[BKNR Commits]

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 at 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))