Revision: 3515 Author: hans URL: http://bknr.net/trac/changeset/3515
Save intermediate state.
U trunk/projects/album-maker/src/make-album.lisp
Modified: trunk/projects/album-maker/src/make-album.lisp =================================================================== --- trunk/projects/album-maker/src/make-album.lisp 2008-07-19 06:10:25 UTC (rev 3514) +++ trunk/projects/album-maker/src/make-album.lisp 2008-07-19 06:10:53 UTC (rev 3515) @@ -2,73 +2,87 @@
(defclass picasa-image (store-image) ((description :initarg :description - :initform "")) + :reader description + :initform "") + (source-url :initarg :source-url + :reader source-url + :initform nil)) (:metaclass persistent-class))
+(defclass picasa-album (store-object) + ((name :initarg :name + :reader name) + (source-url :initarg :source-url + :reader source-url) + (description :initarg :description + :accessor description + :initform "") + (cover-image :initarg :cover-image + :accessor cover-image + :initform nil) + (images :initarg :images + :accessor images + :initform nil)) + (:metaclass persistent-class)) + (defun entity-resolver (pubid sysid) (declare (ignore pubid sysid)) (flexi-streams:make-in-memory-input-stream nil))
-(defun analyze-picasa-album-feed (source) +(defmacro with-feed-items (source &body body) + `(with-xspam-source ,source + (element "rss" + (element "channel" + (one-or-more + (element "item" + ,@body)))))) + +(defun synchronize-picasa-album (source) "Return the list of pictures referenced in the Picasa RSS SOURCE, which can be either a URL or another object accepted by WITH-XSPAM-SOURCE. Returns a list of plists with picture descriptions." - (let (items item) - (with-xspam-source - (if (stringp source) - (drakma:http-request source) - source) - (element "rss" - (element "channel" - (one-or-more - (element "item" - (setf item nil) - (optional - (element "group" - (element "description" - (optional - (text (push :description item) - (push _ item)))) - (one-or-more - (element "content" - (macrolet - ((collect-attribute (attribute-name &optional (parser #'identity)) - "Collect an attribute to the current ITEM + (with-feed-items (if (stringp source) + (drakma:http-request source) + source) + (let (item) + (element "group" ; really media:group + (element "description" + (optional + (text (push :description item) + (push _ item)))) + (one-or-more + (element "content" + (macrolet + ((collect-attribute (attribute-name &optional (parser #'identity)) + "Collect an attribute to the current ITEM plist. Need MACROLET as ATTRIBUTE accepts only literal attribute names." - `(progn - (push ,(intern (string-upcase attribute-name) :keyword) item) - (push (funcall ,parser (attribute ,attribute-name _)) item)))) - (collect-attribute "url") - (collect-attribute "type") - (collect-attribute "width" #'parse-integer) - (collect-attribute "height" #'parse-integer)))))) - (push (nreverse item) items)))))) - (nreverse items))) + `(progn + (push ,(intern (string-upcase attribute-name) :keyword) item) + (push (funcall ,parser (attribute ,attribute-name _)) item)))) + (collect-attribute "url") + (collect-attribute "type") + (collect-attribute "width" #'parse-integer) + (collect-attribute "height" #'parse-integer))))) + (print item))))
(defun picasa-albums (user-name) "Given a Google user name, look up which Albums this user has. Returns a list plists with album information." - (let (items item) - (with-xspam-source (drakma:http-request - (format nil "http://picasaweb.google.com/data/feed/base/user/~A?kind=album&alt=rss&am..." - user-name)) - (element "rss" - (element "channel" - (one-or-more - (element "item" - (setf item nil) - (element "guid" - (text (push :link item) - (push (cl-ppcre:regex-replace "/entry/" _ "/feed/") item))) - (element "group" - (element "title" - (optional - (text (push :title item) - (push _ item))))) - (push (nreverse item) items)))))) - (nreverse items))) + (with-feed-items (drakma:http-request + (format nil "http://picasaweb.google.com/data/feed/base/user/~A?kind=album&alt=rss&am..." + user-name)) + (let (item) + (element "guid" + (text (push :link item) + (push (cl-ppcre:regex-replace "/entry/" _ "/feed/") item))) + (element "group" + (element "title" + (optional + (text (push :title item) + (push _ item))))) + (print item))))
(defun import-images-from-picasa (analyze-results) (dolist (image-args analyze-results)