@@ -3,8 +3,18 @@ A library for handling RSS/Atom feeds

 The library implements most of the elements in the RSS and Atom specs and handles feed discovery, feed type

 detection and feed pulling as well as feed generation.  It is also fairly easy to extend by subclassing the

 appropriate classes and specializing the generic functions `%to-feed`, `make-item`, `%get-items` and

-`%generate-xml`.

+`generate-xml`.

 It is, however, noticeably incomplete: particularly, not all the useful functions have been exported from the

-packages they reside in.  Also, it relies on code in my fork of chronicity <http://github.com/fiddlerwoaroof/chronicity>

-to handle certain wordpress feeds.

+packages they reside in.  Also, it relies on code in my fork of chronicity

+<http://github.com/fiddlerwoaroof/chronicity> to handle certain wordpress feeds.

+

+There are a couple additional features thrown in:

+

+- server-test.lisp runs a demo web server that pulls a bunch of feeds from reddit and serves them up as a

+  single page website.  It's main reason for existence is to test this library and the library I've been

+  working on for web stuff <http://github.com/fiddlerwoaroof/araneus>

+

+- alimenta-clim.lisp runs a demo graphical application that uses McCLIM

+  <https://github.com/robert-strandh/mcclim> to generate an X application that can be used to navigate an RSS

+  feed.

@@ -8,6 +8,7 @@

                #:lquery

                #:should-test

                #:alexandria

+               #:serapeum

                #:anaphora

                #:chronicity

                #:fwoar.lisputils

@@ -1,39 +1,39 @@

 ;;;; alimenta.lisp

-(declaim (optimize (speed 0) (safety 3) (debug 3)))

+(declaim (optimize (speed 0) (safety 3) (debug 4)))

 (in-package #:alimenta)

+(defgeneric -to-feed (doc type &key feed-link)

+  (:documentation "Given an xml-document, return a feed object"))

+

+(defgeneric generate-xml (feed feed-type &key partial)

+  (:documentation "Given a lisp object representing a feed, return an xml

+                   document"))

+

 (defclass feed () 

-  ((title :initarg :title :initform nil)

-   (link :initarg :link :initform nil)

+  ((description :initarg :description :initform nil :accessor description)

+   (doc :initarg :doc :initform nil :accessor doc)

+   (feed-link :initarg :feed-link :initform nil :accessor feed-link)

    (items :initarg :items :initform nil :accessor items)

-   (description :initarg :description :initform nil)

-   (feed-link :initarg :feed-link :initform nil)

-   (doc :initarg :doc :initform nil)

-   (source-type :initarg :source-type :initform nil)))

+   (link :initarg :link :initform nil :accessor link)

+   (source-type :initarg :source-type :initform nil :accessor source-type)

+   (title :initarg :title :initform nil :accessor title)))

 (defclass item ()

-  ((title :initarg :title :initform nil)

-   (id :initarg :id :initform nil)

-   (author :initarg :author :initform nil)

-   (date :initarg :date :initform nil)

-   (link :initarg :link :initform nil)

-   (links :initform (make-hash-table :test #'equalp))

+  ((author :initarg :author :initform nil :accessor author)

    (content :initarg :content :initform nil :accessor content)

-   (doc :initarg :doc :initform nil)))

+   (date :initarg :date :initform nil :accessor date)

+   (doc :initarg :doc :initform nil :accessor doc)

+   (id :initarg :id :initform nil :accessor id)

+   (link :initarg :link :initform nil :accessor link)

+   (links :initform (make-hash-table :test #'equalp) :accessor links)

+   (title :initarg :title :initform nil :accessor title)))

 (defclass complex-value () ())

 (defgeneric primary-value (self)

-  (:documentation "Primarily for COMPLEX-VALUES: this should take one and return a useful primary value")

-  (:method ((self t)) self))

-

-(define-condition duplicate-link-type (error)

-  ((old :reader duplicate-link-type-old :initarg :old)

-   (new :reader duplicate-link-type-new :initarg :new))

-  (:report (lambda (condition stream)

-             (format stream "Item already has link ~s" (duplicate-link-type-old condition)))))

-

+  (:documentation "Primarily for COMPLEX-VALUES: this should take one and

+                   return a useful primary value"))

 (defgeneric push-item (feed item)

   (:documentation "Adds an item to the feed"))

@@ -41,31 +41,40 @@

 (defgeneric make-item (xml-dom doc-type)

   (:documentation "Given an xml document, return an item"))

-(defgeneric parse-feed (feed))

+(defgeneric parse-feed (feed)

+  (:documentation "Parse a feed into a lisp object"))

+

+(defgeneric get-items (xml feed-type)

+  (:documentation "Given an xml document, extract its items"))

-(defgeneric %get-items (xml feed-type))

+(defmethod primary-value ((self t))

+  self)

-(defgeneric %generate-xml (feed feed-type &key partial))

-(defmethod %generate-xml :around ((feed feed) feed-type &rest r)

+(define-condition duplicate-link-type (error)

+  ((old :reader duplicate-link-type-old :initarg :old)

+   (new :reader duplicate-link-type-new :initarg :new))

+  (:report (lambda (condition stream)

+             (format stream "Item already has link ~s" (duplicate-link-type-old condition)))))

+

+

+(defmethod generate-xml :around ((feed feed) feed-type &rest r)

   (declare (ignore r))

   (let ((result (call-next-method feed feed-type)))

     (with-slots (items) feed

       (loop for item in items

-            do (%generate-xml item feed-type :partial result)))

+            do (generate-xml item feed-type :partial result)))

     result))

-(defgeneric %to-feed (doc type &key feed-link)

-  (:documentation "Given an xml-document, return a feed object"))

-(defmethod %to-feed :around ((xml-dom plump:node) doc-type &key feed-link)

-  "This wraps the particular methods so that _they_ don't have to implement item fetching.

-   NIL passed to the type activates auto-detection"

+(defmethod -to-feed :around ((xml-dom plump:node) doc-type &key feed-link)

+  "This wraps the particular methods so that _they_ don't have to implement

+   item fetching.  NIL passed to the type activates auto-detection"

   (aprog1 (call-next-method xml-dom doc-type :feed-link feed-link)

     (with-slots (doc source-type) it

       (setf doc xml-dom

             source-type doc-type))

     (with-slots (items) it

       (setf

-        items (loop for item across (%get-items xml-dom doc-type)

+        items (loop for item across (get-items xml-dom doc-type)

                     collect (make-item item doc-type))))))

 (defgeneric (setf link) (value self))

@@ -109,50 +118,31 @@

             (t root-node-name)))))

-(defun generate-xml (feed &key (feed-type :rss))

-  (%generate-xml feed feed-type))

+;(defun generate-xml (feed &key (feed-type :rss))

+;  (%generate-xml feed feed-type))

 (defun to-feed (doc &key type feed-link)

-  "Makes an instance of feed from the given document.  Specialize %to-feed with

+  "Makes an instance of feed from the given document.  Specialize to-feed with

    an equal-specializer on type with an appropriate symbol to implement a new

    sort of feed."

   (unless type

     (setf type (detect-feed-type doc)))

-  (%to-feed doc type :feed-link feed-link))

-

-

-(defun get-items (feed xml-dom &key type)

-  (with-slots (items) feed

-    (loop for item across (%get-items xml-dom type)

-          do (push (make-item xml-dom type) items)

-          finally (return items)))) 

-

-(defgeneric feed-to-rss (feed))

-(defgeneric feed-to-atom (feed))

-(defgeneric feed-to-json (feed))

-(defgeneric feed-to-html5 (feed)

-  (:documentation

-    "take a feed object, produce an html5 output.  Simple format:

-     <!DOCTYPE html>

-     <html lang=\"en\">

-     <head>

-       <meta charset=\"UTF-8\">

-       <title>Feed Title</title>

-     </head>

-     <body>

-       <main>

-         <article id=\"id\">

-           <h1>Title</h1>

-           <h2>Author</h2>

-           <span class=\"date\">Date</span>

-           <p>Content</p>

-         </article>

-       </main>

-     </body>

-     </html>"))

+  (-to-feed doc type :feed-link feed-link))

+

+

+;(defun -get-items (feed xml-dom &key type)

+;  (with-slots (items) feed

+;    (loop for item across (get-items xml-dom type)

+;          do (push (make-item xml-dom type) items)

+;          finally (return items)))) 

 (defun make-feed (&key title link items feed-link description)

-  (make-instance 'feed :title title :link link :items items :feed-link feed-link :description description))

+  (make-instance 'feed

+                 :description description

+                 :feed-link feed-link

+                 :items items

+                 :link link

+                 :title title))

 (let ((n 0))

   (defun next-id ()

@@ -169,10 +159,6 @@

   (let ((link (cl-ppcre:regex-replace "^https?:" link "")))

     (subseq link 0 (min 30 (length link)))))

-(defun rdf-to-feed (xml-dom))

-(defun json-to-feed (json-object))

-(defun html5-to-feed (html-dom))

-

 (defmethod push-item ((feed feed) (item item))

   (push item (slot-value feed 'items)))

@@ -33,7 +33,7 @@

 (defun make-person (name &optional uri email)

   (make-instance 'atom-person :name name :uri uri :email email))

-(defmethod alimenta::%get-items (xml-dom (feed-type (eql :atom)))

+(defmethod alimenta::get-items (xml-dom (feed-type (eql :atom)))

   ($ (inline xml-dom) "feed > entry"))

 (defun get-link (xml)

@@ -64,7 +64,7 @@

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

                     (awhen (or item-content item-description) (serialize  (parse it) s)))))

     (make-instance 'atom-item

-		   :doc xml-dom

+         :doc xml-dom

                    :content content

                    :date (local-time:parse-timestring item-date)

                    :id item-guid

@@ -81,9 +81,8 @@

                     ($ (inline author) "> uri" (text) (node))

                     ($ (inline author) "> email" (text) (node))))))

-(defmethod %to-feed (xml-dom (type (eql :atom)) &key feed-link)

-  (declare (ignore type) (ignorable feed-link))

-  ; TODO: store feed-link

+(defmethod alimenta::-to-feed (xml-dom (type (eql :atom)) &key feed-link)

+  (declare (ignore type))

   (flet ((get-feed-elem (selector) ($ (inline xml-dom) selector (text) (node)))

          (get-feed-elem-attr (selector attr) ($ (inline xml-dom) selector (attr attr) (node))))

     (let ((doc-title (get-feed-elem "feed > title"))

@@ -133,7 +132,7 @@

                       (continue c))))

      (defconstants ,@constants)))

-(defmethod %generate-xml ((feed feed) (feed-type (eql :atom)) &key partial)

+(defmethod generate-xml ((feed feed) (feed-type (eql :atom)) &key partial)

   (let ((feed-root (or ($1 (inline partial) "feed")

                     (plump:make-element (plump:make-root) "feed"))))

     (prog1 feed-root

@@ -152,7 +151,7 @@

              )))))

-(defmethod %generate-xml ((item item) (feed-type (eql :atom)) &key partial)

+(defmethod generate-xml ((item item) (feed-type (eql :atom)) &key partial)

   (let ((parent (if (string-equal (tag-name partial) "feed")

                   partial

                   (plump:make-element (plump:make-root) "feed"))))

@@ -244,7 +243,7 @@

 (deftest to-feed ()

   (let ((xml (parse +feed1+)))

-    (symbol-macrolet ((feed (alimenta::%to-feed xml :atom)))

+    (symbol-macrolet ((feed (alimenta::-to-feed xml :atom)))

       (should be equal +feed-title+ (slot-value feed 'alimenta:title))

       (should be equal +feed-link-website+ (slot-value feed 'alimenta:link))

       (should be equal +feed-link-self+ (slot-value feed 'alimenta:feed-link))

@@ -256,7 +255,7 @@

       (should be equal +feed-category-term+

               (slot-value

-                (elt 

+                (elt

                   (slot-value feed 'categories)

                   0)

                 'term))

@@ -297,7 +296,7 @@

 (deftest generate-xml ()

   (let* ((xml ($ (inline (parse +entry1+)) "entry" (node)))

          (item (alimenta::make-item xml :atom)))

-    (symbol-macrolet ((generated-xml (alimenta::%generate-xml item :atom)))

+    (symbol-macrolet ((generated-xml (alimenta::generate-xml item :atom)))

       (should be equal +title+

               ($ (inline generated-xml) "entry > title" (text) (node)))

       (should be equal +author+

@@ -4,6 +4,9 @@

   (:use #:cl #:should-test #:lquery #:plump #:alexandria #:anaphora)

   (:export #:define-data-class))

+(defpackage #:alimenta2

+  (:use #:cl #:alexandria #:serapeam #:fw.lu #:should-test))

+

 (defpackage #:alimenta

   (:use #:cl #:should-test #:lquery #:plump #:alexandria #:anaphora)

   (:export #:to-feed #:generate-xml #:feed #:title #:link #:items #:feed-link

@@ -49,6 +49,7 @@

             (slot-value self 'domain))))

 (defun get-date (str)

+  (declare (optimize (debug 3)))

   (handler-case

     (local-time:parse-timestring str)

     (local-time::invalid-timestring (c) (declare (ignore c))

@@ -59,10 +60,17 @@

                  (minute-offset (if (and res (> (length (elt groups 1)) 3))

                                   (* (signum hour-offset) (parse-integer (elt groups 1) :start 3))

                                   0)))

-            (let-each (:be *)

-              (chronicity:parse timestamp)

-              (local-time:timestamp- * minute-offset :minute)

-              (local-time:timestamp- * hour-offset   :hour))))))))

+            (loop

+              (restart-case (return

+                              (let-each (:be *)

+                                (chronicity:parse timestamp)

+                                (local-time:timestamp- * minute-offset :minute)

+                                (local-time:timestamp- * hour-offset   :hour)))       

+                (pop-token () (setf timestamp

+                                    (subseq timestamp

+                                            0

+                                            (position #\space timestamp

+                                                      :from-end t))))))))))))

 (defmethod primary-value ((self rss-image))

@@ -89,10 +97,10 @@

      (combine (text) (attr "domain"))

      (map-apply #'make-category)))

-(defmethod %get-items (xml-dom (feed-type (eql :rss)))

+(defmethod get-items (xml-dom (feed-type (eql :rss)))

   ($ (inline xml-dom) "channel > item"))

-(defmethod %generate-xml ((item item) (feed-type (eql :rss)) &key partial)

+(defmethod generate-xml ((item item) (feed-type (eql :rss)) &key partial)

   (prog1 partial

     (let ((item-root (make-element ($1 (inline partial) "channel") "item")))

       (flet ((make-element (tag) (make-element item-root tag)))

@@ -106,7 +114,7 @@

             "isPermaLink"

             "false"))))))

-(defmethod %generate-xml ((feed feed) (feed-type (eql :rss)) &rest r)

+(defmethod generate-xml ((feed feed) (feed-type (eql :rss)) &rest r)

   (declare (ignore r))

   (let* ((xml-root (plump:make-root))

          (feed-root (plump:make-element xml-root "rss"))

@@ -163,7 +171,7 @@

           (local-time:parse-timestring "2016-01-09T23:00:00.000000-0100")

           (get-date "Fri, 09 Jan 2016 21:30:00 -0230"))) 

-(defmethod %to-feed (xml-dom (type (eql :rss)) &key feed-link)

+(defmethod alimenta::-to-feed (xml-dom (type (eql :rss)) &key feed-link)

   ; TODO: store feed-link

   (flet ((get-channel-element (el)

            ($ (inline xml-dom) el (text) (node))))