1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Main RSS functions
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Sep 2003
10 ;;;; $Id: rss.asd 7061 2003-09-07 06:34:45Z kevin $
11 ;;;; *************************************************************************
15 (defclass rss-0.9x-channel ()
16 ((title :accessor title :initform nil)
17 (link :accessor link :initform nil)
18 (description :accessor description)
19 (items :accessor items :initform nil)))
21 (defclass rss-0.9x-item ()
22 ((title :accessor title :initform nil )
23 (link :accessor link :initform nil)))
26 '("http://www.cliki.net/recent-changes.rdf"))
28 (defun show-sites (&optional (sites *sites*))
30 (awhen (rss-site site)
33 (defun display-site (site &key (stream *standard-output*))
34 (format stream "Site: ~A~%" (title site))
35 (dolist (item (items site))
36 (format stream " ~A~%" (title item))))
39 (multiple-value-bind (body response headers true-uri)
40 (net.aserve.client:do-http-request uri)
41 (declare (ignore true-uri headers))
42 (when (eql 200 response)
43 (with-input-from-string (strm body)
44 (parse-rss-0.9x-stream strm)))))
46 (defun parse-rss-0.9x-file (file)
47 (with-open-file (stream file :direction :input)
48 (parse-rss-0.9x-stream stream)))
50 (defun is-rss-version-supported (attributes)
51 (awhen (position "version" attributes :key #'car :test #'string=)
52 (let ((version (second (nth it attributes))))
53 (= 4 (length version))
54 (string= "0.9" (subseq version 0 3)))))
56 (defun parse-rss-0.9x-stream (stream)
57 (let* ((*package* (find-package 'kmrcl))
58 (tree (remove-from-tree-if
59 (lambda (x) (and (stringp x) (is-string-whitespace x)))
60 (xmls:parse stream :compress-whitespace t))))
61 (unless (and (string= "rss" (first tree))
62 (is-rss-version-supported (second tree)))
63 (return-from parse-rss-0.9x-stream nil))
64 (let* ((content (third tree))
66 (len (length content))
67 (rss (make-instance 'rss-0.9x-channel)))
68 (when (string= "channel" (nth pos content))
70 (while (and (< pos len)
71 (or (string= "title" (car (nth pos content)))
72 (string= "link" (car (nth pos content)))
73 (string= "description" (car (nth pos content)))))
74 (let ((slot (nth pos content)))
76 ((string= "title" (car slot))
77 (setf (title rss) (second slot)))
78 ((string= "link" (car slot))
79 (setf (link rss) (second slot)))
80 ((string= "description" (car slot))
81 (setf (description rss) (second slot)))))
84 (when (string= "item" (car (nth pos content)))
85 (let ((item (make-instance 'rss-0.9x-item)))
86 (dolist (pair (cdr (nth pos content)))
88 ((string= "title" (car pair))
89 (setf (title item) (second pair)))
90 ((string= "links" (car pair))
91 (setf (link item) (second pair)))))
92 (push item (items rss))))
94 (setf (items rss) (nreverse (items rss)))