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

[BKNR Commits]

Revision: 3917
Author: hans
URL: http://bknr.net/trac/changeset/3917

Redirect visitors coming to an image from ffffound to the image
HTML page.

U   trunk/projects/quickhoney/src/handlers.lisp
U   trunk/projects/quickhoney/src/webserver.lisp

Modified: trunk/projects/quickhoney/src/handlers.lisp
===================================================================
--- trunk/projects/quickhoney/src/handlers.lisp	2008-09-18 06:12:23 UTC (rev 3916)
+++ trunk/projects/quickhoney/src/handlers.lisp	2008-09-18 10:11:50 UTC (rev 3917)
@@ -5,7 +5,7 @@
 (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")
 
-(defclass quickhoney-image-handler (page-handler)
+(defclass quickhoney-image-dependent-handler (page-handler)
   ()
   (:documentation "Mixin for handlers whose response only depend on
   quickhoney images.  The HANDLE :AROUND method of this handler
@@ -16,13 +16,25 @@
   single-object handlers.  Deletion is not properly handled
   presently."))
 
-(defmethod handle :around ((handler quickhoney-image-handler))
+(defmethod handle :around ((handler quickhoney-image-dependent-handler))
   (let ((time (last-image-upload-timestamp)))
     (handle-if-modified-since time)
     (setf (header-out :last-modified) (rfc-1123-date time)
           (header-out :cache-control) "max-age=15"))
   (call-next-method))
 
+(defclass quickhoney-image-handler (image-handler)
+  ()
+  (:documentation "Application dependent image handler with specific
+  referer based actions."))
+
+(defmethod handle-object :before ((handler quickhoney-image-handler) (image quickhoney-image))
+  (when (cl-ppcre:scan "^http://ffffound.com/image/" (hunchentoot:header-in* :referer))
+    (redirect (format nil "/~(~A/~A~)/~A"
+                      (quickhoney-image-category image)
+                      (quickhoney-image-subcategory image)
+                      (store-image-name image)))))
+
 (defclass random-image-handler (object-handler)
   ())
 
@@ -41,7 +53,7 @@
       (blob-to-stream (quickhoney-animation-image-animation animation)
                       (send-headers)))))
 
-(defclass json-image-info-handler (object-handler quickhoney-image-handler)
+(defclass json-image-info-handler (object-handler quickhoney-image-dependent-handler)
   ()
   (:default-initargs :query-function #'store-image-with-name))
 
@@ -74,7 +86,7 @@
     (with-object-element ("image")
       (image-to-json image))))
 
-(defclass json-image-query-handler (object-handler quickhoney-image-handler)
+(defclass json-image-query-handler (object-handler quickhoney-image-dependent-handler)
   ())
 
 (defun images-in-category-sorted-by-time (cat-sub)
@@ -216,7 +228,7 @@
                               (blob-to-stream image s)))))
        t t))))
 
-(defclass json-buttons-handler (prefix-handler quickhoney-image-handler)
+(defclass json-buttons-handler (prefix-handler quickhoney-image-dependent-handler)
   ())
 
 (defun preproduced-buttons (category subcategory)

Modified: trunk/projects/quickhoney/src/webserver.lisp
===================================================================
--- trunk/projects/quickhoney/src/webserver.lisp	2008-09-18 06:12:23 UTC (rev 3916)
+++ trunk/projects/quickhoney/src/webserver.lisp	2008-09-18 10:11:50 UTC (rev 3917)
@@ -38,6 +38,7 @@
                                         ("/json-news-archive" json-news-archive-handler)
                                         ("/json-news" json-news-handler)
                                         ("/shutdown" shutdown-handler)
+                                        ("/image" quickhoney-image-handler)
 					user
 					images
 					("/static" directory-handler