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)