main.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          main.lisp
   6 ;;;; Purpose:       Main RSS functions
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Sep 2003
   9 ;;;;
  10 ;;;; $Id: rss.asd 7061 2003-09-07 06:34:45Z kevin $
  11 ;;;; *************************************************************************
  12
  13 (in-package #:rss)
  14
  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)))
  20
  21 (defclass rss-0.9x-item ()
  22   ((title :accessor title :initform nil )
  23    (link :accessor link :initform nil)))
  24
  25 (defvar *sites*
  26     '("http://www.cliki.net/recent-changes.rdf"))
  27
  28 (defun show-sites (&optional (sites *sites*))
  29   (dolist (site sites)
  30     (awhen (rss-site site)
  31            (display-site it))))
  32
  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))))
  37
  38 (defun rss-site (uri)
  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)))))
  45
  46 (defun parse-rss-0.9x-file (file)
  47   (with-open-file (stream file :direction :input)
  48     (parse-rss-0.9x-stream stream)))
  49
  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)))))
  55
  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))
  65            (pos 0)
  66            (len (length content))
  67            (rss (make-instance 'rss-0.9x-channel)))
  68       (when (string= "channel" (nth pos content))
  69         (incf pos)
  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)))
  75             (cond
  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)))))
  82           (incf pos)))
  83       (while (< pos len)
  84         (when (string= "item" (car (nth pos content)))
  85           (let ((item (make-instance 'rss-0.9x-item)))
  86             (dolist (pair (cdr (nth pos content)))
  87               (cond
  88                ((string= "title" (car pair))
  89                 (setf (title item) (second pair)))
  90                ((string= "link" (car pair))
  91                 (setf (link item) (second pair)))))
  92             (push item (items rss))))
  93         (incf pos))
  94       (setf (items rss) (nreverse (items rss)))
  95       rss)))
  96
  97
  98
  99
 100
 101