@@ -1,2 +1,6 @@

-all:

+all: ccl

+

+sbcl:

 	sbcl --load deploy.lisp

+ccl:

+	ccl --load deploy.lisp

@@ -1,4 +1,8 @@

 (load (truename "~/quicklisp/setup.lisp"))

 (push "/home/edwlan/github_repos/alimenta-feed-archive/" asdf:*central-registry*)

 (ql:quickload :alimenta-feed-archive)

-(save-lisp-and-die "feed-archiver" :executable t :toplevel #'alimenta.feed-archive::command-line-main)

+(#+ccl ccl:save-application

+ #+sbcl save-lisp-and-die

+ "feed-archiver"

+ #+sbcl :executable  #+ccl :prepend-kernel t

+ #+sbcl :toplevel #+ccl :toplevel-function #'alimenta.feed-archive::command-line-main)

@@ -9,19 +9,19 @@

   ;; 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)))

+(define-condition feed-error (error)

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

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

+

+(defun wrap-condition (condition feed)

+  (error 'feed-error

+	 :feed feed

+	 :condition condition))

+

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

   (with-accessors ((description alimenta:description)

 		   (feed-link alimenta:feed-link)

@@ -35,22 +35,32 @@

       (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))))))))

+              ;; (format t "~&I Store Info: ~a~%~4t~a~%" (uiop:unix-namestring (cadr item)) root-dir)

+	      (%encode-item root-dir item)

+	      #+null

+              (yason:encode-array-element (uiop:unix-namestring (uiop:enough-pathname root-dir (cadr 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)))))

+(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)))

-(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"))))

+(defun sort-and-filter-items (feed)

+  (setf (alimenta:items feed)

+	(stable-sort

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

+			  :key #'alimenta:date)

+	       #'string-lessp

+	       :key #'alimenta:title)

+	 #'local-time:timestamp>

+	 :key #'alimenta:date)))

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

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

@@ -63,6 +73,7 @@

 		     (link alimenta:link)

 		     (source-type alimenta:source-type)

 		     (title alimenta:title)) feed

+      ; We wrap all errors with our own condition

       (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)))

@@ -73,12 +84,40 @@

 				  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)))

+(defmethod store ((feed alimenta:feed) (stream stream))

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

+			  (typecase c

+			    (feed-error c)

+			    (t (wrap-condition c feed))))))

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

+      (yason:with-object ()

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

+	  (yason:encode-object feed))

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

+	  (yason:with-array ()

+	    (for:for ((item over feed))

+	      (store item stream))))))))

+

+(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))))))

+

+(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 :version nil :type "json") 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 ((item alimenta:item) (stream stream))

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

+    (yason:encode-object item)))

@@ -21,8 +21,8 @@

 (defun test-feed-list ()

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

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

-	    "http://feeds.feedburner.com/GamasutraColumns/")

+	    "https://www.codinghorror.com/blog/index.xml"

+	    "https://sancrucensis.wordpress.com/feed/")

 	  #p"/tmp/feed-archive/"))

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

@@ -40,8 +40,9 @@

 	   :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."

+  "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))

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

 	     (declare (ignore c))

@@ -52,24 +53,31 @@ and modifies the format to something chronicity can handle."

 				  pop-times)

 			  (alimenta.rss::pop-token))

 		   (continue)))))

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

+      (handler-bind ((warning #'muffle-warning)

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

+	(format t "~&Tring to pull: ~a... " feed-url)

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

 	  ;; Why am I decf-ing here?

+	  (format t "... Success~%" feed-url)

 	  (decf pop-times))))))

 (defun skip-feed ()

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

     (invoke-restart restart)))

+(defun pull-and-store-feeds (feeds pull-directory)

+  (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)))))

+

 (defun archive-feeds ()

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

     (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))))))

+	   (paths (pull-and-store-feeds *feeds* pull-directory)))

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

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

 	  (yason:with-object ()

@@ -90,16 +98,33 @@ and modifies the format to something chronicity can handle."

 			paths)))))))))

+;; This is an ungodly mess, we need to avoid funneling everything through fix-pathname-or-skip

 (defun command-line-main (&optional (feed-list-initializer #'init-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))))

+  (declare (optimize (debug 3)))

+  (labels ((feed-type-unsupported (c &key (restart 'skip-feed))

+	     (format t "~&Feed type unsupported: ~a for feed ~a~%"

+		     (alimenta:feed-type c)

+		     (alimenta:feed-link c))

+	     (funcall restart))

+	   (fix-pathname-or-skip (c &key (restart 'skip-feed) (wrapped-condition nil wc-p))

+	     (let ((wrapped-condition (or wrapped-condition c)))

+	       (typecase wrapped-condition

+		 (alimenta:feed-type-unsupported (feed-type-unsupported))

+		 (otherwise

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

+		      (progn (fix-pathname)

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

+		      (progn (unless (eq restart 'continue)

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

+				       (if wc-p

+					   (alimenta.feed-archive.encoders::the-feed c)

+					   "Unknown")))

+			     (funcall restart))))))))

+

+    (handler-bind ((alimenta.feed-archive.encoders::feed-error

+		    (lambda (c) (fix-pathname-or-skip c :wrapped-condition (alimenta.feed-archive.encoders::the-condition c))))

+		   (alimenta:feed-type-unsupported #'feed-type-unsupported)

+		   (error (lambda (c) (fix-pathname-or-skip c :restart 'continue))))

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

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

 	  (archive-feeds))))))

@@ -50,7 +50,7 @@

 	       (local-time:format-timestring nil (alimenta:date item))

 	       "-"

 	       (sha256-string (alimenta:id item))

-	       ".json"))

+	       #+nil ".json"))

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

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

@@ -28,7 +28,7 @@

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

     (yason:encode-object feed)))

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

+(defmethod yason:encode-slots progn ((item alimenta:item))

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

 		   (content alimenta:content)

 		   (date alimenta:date)

@@ -36,13 +36,16 @@

 		   (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)))))

+      (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)))))

+

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

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

+    (yason:encode-slots item))

   item)