[bknr-cvs] hans changed trunk/

[BKNR Commits]

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

Last minute deployment changes for Quickhoney.

U   trunk/bknr/web/src/images/image.lisp
U   trunk/projects/quickhoney/src/handlers.lisp
U   trunk/projects/quickhoney/src/init.lisp
U   trunk/projects/quickhoney/src/webserver.lisp
U   trunk/projects/quickhoney/upgrade-stuff/import.lisp

Modified: trunk/bknr/web/src/images/image.lisp
===================================================================
--- trunk/bknr/web/src/images/image.lisp	2008-09-16 14:27:23 UTC (rev 3904)
+++ trunk/bknr/web/src/images/image.lisp	2008-09-16 14:30:16 UTC (rev 3905)
@@ -166,7 +166,7 @@
                  (directory-recursive pathname :list-directories list-directories)))
 
 (defun import-directory (pathname &key user keywords (spool *user-spool-directory-root*)
-			 keywords-from-dir (class-name 'store-image))
+			 keywords-from-dir (class-name 'store-image) (delete-files t))
   "Import all files from directory by giving them relative names"
   (let ((path-spool (cdr (pathname-directory spool))))
     (unless (subdir-p pathname spool)

Modified: trunk/projects/quickhoney/src/handlers.lisp
===================================================================
--- trunk/projects/quickhoney/src/handlers.lisp	2008-09-16 14:27:23 UTC (rev 3904)
+++ trunk/projects/quickhoney/src/handlers.lisp	2008-09-16 14:30:16 UTC (rev 3905)
@@ -551,3 +551,9 @@
             (encode-array-element (first month))
             (encode-array-element (second month))))))))
 
+(defclass shutdown-handler (admin-only-handler page-handler)
+  ())
+
+(defmethod handle ((handler shutdown-handler))
+  (hunchentoot:stop-server hunchentoot:*server*)
+  "Shutting down HTTP server")
\ No newline at end of file

Modified: trunk/projects/quickhoney/src/init.lisp
===================================================================
--- trunk/projects/quickhoney/src/init.lisp	2008-09-16 14:27:23 UTC (rev 3904)
+++ trunk/projects/quickhoney/src/init.lisp	2008-09-16 14:30:16 UTC (rev 3905)
@@ -30,11 +30,14 @@
      (cl-gd::load-gd-glue)))
   (ensure-directories-exist
    (setf tbnl:*tmp-directory* (merge-pathnames "hunchentoot-tmp/" *store-directory*)))
-  #+cmu
   (actor-start (make-instance 'cron-actor))
   (publish-quickhoney)
   (when (probe-file "site-config.lisp")
     (format t "; loading site configuration file~%")
     (let ((*package* (find-package :quickhoney.config)))
       (load "site-config.lisp")))
-  (hunchentoot:start-server :port *webserver-port*))
+  (bt:make-thread (curry #'hunchentoot:start-server
+                         :port *webserver-port*
+                         :threaded nil
+                         :persistent-connections-p nil)
+                  :name (format nil "HTTP server on port ~A" *webserver-port*)))

Modified: trunk/projects/quickhoney/src/webserver.lisp
===================================================================
--- trunk/projects/quickhoney/src/webserver.lisp	2008-09-16 14:27:23 UTC (rev 3904)
+++ trunk/projects/quickhoney/src/webserver.lisp	2008-09-16 14:30:16 UTC (rev 3905)
@@ -37,6 +37,7 @@
                                         ("/digg-image" digg-image-handler)
                                         ("/json-news-archive" json-news-archive-handler)
                                         ("/json-news" json-news-handler)
+                                        ("/shutdown" shutdown-handler)
 					user
 					images
 					("/static" directory-handler

Modified: trunk/projects/quickhoney/upgrade-stuff/import.lisp
===================================================================
--- trunk/projects/quickhoney/upgrade-stuff/import.lisp	2008-09-16 14:27:23 UTC (rev 3904)
+++ trunk/projects/quickhoney/upgrade-stuff/import.lisp	2008-09-16 14:30:16 UTC (rev 3905)
@@ -118,4 +118,8 @@
   (dolist (pathname (directory (merge-pathnames #P"**/*.*" directory-pathname)))
     (if (member (pathname-type pathname) '(:png :gif :jpg) :test #'string-equal)
         (import-or-update-image pathname)
-        (warn "Ignoring file ~A with unknown extension" pathname))))
\ No newline at end of file
+        (warn "Ignoring file ~A with unknown extension" pathname))))
+
+(defun clean-pixel-images ()
+  (mapc #'delete-object (images-in-category '(:pixel :editorial)))
+  (mapc #'delete-object (images-in-category '(:pixel :parts))))
\ No newline at end of file