@@ -36,19 +36,19 @@

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

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

-              )))))))

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

+                ;; (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 ((items sequence) storage)

   (when (next-method-p)

@@ -73,14 +73,15 @@

                      (title alimenta:title)) feed

                                         ; We wrap all errors with our own condition

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

-        (values (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 (copy-seq items) feed-store)

-                                          feed-store

-                                          index)))

+        (values (multiple-value-list

+                 (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 (copy-seq items) feed-store)

+                                           feed-store

+                                           index))))

                 feed-link)))))

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

@@ -104,14 +105,16 @@

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

+    (multiple-value-list

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

+    (yason:with-object ()

+      (yason:encode-slots item)))

   (list (alimenta:title item)

         stream))

@@ -133,9 +136,15 @@

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

     (make-pathname :name id :version nil :type "json")))

-(defclass feed-stream-provider (stream-provider:file-provider)

+(defclass feed-stream-item-provider ()

   ((%item-providers :accessor item-providers :initform (make-hash-table :test 'equal))))

+(defclass feed-stream-provider (stream-provider:file-provider feed-stream-item-provider)

+  ())

+

+(defclass feed-stream-string-provider (stream-provider:string-provider feed-stream-item-provider)

+  ())

+

 (defmethod stream-provider:get-nested-provider ((provider stream-provider:stream-provider) (streamable alimenta:feed))

   (with (items-root (uiop:merge-pathnames* (uiop:pathname-directory-pathname (stream-provider:stream-key provider streamable))

                                            (stream-provider:root provider)))

@@ -173,10 +182,11 @@

       (let* ((item-provider (stream-provider:get-nested-provider stream-provider feed))

              (item-storage-info (map-coalesce (op (store _ item-provider))

                                               items)))

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

+        (let ((yason::*json-output*

+                (make-instance 'yason::json-output-stream

+                               :output-stream s

+                               :indent t)))

           (with-collection (item "items" item-storage-info "metadata" feed)

             (destructuring-bind (title path) item

               (yason:with-object ()

-                (yason:encode-object-elements

-                 "title" title

-                 "path" path)))))))))

+                (yason:encode-object-elements "title" title "path" path)))))))))

@@ -8,12 +8,14 @@

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

   (flet ((make-dirname (timestamp)

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

+           (merge-pathnames

+            (local-time:format-timestring nil

+                                          (local-time:timestamp-minimize-part timestamp

+                                                                              :sec)

+                                          :format +dirname-format+)

+            *feed-base*)))

+    (values (prog1-let ((result (make-dirname timestamp)))

+              (ensure-directories-exist result)))))

 (defun test-feed-list ()

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

@@ -37,30 +39,39 @@

            (ubiquitous:value :feeds)

            :test #'equalp))

+(defmacro lambda* ((&rest args) &body body)

+  (let ((rest-arg (gensym "REST")))

+    `(lambda (,@args &rest ,rest-arg)

+       (declare (ignore ,rest-arg))

+       ,@body)))

+

 (defun safe-pull-feed (feed-url &aux (pop-times 0))

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

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

-           (declare (ignore c))

-           (when (find-restart 'alimenta: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:pop-token))

-                 (continue)))))

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

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

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

-        ;; Why am I decf-ing here?

-        (alimenta:transform feed

-                            (fw.lu:glambda (entity)

-                              (:method (entity))

-                              (:method ((entity alimenta:item))

-                                (setf (alimenta:content entity)

-                                      (html-sanitizer:sanitize (alimenta:content entity))))))

-        (decf pop-times)))))

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

+                 (error (lambda* (c)

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

+                            (cond

+                              ((< pop-times 50)

+                               (incf pop-times)

+                               (format t

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

+                                       pop-times)

+                               (alimenta:pop-token))

+                              (t

+                               (continue)))))))

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

+      ;; Why am I decf-ing here?

+      (alimenta:transform feed

+                          (fw.lu:glambda (entity)

+                            (:method (entity))

+                            (:method ((entity alimenta:item))

+                              (let ((v (alimenta:content entity)))

+                                (when v

+                                  (setf (alimenta:content entity)

+                                        (html-sanitizer:sanitize v)))))))

+      (decf pop-times))))

 (defmacro with-progress-message ((stream before after &optional (error-msg " ERROR~%~4t~a~%")) &body body)

   (once-only (before after stream)

@@ -115,10 +126,10 @@

                               (merge-pathnames path

                                                (stream-provider:root stream-provider)))))

     (handler-bind ((cl+ssl:ssl-error-verify

-                    (lambda (c)

-                      (declare (ignore c))

-                      (format *error-output* "~&SSL Error while pulling ~a~%"

-                              feed-url))))

+                     (lambda (c)

+                       (declare (ignore c))

+                       (format *error-output* "~&SSL Error while pulling ~a~%"

+                               feed-url))))

       (with-simple-restart (skip-feed "Stop processing for ~a" feed-url)

         (let* ((feed (with-retry ("Pull feed again.")

                        (normalize-feed feed-url (log-pull t)))))

@@ -139,7 +150,7 @@

 (defun archive-feeds-nondeterm ()

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

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

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

          (index-path (merge-pathnames "index.json" pull-directory))

          (feed-stream-provider (make-instance 'alimenta.feed-archive.encoders:feed-stream-provider

                                               :if-exists :error

@@ -157,34 +168,44 @@

                      (alimenta:feed-type c)

                      (alimenta:feed-link c))

              (funcall restart))

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

+           (fix-pathname-or-skip (c &key

+                                      (restart 'skip-feed)

+                                      (wrapped-condition nil wc-p))

              (typecase (or wrapped-condition c)

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

-               (otherwise

+               (t

                 (if (find-restart 'fix-pathname)

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

+                    (if (find-restart 'alimenta.pull-feed:skip-feed)

+                        (alimenta.pull-feed:skip-feed c)

+                        (progn

+                          (unless (eq restart 'continue)

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

+                                    (if wc-p

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

+                                        "Unknown")))

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

     (let ((error-count 0))

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

-                      (op (fix-pathname-or-skip _1 :wrapped-condition (alimenta.feed-archive.encoders:the-condition _1))))

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

-                     ((or usocket:timeout-error usocket:ns-error cl+ssl:ssl-error-verify)

-                      (op (alimenta.pull-feed:skip-feed _)))

-                     

-                     (error

-                      (op

-                        (format t "~&Error signaled, ~a (count ~d)" _1 error-count)

-                        (incf error-count)

-                        (unless (< error-count 15)

-                          (format t " continuing~%")

-                          (fix-pathname-or-skip _1 :restart 'continue)))))

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

+      (handler-bind

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

+             (op (fix-pathname-or-skip

+                  _1 :wrapped-condition

+                  (alimenta.feed-archive.encoders:the-condition _1))))

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

+           ((or usocket:timeout-error usocket:ns-error cl+ssl:ssl-error-verify)

+             (op (alimenta.pull-feed:skip-feed _)))

+

+           (error

+             (op

+               (format t "~&Error signaled, ~a (count ~d)"

+                       _1 error-count)

+               (incf error-count)

+               (unless (< error-count 15)

+                 (format t " continuing~%")

+                 (fix-pathname-or-skip _1 :restart 'continue)))))

+        (multiple-value-bind (*feeds* *feed-base*)

+            (funcall feed-list-initializer)

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

             (archive-feeds-nondeterm)))))))

@@ -208,11 +229,11 @@

                 (alexandria:hash-table-values ht2)))))

 (deftest feed-index ()

-    (should be hash-table=

-            (yason:parse

-             (with-output-to-string (s)

-               (feed-index s (local-time:encode-timestamp 0 0 0 0 1 1 1) '()))

-             :object-as :hash-table :json-arrays-as-vectors nil)

-            (alexandria:alist-hash-table

-             '(("pull-time" . "0001-01-01T00:00:00.000000-08:00")

-               ("feeds" . ())))))

+  (should be hash-table=

+          (yason:parse

+           (with-output-to-string (s)

+             (feed-index s (local-time:encode-timestamp 0 0 0 0 1 1 1) '()))

+           :object-as :hash-table :json-arrays-as-vectors nil)

+          (alexandria:alist-hash-table

+           '(("pull-time" . "0001-01-01T00:00:00.000000-08:00")

+             ("feeds" . ())))))

@@ -12,17 +12,18 @@

 (defun make-feed-index (pull-time references)

   (make-instance 'feed-index

-		 :pull-time pull-time

-		 :references (copy-seq references)))

+                 :pull-time pull-time

+                 :references (copy-seq references)))

 (defun make-feed-reference (url &rest feed-data &key title path)

   (declare (ignore title path))

   (apply #'make-instance 'feed-reference

-	 :url url feed-data))

+         :url url

+         feed-data))

 (defmethod yason:encode-slots progn ((object feed-reference))

   (let ((title (title object))

-	(path (path object)))

+        (path (path object)))

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

     (when title

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

@@ -34,4 +35,4 @@

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

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

       (yason:with-array ()

-	(mapcar 'yason:encode-object references)))))

+        (mapcar 'yason:encode-object references)))))

@@ -43,8 +43,7 @@

   (concatenate 'string

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

 	       "-"

-	       (sha256-string (alimenta:id item))

-	       #+nil ".json"))

+	       (sha256-string (alimenta:id item))))

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

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