[bknr-cvs] hans changed trunk/projects/album-maker/src/make-album.lisp

BKNR Commits bknr at bknr.net
Sat Jul 19 06:10:54 UTC 2008


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"
+            , at 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&access=public"
-                                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&access=public"
+                            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)




More information about the Bknr-cvs mailing list