/usr/share/emacs/site-lisp/w3m/shimbun/sb-atom.el is in w3m-el-snapshot 1.4.569+0.20170110-1.
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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | ;;; sb-atom.el --- shimbun backend for ATOM (Rich Site Summary).
;; Copyright (C) 2006, 2008-2011 Tsuyoshi CHO <tsuyoshi_cho@ybb.ne.jp>
;; Author: Tsuyoshi CHO <tsuyoshi_cho@ybb.ne.jp>
;; Keywords: news
;; Created: Jun 14, 2003
;; This file is a part of shimbun.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
(eval-when-compile
(require 'cl)
(require 'static))
(require 'shimbun)
(require 'sb-rss)
(luna-define-class shimbun-atom (shimbun-rss) ())
(luna-define-generic shimbun-atom-build-message-id (shimbun-atom url date)
"Build unique message-id from URL and DATE and return it.
If return nil, it mean argument URL are not SHIMBUN entry.
Basically, implement illeagal URL to generate error message.
But clarify need ignored URL return nil.")
(luna-define-method shimbun-rss-build-message-id ((shimbun shimbun-atom) url date)
(shimbun-atom-build-message-id shimbun url date))
(luna-define-method shimbun-get-headers ((shimbun shimbun-atom)
&optional range)
(shimbun-atom-get-headers shimbun range t))
(defun shimbun-atom-get-headers (shimbun &optional range
need-summaries need-all-entries)
"Get headers from atom feed described by SHIMBUN.
RANGE is currently ignored. If NEED-SUMMARIES, include node text
as summary. By default, only existing and new items from the
feed are returned, i.e., those items which are newer than the
oldest one in the shimbun. If NEED-ALL-ENTRIES is non-nil, all
items from the feed are returned. If the entries from the feed
have date information, the result is sorted by ascending date."
(let* ((xml (condition-case err
(shimbun-xml-parse-buffer)
(error
(message "Error while parsing %s: %s"
(shimbun-index-url shimbun)
(error-message-string err))
nil)))
headers header newheaders oldheaders oldest)
(dolist (tmp (shimbun-atom-get-headers-1 xml shimbun need-summaries))
(let* ((date (shimbun-header-date tmp))
(ftime
(when (and (stringp date)
(> (length date) 1))
(w3m-float-time (date-to-time date)))))
(push (list tmp ftime) headers)))
(when headers
(if (or need-all-entries
;; If there's a header without date information, we
;; return everything, just to be safe.
(memq nil (mapcar 'cadr headers)))
(mapcar 'car headers)
;; Otherwise, sort according to date.
(setq headers
(sort headers (lambda (a b)
(> (cadr a) (cadr b)))))
(while headers
(setq header (pop headers))
(if (shimbun-search-id shimbun (shimbun-header-id (car header)))
(push header oldheaders)
(push header newheaders)))
(if (null oldheaders)
;; All items are new
(mapcar 'car newheaders)
;; Delete all items which are older than the ones we already
;; have
(setq oldest (cadr (car oldheaders)))
(while (and newheaders
(> oldest (cadr (car newheaders))))
(setq newheaders (cdr newheaders)))
(append
(mapcar 'car newheaders)
(mapcar 'car oldheaders)))))))
(defun shimbun-atom-get-headers-1 (xml shimbun need-summaries)
"Retrieve all items found in XML for SHIMBUN and return headers.
If NEED-SUMMARIES, include node text as summary."
(when xml
(let* ((atom-ns (shimbun-rss-get-namespace-prefix
xml "http://www.w3.org/2005/Atom"))
(dc-ns (shimbun-rss-get-namespace-prefix
xml "http://purl.org/dc/elements/1.1/"))
(author-node (shimbun-rss-find-el
(intern (concat atom-ns "author")) xml))
(fn `(lambda (item) (shimbun-rss-node-text ,atom-ns 'name item)))
(author (when (consp author-node)
(mapconcat fn author-node ",")))
url headers)
(dolist (entry (shimbun-rss-find-el
(intern (concat atom-ns "entry")) xml))
(setq url
(catch 'url
(dolist (link (shimbun-rss-find-el
(intern (concat atom-ns "link")) entry))
(when (string= (shimbun-atom-attribute-value
(intern (concat atom-ns "rel")) link)
"alternate")
(throw 'url (shimbun-atom-attribute-value
(intern (concat atom-ns "href")) link))))))
(unless url
(setq url (shimbun-atom-attribute-value
(intern (concat atom-ns "href"))
(car (shimbun-rss-find-el
(intern (concat atom-ns "link")) entry)))))
(when url
(let* ((date (or (shimbun-rss-get-date shimbun url)
(shimbun-rss-node-text atom-ns 'updated entry)
(shimbun-rss-node-text atom-ns 'published entry)
(shimbun-rss-node-text atom-ns 'modified entry)
(shimbun-rss-node-text atom-ns 'created entry)
(shimbun-rss-node-text atom-ns 'issued entry)
(shimbun-rss-node-text dc-ns 'date entry)))
(author-node (shimbun-rss-find-el
(intern (concat atom-ns "author")) entry))
(author (or (and (consp author-node)
(mapconcat fn author-node ","))
(shimbun-rss-node-text dc-ns 'creator entry)
(shimbun-rss-node-text dc-ns 'contributor entry)
author))
(id (shimbun-rss-build-message-id shimbun url date)))
(when id
(push (shimbun-create-header
0
(or (shimbun-rss-node-text atom-ns 'title entry)
(shimbun-rss-node-text dc-ns 'subject entry))
(or author (shimbun-from-address shimbun))
(shimbun-rss-process-date shimbun date)
id "" 0 0 url
(when need-summaries
(let ((summary (shimbun-rss-node-text
atom-ns 'summary entry)))
(when summary
(list (cons 'summary summary))))))
headers)))))
headers)))
(defun shimbun-atom-attribute-value (attribute node)
(let* ((attr-list (if (and node (listp node))
(nth 1 node)
nil)))
(when attr-list
(catch 'value
(dolist (attr attr-list)
(when (eq (car attr) attribute)
(throw 'value (cdr attr))))))))
(provide 'sb-atom)
;; end of sb-atom.el
|