/usr/share/common-lisp/source/rss/main.lisp is in cl-rss 0.1.1-6.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: main.lisp
;;;; Purpose: Main RSS functions
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Sep 2003
;;;;
;;;; $Id: rss.asd 7061 2003-09-07 06:34:45Z kevin $
;;;; *************************************************************************
(in-package #:rss)
(defclass rss-0.9x-channel ()
((title :accessor title :initform nil)
(link :accessor link :initform nil)
(description :accessor description)
(items :accessor items :initform nil)))
(defclass rss-0.9x-item ()
((title :accessor title :initform nil )
(link :accessor link :initform nil)))
(defvar *sites*
'("http://www.cliki.net/recent-changes.rdf"))
(defun show-sites (&optional (sites *sites*))
(dolist (site sites)
(awhen (rss-site site)
(display-site it))))
(defun display-site (site &key (stream *standard-output*))
(format stream "Site: ~A~%" (title site))
(dolist (item (items site))
(format stream " ~A~%" (title item))))
(defun rss-site (uri)
(multiple-value-bind (body response headers true-uri)
(net.aserve.client:do-http-request uri)
(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)
(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)))
|