@@ -1 +1,3 @@

 .*.sw?

+.[#]*

+[#]*#

@@ -14,5 +14,6 @@

   :serial t

   :components ((:file "tools")

 	       (:file "yason-encoders")

+	       (:file "encoders")

 	       (:file "feed-archive")))

new file mode 100644

@@ -0,0 +1,84 @@

+(defpackage :alimenta.feed-archive.encoders

+  (:use :cl :alexandria :serapeum :fw.lu :alimenta.feed-archive.tools)

+  (:shadowing-import-from :alimenta.feed-archive.tools :->)

+  (:export :skip-item))

+

+(in-package :alimenta.feed-archive.encoders)

+

+(defun fix-path (path)

+  ;; Work around some issue with pathnames

+  (setf path (merge-pathnames path (make-pathname :type :unspecific))))

+

+(defun %encode-item (root-dir item)

+  (destructuring-bind (title path) item

+    (format t "~&Encoding ~a~%" title)

+    (restart-once (fix-pathname () (fix-path path))

+      (let ((pathname (uiop:enough-pathname path root-dir)))

+	(yason:with-object ()

+	  (yason:encode-object-element "title" title)

+	  (yason:encode-object-element "path" pathname))))))

+

+(defun skip-item ()

+  (when-let ((restart (find-restart 'skip-item)))

+    (invoke-restart restart)))

+

+(defun %encode-feed-as-json (feed item-storage-info root-dir &optional stream)

+  (with-accessors ((description alimenta:description)

+		   (feed-link alimenta:feed-link)

+		   (items alimenta:items)

+		   (link alimenta:link)

+		   (source-type alimenta:source-type)

+		   (title alimenta:title)) feed)

+  (yason:with-output (stream :indent t)

+    (yason:with-object ()

+      (yason:encode-object-element "metadata" feed)

+      (yason:with-object-element ("items")

+	(yason:with-array ()

+	  (dolist (item item-storage-info)

+	    (with-simple-restart (skip-item "Skip item ~s" (car item))

+	      (%encode-item root-dir item))))))))

+

+(defmethod store ((item alimenta:item) (directory pathname))

+  (flet ((get-item-store-name (item directory)

+	   (let ((id (get-id item)))

+	     (merge-pathnames (make-pathname :name id) directory))))

+

+    (prog1-let ((item-title (alimenta:title item))

+		(fn (get-item-store-name item directory)))

+      (with-open-file (item-f fn :direction :output)

+	(yason:encode item item-f)))))

+

+(define-condition feed-error (error)

+  ((%feed :initarg :feed :initform (error "We need a feed"))

+   (%condition :initarg :condition :initform (error "feed-error must wrap a condition"))))

+

+(defmethod store ((feed alimenta:feed) (directory pathname))

+  (flet ((get-feed-store-name (feed directory)

+	   (merge-pathnames (get-id feed)

+			    directory)))

+

+    (with-accessors ((description alimenta:description)

+		     (feed-link alimenta:feed-link)

+		     (items alimenta:items)

+		     (link alimenta:link)

+		     (source-type alimenta:source-type)

+		     (title alimenta:title)) feed

+      (handler-bind ((error (lambda (c) (error 'feed-error :feed feed :condition c))))

+	(prog1-let ((feed-title title)

+		    (feed-store (get-feed-store-name feed directory)))

+	  (ensure-directories-exist feed-store)

+	  (with-open-file (index (merge-pathnames "index.json" feed-store) :direction :output)

+	    (%encode-feed-as-json feed

+				  (store items feed-store)

+				  feed-store

+				  index)))))))

+

+(defmethod store ((items sequence) (directory pathname))

+  (map 'list (lambda (item) (store item directory))

+       (stable-sort

+	(sort (remove-if #'older-than-a-week items :key #'alimenta:date)

+	      #'string-lessp

+	      :key #'alimenta:title)

+	#'local-time:timestamp>

+	:key #'alimenta:date)))

+

@@ -12,100 +12,13 @@

 (defun get-store-directory-name (timestamp)

   (flet ((make-dirname (timestamp)

-	   (merge-pathnames (local-time:format-timestring nil (local-time:timestamp-minimize-part timestamp :sec)

-							  :format +dirname-format+)

-			    *feed-base*)))

+	   (-> (local-time:format-timestring nil (local-time:timestamp-minimize-part timestamp :sec)

+					     :format +dirname-format+)

+	       (merge-pathnames *feed-base*))))

     (-> (prog1-let ((result (make-dirname timestamp)))

 	  (ensure-directories-exist result))

 	(car))))

-(defun %encode-item (root-dir item)

-  (let ((restarted nil))

-    (destructuring-bind (title path) item

-      (tagbody start

-	 (format t "~&Restarted: ~a" restarted)

-	 (when restarted

-	   (format t " ~a~%"(namestring path)))

-	 (restart-case

-	     (progn (format t "~&encoding . . .~%")

-		    (let ((pathname (uiop:enough-pathname path root-dir)))

-		      (yason:with-object ()

-			(yason:encode-object-element "title" title)

-			(yason:encode-object-element "path" pathname))))

-	   (fix-pathname ()

-	     (setf path

-		   (merge-pathnames path

-				    (make-pathname :type :unspecific)))

-	     (unless restarted

-	       (setf restarted t)

-	       (go start))))))))

-

-(defun encode-feed-as-json (feed item-storage-info root-dir &optional stream)

-  (with-accessors ((description alimenta:description)

-		   (feed-link alimenta:feed-link)

-		   (items alimenta:items)

-		   (link alimenta:link)

-		   (source-type alimenta:source-type)

-		   (title alimenta:title)) feed)

-  (yason:with-output (stream :indent t)

-    (yason:with-object ()

-      (yason:encode-object-element "metadata" feed)

-      (yason:with-object-element ("items")

-	(yason:with-array ()

-	  (dolist (item item-storage-info)

-	    (with-simple-restart (continue "Skip item ~s" (car item))

-	      (%encode-item root-dir item))))))))

-

-(defmethod store ((item alimenta:item) directory)

-  (prog1-let ((item-title (alimenta:title item))

-	      (fn (get-item-store-name item directory)))

-    (with-open-file (item-f fn :direction :output)

-      (yason:encode item item-f))))

-

-(defmethod store ((feed alimenta:feed) directory)

-  (with-accessors ((description alimenta:description)

-		   (feed-link alimenta:feed-link)

-		   (items alimenta:items)

-		   (link alimenta:link)

-		   (source-type alimenta:source-type)

-		   (title alimenta:title)) feed

-    (prog1-let ((feed-title title)

-		(feed-store (get-feed-store-name feed directory)))

-      (ensure-directories-exist feed-store)

-      (with-open-file (index (merge-pathnames "index.json" feed-store) :direction :output)

-	(encode-feed-as-json feed

-			     (store items feed-store)

-			     feed-store

-			     index)))))

-

-(defmethod store ((items sequence) directory)

-  (map 'list (lambda (item) (store item directory))

-       (stable-sort

-         (sort (remove-if #'older-than-a-week items :key #'alimenta:date)

-             #'string-lessp

-             :key #'alimenta:title)

-         #'local-time:timestamp>

-         :key #'alimenta:date)))

-

-(defmethod yason:encode ((item alimenta:item) &optional stream)

-  (with-accessors ((author alimenta::author)

-                   (content alimenta:content)

-                   (date alimenta:date)

-                   (id alimenta:id)

-                   (link alimenta:link)

-                   (title alimenta:title)) item

-    (let* ((date (local-time:format-timestring nil date)))

-      (yason:with-output (stream :indent t)

-	(yason:with-object ()

-	  (yason:encode-object-element "title" title)

-	  (yason:encode-object-element "date" date)

-	  (yason:encode-object-element "author" title)

-	  (yason:encode-object-element "id" (princ-to-string id))

-	  (yason:encode-object-element "link" link)

-	  (yason:encode-object-element "content" content)))))

-  item)

-

-

 (defun test-feed-list ()

   (values '("http://feeds.feedburner.com/GamasutraFeatureArticles/"

 	    "http://feeds.feedburner.com/GamasutraNews/"

@@ -115,72 +28,79 @@

 (defun init-feeds (&key feed-list archive-root)

   (ubiquitous:restore 'alimenta.feed-archiver)

   (let ((default-root (or archive-root

-                          (merge-pathnames ".feed-archive/"

-                                           (truename "~/")))))

+			  (merge-pathnames ".feed-archive/"

+					   (truename "~/")))))

     (values (ubiquitous:defaulted-value feed-list :feeds)

-            (ubiquitous:defaulted-value default-root :archive :root))))

+	    (ubiquitous:defaulted-value default-root :archive :root))))

 (defun add-feed (feed)

   (init-feeds)

   (pushnew feed

-           (ubiquitous:value :feeds)

-           :test #'equalp))

+	   (ubiquitous:value :feeds)

+	   :test #'equalp))

 (defun safe-pull-feed (feed-url)

+  "Handles date parsing errors in the feed: chronicity won't parse certain date formats, this catches the error 

+and modifies the format to something chronicity can handle."

   (let ((pop-times 0))

-    (handler-bind

-      ((condition

-         (lambda (c) c

-           (when (find-restart 'alimenta.rss::pop-token) 

-             (if (< pop-times 50)

-               (progn (incf pop-times)

-                      (format t "~&Processing error, trying to pop a token (popped ~d times)~%"

-                              pop-times)

-                      (alimenta.rss::pop-token))

-               (progn

-                 (break)

-                 (continue)))))))

-      (prog1 (alimenta.pull-feed:pull-feed feed-url)

-        (decf pop-times)))))

+    (flet ((pop-50-tokens (c)

+	     (declare (ignore c))

+	     (when (find-restart 'alimenta.rss::pop-token) 

+	       (if (< pop-times 50)

+		   (progn (incf pop-times)

+			  (format t "~&Processing error, trying to pop a token (popped ~d times)~%"

+				  pop-times)

+			  (alimenta.rss::pop-token))

+		   (continue)))))

+      (handler-bind ((error #'pop-50-tokens))

+	(prog1 (alimenta.pull-feed:pull-feed feed-url)

+	  ;; Why am I decf-ing here?

+	  (decf pop-times))))))

+

+(defun skip-feed ()

+  (when-let ((restart (find-restart 'skip-feed)))

+    (invoke-restart restart)))

 (defun archive-feeds ()

   (let ((pull-time (local-time:now)))

-    (alimenta.pull-feed::with-user-agent ("Feed Archiver v0.1b")

-      (let* ((pull-directory (get-store-directory-name pull-time)) 

-	     (paths (loop for feed-url in *feeds* collect

-			 (with-simple-restart (continue "Skip ~a" feed-url)

-			   (let ((feed (safe-pull-feed feed-url)))

-			     (setf (alimenta:feed-link feed)

-				   feed-url)

-			     (store feed pull-directory))))))

-	(with-open-file (index (merge-pathnames "index.json" pull-directory) :direction :output)

-	  (yason:with-output (index :indent t)

-	    (yason:with-object ()

-	      (yason:encode-object-element "pull-time" (local-time:format-timestring nil pull-time))

-	      (yason:encode-object-element "feed-urls" *feeds*)

-	      (yason:with-object-element ("feeds")

-		(yason:with-array ()

-		  (mapcar (lambda (url feed-data)

-			    (yason:with-object ()

-			      (yason:encode-object-element "url" url)

-			      (when feed-data

-				(destructuring-bind (title path) feed-data

-				  (yason:encode-object-element "title" title)

-				  (yason:encode-object-element "path"

-							       (princ-to-string

-								(uiop:enough-pathname path *feed-base*)))))))

-			  *feeds*

-			  paths))))))))))

+    (let* ((pull-directory (get-store-directory-name pull-time)) 

+	   (paths (loop for feed-url in *feeds* collect

+		       (with-simple-restart (skip-feed "Skip ~a" feed-url)

+			 (let ((feed (safe-pull-feed feed-url)))

+			   (setf (alimenta:feed-link feed)

+				 feed-url)

+			   (store feed pull-directory))))))

+      (with-open-file (index (merge-pathnames "index.json" pull-directory) :direction :output)

+	(yason:with-output (index :indent t)

+	  (yason:with-object ()

+	    (yason:encode-object-element "pull-time" (local-time:format-timestring nil pull-time))

+	    (yason:encode-object-element "feed-urls" *feeds*)

+	    (yason:with-object-element ("feeds")

+	      (yason:with-array ()

+		(mapcar (lambda (url feed-data)

+			  (yason:with-object ()

+			    (yason:encode-object-element "url" url)

+			    (when feed-data

+			      (destructuring-bind (title path) feed-data

+				(yason:encode-object-element "title" title)

+				(yason:encode-object-element "path"

+							     (princ-to-string

+							      (uiop:enough-pathname path *feed-base*)))))))

+			*feeds*

+			paths)))))))))

 (defun command-line-main (&optional (feed-list-initializer #'init-feeds))

-  (handler-bind ((error (lambda (c)

-		      c

-		      (format t "~&CONDITION RECEIVED: ~S~%RESTARTS: ~s~%" c (compute-restarts c))

-		      (if (find-restart 'fix-pathname)

-			  (fix-pathname)

-			  (progn (format t "~&Skip a feed...~%")

-				 (continue))))))

-    (multiple-value-bind (*feeds* *feed-base*) (funcall feed-list-initializer)

-      (archive-feeds))))

+  (flet ((fix-pathname-or-continue (c)

+	   (declare (ignorable c))

+	   (format t "~&Received condition ~s~%" c)

+	   (if (find-restart 'fix-pathname)

+	       (progn (fix-pathname)

+		      (format t "~&Fixing pathname...~%"))

+	       (progn (format t "~&Skipping a feed...~%")

+		      (continue)))))

+    (handler-bind ((error (lambda (c) (fix-pathname-or-continue c))))

+      (multiple-value-bind (*feeds* *feed-base*) (funcall feed-list-initializer)

+	(alimenta.pull-feed::with-user-agent ("Feed Archiver v0.1b")

+	  (archive-feeds))))))

@@ -2,7 +2,7 @@

   (:use :cl :alexandria :serapeum :fw.lu)

   (:shadow :->)

   (:export :fix-pathname :sha256-string :get-id :older-than-a-week :-> :get-feed-store-name

-	   :store :get-item-store-name))

+	   :store :get-item-store-name :restart-once))

 (in-package :alimenta.feed-archive.tools)

@@ -52,16 +52,22 @@

 	       (sha256-string (alimenta:id item))

 	       ".json"))

-(defun get-item-store-name (item directory)

-  (let ((id (get-id item)))

-    (merge-pathnames (make-pathname :name id) directory)))

-

-(defun get-feed-store-name (feed directory)

-  (merge-pathnames (get-id feed)

-                   directory))

-

 (defun older-than-a-week (date)

   (let ((week-ago (local-time:timestamp- (local-time:now)

                                          7 :day)))

     (local-time:timestamp< date week-ago)))

+(defmacro restart-once ((restart-name (&rest restart-args) &body handler) &body body)

+  "Defines a restart that, the first time it's executed, runs a chunk of code and then,

+next time, it re-raises the exception."

+  (with-gensyms (start restarted)

+    `(let ((,restarted nil))

+       (tagbody ,start

+	  (restart-case

+	      (progn ,@body)

+	    (,restart-name ,restart-args

+	      ,@handler

+	      (unless ,restarted

+		(setf ,restarted t)

+		(go ,start))))))))

+

@@ -28,3 +28,21 @@

   (yason:with-output (stream :indent t)

     (yason:encode-object feed)))

+(defmethod yason:encode ((item alimenta:item) &optional stream)

+  (with-accessors ((author alimenta::author)

+		   (content alimenta:content)

+		   (date alimenta:date)

+		   (id alimenta:id)

+		   (link alimenta:link)

+		   (title alimenta:title)) item

+    (let* ((date (local-time:format-timestring nil date)))

+      (yason:with-output (stream :indent t)

+	(yason:with-object ()

+	  (yason:encode-object-element "title" title)

+	  (yason:encode-object-element "date" date)

+	  (yason:encode-object-element "author" title)

+	  (yason:encode-object-element "id" (princ-to-string id))

+	  (yason:encode-object-element "link" link)

+	  (yason:encode-object-element "content" content)))))

+  item)

+