RSShimbun - RSS feed converted from Shimbun

まだ途中で、ちゃんとしたRSSになってるかどうかも確認してないけど、だいたいできた。

これは何か?

Shimbunを使ってRSSを生成するEmacs Lisp

rsshimbun.el

(require 'shimbun)
(require 'mew-bq)
(require 'mew-func)

(defun alist-to-attr (alist)
  (mapconcat (lambda (pair)
               (format "%s=\"%s\"" (car pair) (cadr pair)))
             alist " "))

(defun sexp-to-xml (s)
  (cond
   ((null s) nil)
   ((consp s)
    (let ((tag (car s))
          attr body)
      (if (vectorp (cadr s))
          (progn
            (setq attr (aref (cadr s) 0))
            (setq body (cddr s)))
        (setq body (cdr s)))
      (format "<%s %s>%s</%s>"
              tag
              (alist-to-attr attr)
              (mapconcat 'sexp-to-xml body "")
              tag)))
   (t (format "%s" s))))

(defun rsshimbun-time-tmzn-int (tz)
  (if (< tz 0)
      (format "-%02d%02d" (/ (- tz) 3600) (/ (% (- tz) 3600) 60))
    (format "+%02d%02d" (/ tz 3600) (/ (% tz 3600) 60))))

(defun rsshimbun-encode-time-w3cdtf (second minute hour day month year &optional zone)
  (format "%04d-%02d-%02dT%02d:%02d:%02d%s"
          year month day hour minute second (rsshimbun-time-tmzn-int zone)))

(defun rsshimbun-decode-time-rfc (s)
  (if (string-match mew-time-rfc-regex s)
      (let ((year (mew-time-rfc-year))
            (mon  (mew-time-mon-str-to-int (mew-time-rfc-mon)))
            (day  (mew-time-rfc-day))
            (hour (mew-time-rfc-hour))
            (min  (mew-time-rfc-min))
            (sec  (mew-time-rfc-sec))
            (tmzn (mew-time-rfc-tmzn)))
        (cond
         ((< year 50)
          (setq year (+ year 2000)))
         ((< year 100)
          (setq year (+ year 1900))))
        (list sec min hour day mon year tmzn))))

(defun rsshimbun-decode-header-string (value)
  (while (string-match mew-header-decode-regex value)
    (let ((pre (substring value 0 (match-beginning 0)))
          (pst (substring value (match-end 0)))
          (med (mew-header-decode (match-string 1 value)
                                  (match-string 2 value)
                                  (match-string 3 value))))
      (if (string-match mew-header-decode-regex3 pst)
          (setq pst (substring pst (match-end 1))))
      (setq value (concat pre med pst))))
  value)

(defun rsshimbun-get-content (shimbun head)
  (with-temp-buffer
    (shimbun-article shimbun head)
    (goto-char (point-min))
    (re-search-forward "^$")
    (decode-coding-string (buffer-substring (1+ (point)) (point-max))
                          'iso-2022-jp)))

(defun feed-to-xml (feed &optional title link desc)
  (let ((items (list 'items
                     (list 'rdf:Seq
                           (mapconcat (lambda (item)
                                        (format "<rdf:li rdf:resource=\"%s\"/>"
                                                (cadr (assoc 'link (cdr item)))))
                                      feed "\n")))))
    (sexp-to-xml
     `(rdf:RDF
       [((xmlns "http://purl.org/rss/1.0/")
         (xmlns:rdf "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
         (xmlns:dc "http://purl.org/dc/elements/1.1/")
         (xml:lang "ja"))]
       (channel
        [((rdf:about "http://d.hatena.ne.jp/nozom/rss"))]
        (title ,title)
        (link ,link)
        (description ,desc)
        ,items)
       ,(mapconcat 'sexp-to-xml feed "\n")))))

(defun rsshimbun-get-rss (server group &optional title desc)
  (or title (setq title (concat "RSS feed converted from shimbun " server "/" group)))
  (or desc (setq desc title))
  (let ((shimbun (shimbun-open server)))
    (shimbun-open-group shimbun group)
    (let ((headers (shimbun-headers shimbun)))
      (prog1
          (feed-to-xml
           (mapcar (lambda (head)
                     (let ((title (rsshimbun-decode-header-string
                                   (shimbun-header-subject head)))
                           (link (shimbun-article-url shimbun head))
                           (date (apply 'rsshimbun-encode-time-w3cdtf
                                        (rsshimbun-decode-time-rfc
                                         (shimbun-header-date head))))
                           (content (rsshimbun-get-content shimbun head)))
                       (cons 'item
                             (list (list 'title title)
                                   (list 'link link)
                                   (list 'dc:date date)
                                   (list 'content content)))))
                   headers)
           title
           (shimbun-index-url shimbun)
           desc)
        (shimbun-close-group shimbun)
        (shimbun-close shimbun)))))

使用例

こんな感じで使う

(with-current-buffer (get-buffer-create "*shimbun*")
  (erase-buffer)
  (set-buffer-file-coding-system 'utf-8)
  (insert (rsshimbun-get-rss "yahoo" "topnews")))