From: Frédéric Perrin Date: Tue, 2 Apr 2024 19:25:00 +0000 (+0100) Subject: Add published propety X-Git-Url: http://gitweb.fperrin.net/?p=atom.git;a=commitdiff_plain;h=HEAD;hp=e1b9724b572b85b05aba7bcc9217c4aab8378edd Add published propety --- diff --git a/atom-tests.el b/atom-tests.el new file mode 100644 index 0000000..c822f25 --- /dev/null +++ b/atom-tests.el @@ -0,0 +1,142 @@ +;;; atom-tests.el --- Tests for the atom.el library -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Frédéric Perrin + +;; Author: Frédéric Perrin +;; Keywords: + +;; 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 3 of the License, 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. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(normal-top-level-add-to-load-path (list default-directory)) +(require 'atom) + + +(ert-deftest text-feed () + (let* ((user-full-name "John Smith") + (user-mail-address "john.smith@example.org") + (now (current-time)) + (my-atom-feed (atom-create "My feed" "http://example.org" + (list :updated now)))) + ;; A simple, text-only entry + (atom-add-text-entry + my-atom-feed + "Hello world" + "http://example.org/hello" + "Hello the world!" + (list :updated now)) + + ;; + ;; + ;; My feed + ;; John Smith + ;; john.smith@example.org + ;; 2024-03-13T21:55:38+00:00http://example.org + ;; Hello world + ;; + ;; http://example.org/hello + ;; 2024-03-13T21:54:14+00:00 + ;; Hello the world! + ;; + ;; + + (with-temp-buffer + (atom-print my-atom-feed) + (let ((expected-strings + (list + "My feed" + "John Smith" + "john.smith@example.org" + "" + "[[:space:]]+Hello world" + "" + "http://example.org/hello" + "Hello the world!"))) + (dolist (exp-string expected-strings) + (goto-char (point-min)) + (should (re-search-forward exp-string)))) + (goto-char (point-min)) + ;; there will be two updated elements, for the feed and the entry + (re-search-forward "updated>\\(.*\\)") + (let* ((updated-string (match-string 1)) + (updated-time (atom-parse-time updated-string))) + (should (equal updated-time (seq-take now 2)))) + (re-search-forward "updated>\\(.*\\)") + (let* ((updated-string (match-string 1)) + (updated-time (atom-parse-time updated-string))) + (should (equal updated-time (seq-take now 2))))))) + +(ert-deftest html-xhtml-feed () + (let ((my-atom-feed (atom-create "My feed" "http://example.org"))) + + (atom-add-text-entry + my-atom-feed + "A text entry" + "http://example.org/text" + "Some text only") + (atom-add-html-entry + my-atom-feed + "An HTML entry" + "http://example.org/html" + "

One can also use HTML in the entries.

") + (atom-add-xhtml-entry + my-atom-feed + "A xHTML entry" + "http://example.org/xhtml" + "

One can also use xHTML in the entries.

") + + ;; only check that we can print the feed... + (atom-print my-atom-feed) + (atom-print-as-rss my-atom-feed))) + +(ert-deftest atom-opt-elements () + (let ((my-atom-feed (atom-create "My Feed" "http://example.org" + (list :subtitle "Feed subtitle" + :self "http://example.org/feed.atom" + :id "urn:example-id:1" + :author (list "Author name" "Author@example.org") + :updated (atom-parse-time "2024-03-23T01:02:03+04:00"))))) + (atom-add-text-entry + my-atom-feed + "A text entry" + "http://example.org/text" + "Some text" + (list :updated (atom-parse-time "2024-03-23T01:02:04+0400") + :published (atom-parse-time "2024-03-23T01:02:04+0400") + :summary "Summary")) + (atom-add-html-entry + my-atom-feed + "A HTLM entry" + "http://example.org/html" + "

Some text

" + (list :updated (atom-parse-time "2024-03-23T01:02:05+04:00") + :summary "

summary...

")) + (atom-add-xhtml-entry + my-atom-feed + "A XHTML entry" + "http://example.org/xhtml" + "

Some text

" + (list :updated (atom-parse-time "2024-03-23T01:02:06+04:00") + :summary "

summary...

")) + + (atom-print my-atom-feed) + (atom-print-as-rss my-atom-feed "http://example.org/feed.rss"))) + +(provide 'atom-tests) +;;; atom-tests.el ends here diff --git a/atom.el b/atom.el index 0a4b61e..34111c1 100644 --- a/atom.el +++ b/atom.el @@ -1,4 +1,4 @@ -;;; atom.el --- Create an Atom feed +;;; atom.el --- Create an Atom feed -*- lexical-binding: t -*- ;; Copyright (C) 2011 Frédéric Perrin @@ -47,17 +47,17 @@ ;; ;; (atom-print my-atom-feed) ;; ;; If you prefer RSS feeds: -;; (atom-to-rss-print my-atom-feed)) +;; (atom-print-as-rss my-atom-feed)) ;; Full documentation is available at . +;; See atom-tests.el for usage examples. ;;; Code: (require 'xml) (require 'url-parse) -(require 'cl) ; for setf in url-canonalize -(defun atom-create (title link &optional subtitle self id author updated) +(defun atom-create (title link &optional props) "Create a new atom structure. TITLE is the title for the feed, a short, text-only, human @@ -66,29 +66,34 @@ readable string. LINK is the URL of a page responible for the content of this feed. -SUBTITLE is a subtitle for the feed; it can be a bit longer than -TITLE, maybe a paragraph long. +PROPS is an optional plist with the following properties: -SELF is the canonical URL to this feed. +- :subtitle is a subtitle for the feed; it can be a bit longer than + TITLE, maybe a paragraph long. -ID is a unique identifier for this feed. If not given, it -defaults to SELF. +- :self is the canonical URL to this feed. If missing, the resulting + feed is non-conforming. -AUTHOR is the author of the feed. See `atom-massage-author' for -the possible ways to specify it. In particular, `nil' uses -`user-full-name' and `user-mail-address'. +- :id is a unique identifier for this feed. If not given, it + defaults to :self. -UPDATED is the date the feed was last updated. If not given, +- :author is the author of the feed. See `atom-massage-author' for +the possible ways to specify it. In particular, nil uses +variable `user-full-name' and `user-mail-address'. + +- :updated is the date the feed was last updated. If not given, `(current-time)' is used." (let ((atom-feed (list (list 'title nil title)))) (atom-modify-entry atom-feed 'link `(((href . ,link)))) - (atom-modify-entry atom-feed 'author (atom-massage-author author)) - (if subtitle (atom-modify-entry atom-feed 'subtitle subtitle)) - (if self (atom-modify-entry atom-feed 'link - `(((href . ,self) (rel . "self") - (type . "application/atom+xml"))))) - (atom-modify-entry atom-feed 'updated (atom-format-time updated)) - (atom-modify-entry atom-feed 'id (or id self link)) + (atom-modify-entry atom-feed 'author (atom-massage-author (plist-get props :author))) + (if (plist-member props :subtitle) + (atom-modify-entry atom-feed 'subtitle (plist-get props :subtitle))) + (if (plist-member props :self) + (atom-modify-entry atom-feed 'link + `(((href . ,(plist-get props :self)) (rel . "self") + (type . "application/atom+xml"))))) + (atom-modify-entry atom-feed 'updated (atom-format-time (plist-get props :updated))) + (atom-modify-entry atom-feed 'id (or (plist-get props :id) (plist-get props :self) link)) atom-feed)) (defun atom-push-entry (atom entry) @@ -102,10 +107,10 @@ UPDATED is the date the feed was last updated. If not given, (cons name val)))) (nconc entry (list elem)))) -(defun atom-add-entry (atom title link content - &optional updated id summary) - "Add an entry to the atom flux ATOM. Return the newly added -entry. +(defun atom-add-entry (atom title link content &optional props) + "Add an entry to the atom flux ATOM. + +Return the newly adde dentry. TITLE is a short, text-only, human readable string. @@ -115,20 +120,27 @@ may change between successive generations of the atom feed. CONTENT is the content of the entry; use `atom-add-html-entry' or `atom-add-xhtml-entry' when CONTENT is not text-only. -If SUMMARY is not given, the entry will not contain any summary. +PROPS is an optional plist with the following properties: + +- :summary, if is not given, the entry will not contain any summary. -UPDATED defaults to `(current-time)' if omitted, which is -probably not a very good default. +- :updated defaults to `(current-time)'. -ID defaults to LINK, which is not optimal; see `atom-generate-id' -for a way to create good identifiers. For a given entry, it must -not change between successive generations of the atom feed, even -when the content of the entry ." +- :published, if given, is the earliest availability of the + entry. It is optional, and shouldn't change even if the entry + content (etc.) updated after the initial publication. + +- :id is a unique ID for the entry; defaulting to LINK. RFC4287 + has specific requirements about valid IRI that may be used, + which this library does not try to enforce." (let ((entry (list (list 'title nil title)))) (atom-modify-entry entry 'link (list (list (cons 'href link)))) - (atom-modify-entry entry 'id (or id link)) - (atom-modify-entry entry 'updated (atom-format-time updated)) - (if summary (atom-modify-entry entry 'summary summary)) + (atom-modify-entry entry 'id (or (plist-get props :id) link)) + (atom-modify-entry entry 'updated (atom-format-time (plist-get props :updated))) + (if (plist-member props :published) + (atom-modify-entry entry 'published (atom-format-time (plist-get props :published)))) + (if (plist-member props :summary) + (atom-modify-entry entry 'summary (plist-get props :summary))) (atom-modify-entry entry 'content content) (atom-push-entry atom entry) entry)) @@ -137,29 +149,27 @@ when the content of the entry ." "Add an entry to ATOM, with a textual content. See `atom-add-entry' for details.") -(defun atom-add-html-entry (atom title link content - &optional updated id summary) - "Add an entry to ATOM, with some HTML content. CONTENT should -be a string enconding a valid HTML fragment. See `atom-add-entry' -for additional details." - (atom-add-entry atom - title link (atom-massage-html content) - updated id (and summary (atom-massage-html summary)))) - -(defun atom-add-xhtml-entry (atom title link content - &optional updated id summary noconvert) - "Add an entry to ATOM, with some XHTML content. CONTENT may be -given either as a string, or as an XML tree, of a valid XHTML -fragment. See `atom-add-entry' for additional details. - -If NOCONVERT is nil, translate all links in CONTENT so that they -are no longer relative to LINK." - (let ((xhtml-content (atom-massage-xhtml content))) - (unless noconvert - (atom-xhtml-convert-links (cadr xhtml-content) link)) - (atom-add-entry atom - title link xhtml-content - updated id (and summary (atom-massage-xhtml summary))))) +(defun atom-add-html-entry (atom title link content &optional props) + "Add an entry to ATOM, with some HTML content. + +TITLE, LINK, PROPS as in `atom-add-entry'. CONTENT should be a string +enconding a valid HTML fragment. See `atom-add-entry' for +additional details." + (if (plist-member props :summary) + (plist-put props :summary (atom-massage-html (plist-get props :summary)))) + (atom-add-entry atom title link (atom-massage-html content) props)) + +(defun atom-add-xhtml-entry (atom title link content &optional props) + "Add an entry to ATOM, with some XHTML content. + +TITLE, LINK, PROPS as in `atom-add-entry'. CONTENT may be given +either as a string, or as an XML tree, of a valid XHTML fragment. +See `atom-add-entry' for additional details." + (if (plist-member props :summary) + (plist-put props :summary (atom-massage-xhtml (plist-get props :summary)))) + (atom-add-entry atom title link (atom-massage-xhtml content) props)) + +(defvar atom-xml-declaration "\n") (defun atom-print (atom) "Print the Atom feed ATOM in the current buffer." @@ -175,11 +185,17 @@ are no longer relative to LINK." (write-file filename))) -(defun atom-to-rss (atom) - "Translate an Atom feed into an RSS one, returning the translation. +(defun atom-to-rss (atom &optional rss-self) + "Translate Atom feed ATOM into an RSS one, returning the translation. + +If RSS-SELF is given, it is used as self link of the RSS feed. Some information may be lost or approximated." (let ((rss (list (assoc 'title atom)))) + (if rss-self + (atom-modify-entry rss 'atom:link + `(((href . ,rss-self) (rel . "self") + (type . "application/atom+xml"))))) (atom-to-rss-translator atom rss '((subtitle . description) (updated . pubDate) (link . link))) @@ -190,7 +206,7 @@ Some information may be lost or approximated." (reverse rss))) (defun atom-to-rss-item (entry) - "Translates an Atom entry into an RSS item." + "Translates the Atom entry ENTRY into an RSS item." (let ((item (list (assoc 'title entry)))) (atom-to-rss-translator (xml-node-children entry) item @@ -203,7 +219,8 @@ Some information may be lost or approximated." (setcar (cdr guid) (list (cons 'isPermaLink "false")))) (if (and descr (equal (xml-get-attribute descr 'type) "xhtml")) - (setcar (cddr descr) (xml-node-as-text descr)))) + (setcar (cddr descr) (xml-node-as-text descr))) + (setcar (cdr descr) nil)) `(item nil ,@item))) (defun atom-to-rss-translator (source target translations) @@ -221,18 +238,23 @@ Some information may be lost or approximated." (setcar (cdr link) nil) (setcdr (cdr link) (cons link-addr nil))))) -(defun atom-print-as-rss (atom) - (let ((rss (atom-to-rss atom))) +(defun atom-print-as-rss (atom &optional rss-self) + "Convert Atom feed ATOM to RSS in the current buffer. + +If RSS-SELF is given, it is used as self link of the RSS feed." + (let ((rss (atom-to-rss atom rss-self))) (insert atom-xml-declaration) - (insert "\n") + ;; xmlns:atom included in order to allow the atom:link rel=self element + (insert "\n") (insert " \n") (xml-print rss " ") (insert "\n \n") (insert ""))) (defun atom-to-rss-time (time) - "Translates a string from the format used by Atom into the -format used by RSS." + "Translate TIME from the format used by Atom into the format used by RSS. + +TIME is a string." (let ((system-time-locale "C")) (format-time-string "%a, %d %b %Y %T %z" (atom-parse-time time)))) @@ -242,10 +264,12 @@ format used by RSS." (setcar (cddr pubDate) (atom-to-rss-time (car (xml-node-children pubDate)))))) -(defun atom-to-rss-write-file (atom filename) - "Saves ATOM as a RSS feed into FILENAME." +(defun atom-to-rss-write-file (atom filename &optional rss-self) + "Save ATOM as a RSS feed into FILENAME. + +If RSS-SELF is given, it is used as self link of the RSS feed." (with-temp-buffer - (atom-print-as-rss atom) + (atom-print-as-rss atom rss-self) (write-file filename))) @@ -254,10 +278,8 @@ format used by RSS." (defvar atom-xhtml-namespace "http://www.w3.org/1999/xhtml") -(defvar atom-xml-declaration "\n") - (defun atom-format-time (&optional time) - "Format a time according to RFC3339." + "Format time value TIME according to RFC3339." ;; The time zone must be specified in numeric form, but with a colon between ;; the hour and minute parts. (replace-regexp-in-string @@ -265,13 +287,15 @@ format used by RSS." (format-time-string atom-time-format-string time))) (defun atom-parse-time (&optional time) - "Parse a time as specified in RFC3339 into Emacs's native format." - ;; Same remark as in `atom-format-time' + "Parse string TIME as specified in RFC3339 into Emacs's native format." + ;; Same remark as in `atom-format-time': RFC3339 wants a colon between hour + ;; and minute parts of the timezome, so remove it before `date-to-time'. (date-to-time (replace-regexp-in-string ":\\(..\\)$" "\\1" time))) (defun atom-massage-html (content) - "Massage CONTENT so it can be used as an HTML fragment in an -Atom feed. CONTENT must be a string." + "Massage CONTENT so it can be used as an HTML fragment in an Atom feed. + +CONTENT must be a string." (list '((type . "html")) content)) (defun atom-string-to-xml (string) @@ -289,8 +313,7 @@ Atom feed. CONTENT must be a string." (car (xml-parse-region (point-min) (point-max)))))) (defun atom-massage-xhtml (content) - "Massage CONTENT so it can be used as an XHTML fragment in an -Atom feed." + "Massage CONTENT so it can be used as an XHTML fragment in an Atom feed." (list '((type . "xhtml")) (or (and (stringp content) (atom-string-to-xml content)) @@ -298,8 +321,8 @@ Atom feed." (defun atom-massage-author (author) "Return an XML node representing the author. AUTHOR can be: -- nil, in which case `user-full-name' and `user-mail-address' are - used; +- nil, in which case variables `user-full-name' and `user-mail-address' + are used; - a single string, the full name of the author; no email address will be included; - a list with two elements, the full name and the email address @@ -322,20 +345,11 @@ absolute, in the context of BASE, an URL." (dolist (child (xml-node-children node)) (when (listp child) (atom-xhtml-convert-links child base)))) -(defun atom-generate-id (link creation-date) - "Generate a string suitable for use as an atom:id element. This -implements Mark Pilgrom's tag: URI method, using the -CREATION-DATE of the entry, and the domain part of LINK." - (format "tag:%s,%s:/%s" - (url-host (url-generic-parse-url link)) - (format-time-string "%Y-%m-%d" creation-date) - (format-time-string "%Y%m%d%H%M%S" creation-date))) - ;;; Functions that should probably not be there (defun url-canonalize (address base) - "Make ADRESS an absolute URL, taking it in the BASE context." + "Make ADDRESS an absolute URL, taking it in the BASE context." ;; I feel such a function should exist in `url-parse'. Did I miss it? (let ((url-base (url-generic-parse-url base)) (url-address (url-generic-parse-url address))) @@ -352,9 +366,5 @@ CREATION-DATE of the entry, and the domain part of LINK." (xml-print (xml-node-children node)) (buffer-string))) -(defun xml-node-create (name attrlist childlist) - "Create a new XML node." - (list name attrlist . childlist)) - (provide 'atom) ;;; atom.el ends here diff --git a/xml-xhtml-entities.el b/xml-xhtml-entities.el index 9211562..a14a1d9 100644 --- a/xml-xhtml-entities.el +++ b/xml-xhtml-entities.el @@ -153,9 +153,9 @@ ;; C0 Controls and Basic Latin ("quot" . "\"") ;; quotation mark, U+0022 ISOnum - ("amp" . "&") ;; ampersand, U+0026 ISOnum - ("lt" . "<") ;; less-than sign, U+003C ISOnum - ("gt" . ">") ;; greater-than sign, U+003E ISOnum + ("amp" . "&") ;; ampersand, U+0026 ISOnum + ("lt" . "<") ;; less-than sign, U+003C ISOnum + ("gt" . ">") ;; greater-than sign, U+003E ISOnum ("apos" . "'") ;; apostrophe = APL quote, U+0027 ISOnum ;; Latin Extended-A