git.fiddlerwoaroof.com
Raw Blame History
(in-package :alimenta.feed-archive)

(defun directory-for-timestamp (timestamp)
  (let* ((rounded (local-time:timestamp-minimize-part timestamp :sec))
         (formatted (local-time:format-timestring nil rounded
                                                  :format +dirname-format+)))
    (values (parse-namestring formatted))))

(defun ensure-store-directory (timestamp base)
  (prog1-let ((result (merge-pathnames (directory-for-timestamp timestamp)
                                       base)))
    (ensure-directories-exist result)))

(defun test-feed-list ()
  (values '("http://feeds.feedburner.com/GamasutraFeatureArticles/"
            "http://feeds.feedburner.com/undergroundthomist/yCSy"
            "https://www.codinghorror.com/blog/index.xml")
          #p"/tmp/feed-archive/"))

(defun init-feeds (&key feed-list archive-root)
  (ubiquitous:restore 'alimenta.feed-archiver)
  (let ((default-root (or archive-root
                          (merge-pathnames ".feed-archive/"
                                           (truename "~/")))))
    (values (ubiquitous:defaulted-value feed-list :feeds)
            (ubiquitous:defaulted-value default-root :archive :root))))

(defun add-feed (feed)
  (init-feeds)
  (pushnew feed
           (ubiquitous:value :feeds)
           :test #'equalp))
(defun append-feed (feed)
  (init-feeds)
  (setf (ubiquitous:value :feeds)
        (append (remove feed (ubiquitous:value :feeds)
                        :test 'equalp)
                (list feed))))

(defun archive-feeds-nondeterm ()
  (let* ((pull-time (local-time:now))
         (pull-directory (ensure-store-directory pull-time *feed-base*))
         (index-path (merge-pathnames "index.json" pull-directory))
         (feed-stream-provider (make-instance 'alimenta.feed-archive.encoders:feed-stream-provider
                                              :if-exists :error
                                              :root pull-directory)))
    (with-open-file (index index-path :direction :output)
      (archive-feeds pull-time
                     feed-stream-provider
                     index))
    (format t "~&!! pull-directory ~a~%" (uiop:enough-pathname pull-directory *feed-base*))))

;; 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))
  (labels ((feed-type-unsupported (c)
             (format t "~&Feed type unsupported: ~a for feed ~a~%"
                     (alimenta:feed-type c)
                     (alimenta:feed-link c))
             (skip-feed c))
           (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))
               (t
                (if (find-restart 'fix-pathname c)
                    (fix-pathname)
                    (if (find-restart 'alimenta.pull-feed:skip-feed c)
                        (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
               (format t "~&~2t~%Feed Error?~%")
               (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
                usocket:socket-error
                cl+ssl:ssl-error-verify
                storage-condition
                type-error
                plump-dom:invalid-xml-character)
             (op
               (format t "~&Error pulling feed, skipping: ~s~%" _1)
               (skip-feed _1)))

           (error
             (op
               (format t "~&Error signaled, ~s (count ~d)"
                       _1 error-count)
               (incf error-count)
               (when (< error-count 15)
                 (format t " continuing~%")
                 (skip-feed _1)))))
        (multiple-value-bind (*feeds* *feed-base*)
            (funcall feed-list-initializer)
          (alimenta.pull-feed:with-user-agent ("Feed Archiver v0.1b")
            (archive-feeds-nondeterm)))))))