[bknr-cvs] hans changed trunk/projects/quickhoney/upgrade-stuff/import.lisp

[BKNR Commits]

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

Support db upgrade through just loading this file.

U   trunk/projects/quickhoney/upgrade-stuff/import.lisp

Modified: trunk/projects/quickhoney/upgrade-stuff/import.lisp
===================================================================
--- trunk/projects/quickhoney/upgrade-stuff/import.lisp	2008-09-06 16:33:40 UTC (rev 3820)
+++ trunk/projects/quickhoney/upgrade-stuff/import.lisp	2008-09-06 16:34:27 UTC (rev 3821)
@@ -1,17 +1,17 @@
 (in-package :quickhoney)
 
-(defun replace-image (pathname)
+(defun replace-image (pathname &rest args)
   (handler-case
       (let ((old (store-image-with-name (pathname-name pathname))))
         (when old
           (format t "deleting ~A~%" old)
           (delete-object old))
-        (import-image pathname))
+        (apply #'import-image pathname args))
     (error (e)
       (format t "~&; error importing ~S: ~A~%" pathname e))))
 
 (dolist (name '(#p"type-news.png" #p"type-pixel.png" #p"type-shop.png" #p"type-vector.png"))
-  (import-image name :keywords '(:type)))
+  (replace-image name :keywords '(:type)))
 
 (dolist (pathname '(#P"overlay-close.gif"
                     #P"hey.gif"
@@ -32,7 +32,7 @@
                     #P"pixelcontact.gif"))
   (replace-image pathname))
 
-(import-image #p"news-sep.gif")
+(replace-image #p"news-sep.gif")
 
 (with-transaction (:update-shopping)
   (dolist (image (get-keywords-intersection-store-images '(:photo :shopping)))
@@ -41,6 +41,30 @@
 (mapc #'delete-object (get-keywords-intersection-store-images '(:upload :home :button)))
 (mapc #'delete-object (get-keywords-intersection-store-images '(:clients :nicejobs)))
 
+(defparameter *category-keywords* '(:pixel :vector :news :contact))
+(defparameter *other-keywords* '(:published :upload :import :buy-file :buy-t-shirt :buy-print :explicit :hans :bw))
+
+(with-transaction (:initialize-cat-sub)
+  (dolist (image (class-instances 'quickhoney-image))
+    (let ((cat (first (intersection (store-image-keywords image) *category-keywords*)))
+          (sub (first (set-difference (store-image-keywords image) (append *category-keywords* *other-keywords*)))))
+      (when cat
+        (setf (quickhoney-image-cat-sub image)
+              (if sub
+                  (list cat sub)
+                  (list cat))))
+      (setf (store-image-keywords image)
+            (set-difference (store-image-keywords image) (cons (quickhoney-image-subcategory image)
+                                                               *category-keywords*))))))
+
+(with-transaction (:initialize-owner)
+  (dolist (image (class-instances 'quickhoney-image))
+    (setf (owned-object-owner image)
+          (case (quickhoney-image-category image)
+            (:vector (find-user "p"))
+            (:pixel (find-user "n"))
+            (t (find-user "hans"))))))
+
 (with-transaction (:initialize-news)
   (setf (slot-value (find-rss-channel "quickhoney") 'bknr.rss::items)
         (sort (remove-if (lambda (image)