sample-rss-parser.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(defparameter *depend-on* '(:dexador :cxml))

(eval-when (:execute)
  (dolist (target *depend-on*)
    (ql:quickload target)))

(defstruct rss-element
  :title
  :link
  :date
  :description)

#|
(1 2 3) -> (1 2 3)
(1 . 2) -> (1 2)
|#
(defun make-nil-tail-list (list)
  (labels ((f (result rest)
             (let ((head (car rest))
                   (tail (cdr rest)))
               (if (null tail)
                   (cons head result)
                   (if (listp tail)
                       (f (cons head result) tail)
                       (cons tail (cons head result)))))))
    (reverse (f nil list))))

(defun find-lists-recursively (condition list)
  (labels ((f (result rest)
             (assert (listp rest))
             (when (funcall condition rest)
               (setf result (cons rest result)))
             (when (listp (cdr rest))
               (dolist (elem (make-nil-tail-list rest))
                 (if (and (listp elem)
                          (not (null elem)))
                     (setf result (f result elem)))))
             result))
    (reverse (f nil list))))

; find like (("header-name" . "hoge") "fuga")
(defun find-headered-lists (header-name list)
  (find-lists-recursively #'(lambda (lst)
                             (let ((head (car lst)))
                               (and (listp head)
                                    (equal header-name (car head)))))
                         list))

; (defparameter *test-target* "http://www.4gamer.net/rss/index.xml")
(defparameter *test-target* "http://rss.rssad.jp/rss/impresswatch/pcwatch.rdf")

(defun main (&rest argv)
  (declare (ignorable argv))
  (let ((xmls-list (cxml:parse-stream (dex:get *test-target* :want-stream t)
                                      (cxml-xmls:make-xmls-builder))))
    (labels ((extract (name list)
               (third (car (find-headered-lists name list)))))
      (with-open-file (out "/var/www/html/esh/temp"
                           :direction :output
                           :if-exists :new-version
                           :if-does-not-exist :create)
        (dolist (item (find-headered-lists "item" xmls-list))
          (format out "|---item---|~%~A~%"
                  (make-rss-element
                   :title (extract "title" item)
                   :link (extract "link" item)
                   :date (extract "date" item)
                   :description (extract "description" item))))
        (format out "~%~% ~100~ ~%~%~A" xmls-list)))))