X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=main.lisp;h=44fd7885797981e5662e23deb6077cfd9bc908c2;hb=eec332475db44c58ac7c1b228243f44f8472fbc3;hp=fb93f7d4098e495730d70a613fbf72abbd1a47af;hpb=34a0917a07e7a6e3c20b58939e655c7f7066356e;p=cl-rss.git diff --git a/main.lisp b/main.lisp index fb93f7d..44fd788 100644 --- a/main.lisp +++ b/main.lisp @@ -12,15 +12,30 @@ (in-package #:rss) -(defclass rss-0.9x-channel () - ((title :accessor title :initform nil) - (link :accessor link :initform nil) - (description :accessor description) +(defclass rss-channel () + ((title :reader title) + (link :reader link) + (description :reader description :initform nil) + (language :reader language :initform nil) + (image :reader image :initform nil) + (pub-date :reader pub-date :initform nil) + (last-build-date :reader last-build-date :initform nil) + (items :accessor items :initform nil))) -(defclass rss-0.9x-item () - ((title :accessor title :initform nil ) - (link :accessor link :initform nil))) +(defclass rss-item () + ((title :reader title) + (link :reader link) + (description :reader description :initform nil) + (pub-date :reader pub-date :initform nil))) + +(defclass rss-image () + ((url :reader url) + (title :reader title) + (link :reader link) + (width :reader width :initform nil) + (height :reader height :initform nil) + (description :reader description :initform nil))) (defvar *sites* '("http://www.cliki.net/recent-changes.rdf")) @@ -28,7 +43,7 @@ (defun show-sites (&optional (sites *sites*)) (dolist (site (mklist sites)) (awhen (rss-site site) - (display-site it)))) + (display-site it)))) (defun display-site (site &key (stream *standard-output*)) (format stream "Site: ~A~%" (title site)) @@ -41,61 +56,166 @@ (declare (ignore true-uri headers)) (when (eql 200 response) (with-input-from-string (strm body) - (parse-rss-0.9x-stream strm))))) - -(defun parse-rss-0.9x-file (file) + (parse-rss-stream strm))))) + +(defun parse-rss-file (file) (with-open-file (stream file :direction :input) - (parse-rss-0.9x-stream stream))) - -(defun is-rss-version-supported (attributes) - (awhen (position "version" attributes :key #'car :test #'string=) - (let ((version (second (nth it attributes)))) - (= 4 (length version)) - (string= "0.9" (subseq version 0 3))))) - -(defun parse-rss-0.9x-stream (stream) - (let* ((*package* (find-package 'kmrcl)) - (tree (remove-from-tree-if - (lambda (x) (and (stringp x) (is-string-whitespace x))) - (xmls:parse stream :compress-whitespace t)))) - (unless (and (string= "rss" (first tree)) - (is-rss-version-supported (second tree))) - (return-from parse-rss-0.9x-stream nil)) - (let* ((content (third tree)) - (pos 0) - (len (length content)) - (rss (make-instance 'rss-0.9x-channel))) - (when (string= "channel" (nth pos content)) - (incf pos) - (while (and (< pos len) - (or (string= "title" (car (nth pos content))) - (string= "link" (car (nth pos content))) - (string= "description" (car (nth pos content))))) - (let ((slot (nth pos content))) - (cond - ((string= "title" (car slot)) - (setf (title rss) (second slot))) - ((string= "link" (car slot)) - (setf (link rss) (second slot))) - ((string= "description" (car slot)) - (setf (description rss) (second slot))))) - (incf pos))) - (while (< pos len) - (when (string= "item" (car (nth pos content))) - (let ((item (make-instance 'rss-0.9x-item))) - (dolist (pair (cdr (nth pos content))) - (cond - ((string= "title" (car pair)) - (setf (title item) (second pair))) - ((string= "link" (car pair)) - (setf (link item) (second pair))))) - (push item (items rss)))) - (incf pos)) - (setf (items rss) (nreverse (items rss))) - rss))) - - - - - - + (parse-rss-stream stream))) + +(defun is-rss-version-supported (version-string) + (and (member version-string '("0.91" "0.92" "2.0") :test #'string=) t)) + +(define-condition rss-parse-error (error) + ((msg :initarg :msg :reader msg)) + (:documentation "Thrown when PARSE-RSS-STREAM encounters invalid RSS data.") + (:report + (lambda (condition stream) + (format stream "Parse error reading RSS~@[. ~A~]" (msg condition))))) + +(define-condition rss-version-unsupported (rss-parse-error) + ((version :initarg :version :reader version)) + (:documentation + "Thrown when PARSE-RSS-STREAM encounters RSS of a version it doesn't +recognise.") + (:report + (lambda (condition stream) + (format stream "Unexpected RSS version: ~S" (version condition))))) + +(defmacro string=-case (keyform (&rest cases) &optional &body otherwise) + "A version of CASE that tests using string=." + (let ((key (gensym)) (expected)) + `(let ((,key ,keyform)) + (cond + ,@(mapcar + (lambda (form) + (destructuring-bind (string &body body) form + (unless (stringp string) + (error "Can only deal with strings as keys.")) + (push string expected) + `((string= ,string ,key) ,@body))) + cases) + (t + ,@otherwise))))) + +(defun setf-unique-slot (object name value) + "Set the slot with the given NAME in OBJECT to VALUE, throwing an error if it +was already set." + (when (and (slot-boundp object name) (slot-value object name)) + (error 'rss-parse-error + :msg (format nil "<~A> should only be specified once in the node." + name))) + (setf (slot-value object name) value)) + +(defun setf-unique-string (object name node) + "Set the slot with the given NAME in OBJECT to the string contents of NODE, +throwing an error if it was already set, or if they aren't a string. Used for +elements like