testing/lisp/test-ox-publish.el

   1 ;;; test-ox-publish.el --- Tests for "ox-publish.el" -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2016  Nicolas Goaziou
   4
   5 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Code:
  21
  22 \f
  23 ;;; Helper functions
  24
  25 (defun org-test-publish (properties handler)
  26   "Publish a project defined by PROPERTIES.
  27 Call HANDLER with the publishing directory as its sole argument.
  28 Unless set otherwise in PROPERTIES, `:base-directory' is set to
  29 \"examples/pub/\" sub-directory from test directory and
  30 `:publishing-function' is set to `org-publish-attachment'."
  31   (declare (indent 1))
  32   (let* ((org-publish-use-timestamps-flag nil)
  33          (org-publish-cache nil)
  34          (base-dir (expand-file-name "examples/pub/" org-test-dir))
  35          (pub-dir (make-temp-file "org-test" t))
  36          (org-publish-timestamp-directory
  37           (expand-file-name ".org-timestamps/" pub-dir))
  38          (project
  39           `("test" ,@(org-combine-plists
  40                       `(:base-directory
  41                         ,base-dir
  42                         :publishing-function org-publish-attachment)
  43                       properties
  44                       `(:publishing-directory ,pub-dir)))))
  45     (unwind-protect
  46         (progn
  47           (org-publish-projects (list project))
  48           (funcall handler pub-dir))
  49       ;; Clear published data.
  50       (delete-directory pub-dir t)
  51       ;; Delete auto-generated site-map file, if applicable.
  52       (let ((site-map (and (plist-get properties :auto-sitemap)
  53                            (expand-file-name
  54                             (or (plist-get properties :sitemap-filename)
  55                                 "sitemap.org")
  56                             base-dir))))
  57         (when (and site-map (file-exists-p site-map))
  58           (delete-file site-map))))))
  59
  60 \f
  61 ;;; Mandatory properties
  62
  63 (ert-deftest test-org-publish/base-extension ()
  64   "Test `:base-extension' specifications"
  65   ;; Regular tests.
  66   (should
  67    (equal '("a.org" "b.org")
  68           (org-test-publish '(:base-extension "org")
  69             (lambda (dir)
  70               (remove ".org-timestamps"
  71                       (cl-remove-if #'file-directory-p
  72                                     (directory-files dir)))))))
  73   (should
  74    (equal '("file.txt")
  75           (org-test-publish '(:base-extension "txt")
  76             (lambda (dir)
  77               (remove ".org-timestamps"
  78                       (cl-remove-if #'file-directory-p
  79                                     (directory-files dir)))))))
  80   ;; A nil value is equivalent to ".org".
  81   (should
  82    (equal '("a.org" "b.org")
  83           (org-test-publish '(:base-extension nil)
  84             (lambda (dir)
  85               (remove ".org-timestamps"
  86                       (cl-remove-if #'file-directory-p
  87                                     (directory-files dir)))))))
  88   ;; Symbol `any' includes all files, even those without extension.
  89   (should
  90    (equal '("a.org" "b.org" "file.txt" "noextension")
  91           (org-test-publish '(:base-extension any)
  92             (lambda (dir)
  93               (remove ".org-timestamps"
  94                       (cl-remove-if #'file-directory-p
  95                                     (directory-files dir))))))))
  96
  97
  98 \f
  99 ;;; Site-map
 100
 101 (ert-deftest test-org-publish/sitemap ()
 102   "Test site-map specifications."
 103   ;; Site-map creation is controlled with `:auto-sitemap'.  It
 104   ;; defaults to "sitemap.org".
 105   (should
 106    (org-test-publish
 107        '(:auto-sitemap t)
 108      (lambda (dir) (file-exists-p (expand-file-name "sitemap.org" dir)))))
 109   (should-not
 110    (org-test-publish
 111        '(:auto-sitemap nil)
 112      (lambda (dir) (file-exists-p (expand-file-name "sitemap.org" dir)))))
 113   ;; Site-map file name is controlled with `:sitemap-filename'.
 114   (should
 115    (org-test-publish
 116        '(:auto-sitemap t :sitemap-filename "mysitemap.org")
 117      (lambda (dir) (file-exists-p (expand-file-name "mysitemap.org" dir)))))
 118   ;; Site-map title is controlled with `:sitemap-title'.  It defaults
 119   ;; to the project name.
 120   (should
 121    (equal "#+TITLE: Sitemap for project test"
 122           (org-test-publish
 123               '(:auto-sitemap t)
 124             (lambda (dir)
 125               (with-temp-buffer
 126                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 127                 (buffer-substring (point) (line-end-position)))))))
 128   (should
 129    (equal "#+TITLE: My title"
 130           (org-test-publish
 131               '(:auto-sitemap t :sitemap-title "My title")
 132             (lambda (dir)
 133               (with-temp-buffer
 134                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 135                 (buffer-substring (point) (line-end-position)))))))
 136   ;; Allowed site-map styles: `list' and `tree'.
 137   (should
 138    (equal "
 139 - [[file:a.org][A]]
 140 - [[file:b.org][b]]
 141 - [[file:sub/c.org][C]]"
 142           (org-test-publish
 143               '(:auto-sitemap t
 144                               :sitemap-sort-folders ignore
 145                               :sitemap-style list
 146                               :exclude "."
 147                               :include ("a.org" "b.org" "sub/c.org"))
 148             (lambda (dir)
 149               (with-temp-buffer
 150                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 151                 (buffer-substring (line-beginning-position 2) (point-max)))))))
 152   (should
 153    (equal "
 154 - [[file:a.org][A]]
 155 - [[file:b.org][b]]
 156 - sub
 157   - [[file:sub/c.org][C]]"
 158           (org-test-publish
 159               '(:auto-sitemap t
 160                               :sitemap-style tree
 161                               :exclude "."
 162                               :include ("a.org" "b.org" "sub/c.org"))
 163             (lambda (dir)
 164               (with-temp-buffer
 165                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 166                 (buffer-substring (line-beginning-position 2) (point-max)))))))
 167   ;; When style is `list', `:sitemap-sort-folders' controls the order
 168   ;; of appearance of directories among published files.
 169   (should
 170    (equal
 171     "
 172 - sub/
 173 - [[file:a.org][A]]
 174 - [[file:sub/c.org][C]]"
 175     (org-test-publish
 176         '(:auto-sitemap t
 177                         :recursive t
 178                         :sitemap-style list
 179                         :sitemap-sort-folders first
 180                         :exclude "."
 181                         :include ("a.org" "sub/c.org"))
 182       (lambda (dir)
 183         (with-temp-buffer
 184           (insert-file-contents (expand-file-name "sitemap.org" dir))
 185           (buffer-substring (line-beginning-position 2) (point-max)))))))
 186   (should
 187    (equal
 188     "
 189 - [[file:a.org][A]]
 190 - [[file:sub/c.org][C]]
 191 - sub/"
 192     (org-test-publish
 193         '(:auto-sitemap t
 194                         :recursive t
 195                         :sitemap-style list
 196                         :sitemap-sort-folders last
 197                         :exclude "."
 198                         :include ("a.org" "sub/c.org"))
 199       (lambda (dir)
 200         (with-temp-buffer
 201           (insert-file-contents (expand-file-name "sitemap.org" dir))
 202           (buffer-substring (line-beginning-position 2) (point-max)))))))
 203   ;; When style is `list', `:sitemap-sort-folders' can be used to
 204   ;; toggle visibility of directories in the site-map.
 205   (should
 206    (let ((case-fold-search t))
 207      (string-match-p
 208       "- sub/$"
 209       (org-test-publish
 210           '(:auto-sitemap t
 211                           :recursive t
 212                           :sitemap-style list
 213                           :sitemap-sort-folders t
 214                           :exclude "."
 215                           :include ("a.org" "sub/c.org"))
 216         (lambda (dir)
 217           (with-temp-buffer
 218             (insert-file-contents (expand-file-name "sitemap.org" dir))
 219             (buffer-substring (line-beginning-position 2) (point-max))))))))
 220   (should-not
 221    (string-match-p
 222     "- sub/$"
 223     (org-test-publish
 224         '(:auto-sitemap t
 225                         :recursive t
 226                         :sitemap-style list
 227                         :sitemap-sort-folders ignore
 228                         :exclude "."
 229                         :include ("a.org" "sub/c.org"))
 230       (lambda (dir)
 231         (with-temp-buffer
 232           (insert-file-contents (expand-file-name "sitemap.org" dir))
 233           (buffer-substring (line-beginning-position 2) (point-max)))))))
 234   ;; Using `:sitemap-sort-files', files can be sorted alphabetically
 235   ;; (according to their title, or file name when there is none),
 236   ;; chronologically a anti-chronologically.
 237   (should
 238    (equal
 239     "
 240 - [[file:a.org][A]]
 241 - [[file:b.org][b]]
 242 - [[file:sub/c.org][C]]"
 243     (org-test-publish
 244         '(:auto-sitemap t
 245                         :recursive t
 246                         :sitemap-style list
 247                         :sitemap-sort-folders ignore
 248                         :sitemap-sort-files alphabetically
 249                         :exclude "."
 250                         :include ("a.org" "b.org" "sub/c.org"))
 251       (lambda (dir)
 252         (with-temp-buffer
 253           (insert-file-contents (expand-file-name "sitemap.org" dir))
 254           (buffer-substring (line-beginning-position 2) (point-max)))))))
 255   (should
 256    (equal
 257     "
 258 - [[file:b.org][b]]
 259 - [[file:sub/c.org][C]]
 260 - [[file:a.org][A]]"
 261     (org-test-publish
 262         '(:auto-sitemap t
 263                         :recursive t
 264                         :sitemap-style list
 265                         :sitemap-sort-folders ignore
 266                         :sitemap-sort-files chronologically
 267                         :exclude "."
 268                         :include ("a.org" "b.org" "sub/c.org"))
 269       (lambda (dir)
 270         (with-temp-buffer
 271           (insert-file-contents (expand-file-name "sitemap.org" dir))
 272           (buffer-substring (line-beginning-position 2) (point-max)))))))
 273   (should
 274    (equal
 275     "
 276 - [[file:a.org][A]]
 277 - [[file:sub/c.org][C]]
 278 - [[file:b.org][b]]"
 279     (org-test-publish
 280         '(:auto-sitemap t
 281                         :recursive t
 282                         :sitemap-style list
 283                         :sitemap-sort-folders ignore
 284                         :sitemap-sort-files anti-chronologically
 285                         :exclude "."
 286                         :include ("a.org" "b.org" "sub/c.org"))
 287       (lambda (dir)
 288         (with-temp-buffer
 289           (insert-file-contents (expand-file-name "sitemap.org" dir))
 290           (buffer-substring (line-beginning-position 2) (point-max)))))))
 291   ;; `:sitemap-format-entry' formats entries in the site-map whereas
 292   ;; `:sitemap-function' controls the full site-map.
 293   (should
 294    (equal "
 295 - a.org"
 296           (org-test-publish
 297               '(:auto-sitemap t
 298                               :exclude "."
 299                               :include ("a.org")
 300                               :sitemap-format-entry
 301                               (lambda (f _s _p) f))
 302             (lambda (dir)
 303               (with-temp-buffer
 304                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 305                 (buffer-substring (line-beginning-position 2) (point-max)))))))
 306   (should
 307    (equal "Custom!"
 308           (org-test-publish
 309               '(:auto-sitemap t
 310                               :exclude "."
 311                               :include ("a.org")
 312                               :sitemap-function (lambda (_title _f) "Custom!"))
 313             (lambda (dir)
 314               (with-temp-buffer
 315                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 316                 (buffer-string))))))
 317   (should
 318    (equal "[[file:a.org][A]]"
 319           (org-test-publish
 320               '(:auto-sitemap t
 321                               :exclude "."
 322                               :include ("a.org")
 323                               :sitemap-function
 324                               (lambda (_title f) (org-list-to-generic f nil)))
 325             (lambda (dir)
 326               (with-temp-buffer
 327                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 328                 (buffer-string)))))))
 329
 330 \f
 331 ;;; Tools
 332
 333 (ert-deftest test-org-publish/get-project-from-filename ()
 334   "Test `org-publish-get-project-from-filename' specifications."
 335   ;; Check base directory.
 336   (should
 337    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 338           (file (expand-file-name "a.org" base))
 339           (org-publish-project-alist `(("p" :base-directory ,base))))
 340      (org-publish-get-project-from-filename file)))
 341   ;; Return nil if no appropriate project is found.
 342   (should-not
 343    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 344           (file (expand-file-name "a.org" base))
 345           (org-publish-project-alist `(("p" :base-directory ,base))))
 346      (org-publish-get-project-from-filename "/other/file.org")))
 347   ;; Return the first project effectively publishing the provided
 348   ;; file.
 349   (should
 350    (equal "p2"
 351           (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 352                  (file (expand-file-name "a.org" base))
 353                  (org-publish-project-alist
 354                   `(("p1" :base-directory "/other/")
 355                     ("p2" :base-directory ,base)
 356                     ("p3" :base-directory ,base))))
 357             (car (org-publish-get-project-from-filename file)))))
 358   ;; When :recursive in non-nil, allow files in sub-directories.
 359   (should
 360    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 361           (file (expand-file-name "sub/c.org" base))
 362           (org-publish-project-alist
 363            `(("p" :base-directory ,base :recursive t))))
 364      (org-publish-get-project-from-filename file)))
 365   (should-not
 366    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 367           (file (expand-file-name "sub/c.org" base))
 368           (org-publish-project-alist
 369            `(("p" :base-directory ,base :recursive nil))))
 370      (org-publish-get-project-from-filename file)))
 371   ;; Also, when :recursive is non-nil, follow symlinks to directories.
 372   (should
 373    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 374           (file (expand-file-name "link/link.org" base))
 375           (org-publish-project-alist
 376            `(("p" :base-directory ,base :recursive t))))
 377      (org-publish-get-project-from-filename file)))
 378   (should-not
 379    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 380           (file (expand-file-name "link/link.org" base))
 381           (org-publish-project-alist
 382            `(("p" :base-directory ,base :recursive nil))))
 383      (org-publish-get-project-from-filename file)))
 384   ;; Check :base-extension.
 385   (should
 386    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 387           (file (expand-file-name "file.txt" base))
 388           (org-publish-project-alist
 389            `(("p" :base-directory ,base :base-extension "txt"))))
 390      (org-publish-get-project-from-filename file)))
 391   (should-not
 392    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 393           (file (expand-file-name "file.txt" base))
 394           (org-publish-project-alist
 395            `(("p" :base-directory ,base :base-extension "org"))))
 396      (org-publish-get-project-from-filename file)))
 397   ;; When :base-extension has the special value `any', allow any
 398   ;; extension, including none.
 399   (should
 400    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 401           (file (expand-file-name "file.txt" base))
 402           (org-publish-project-alist
 403            `(("p" :base-directory ,base :base-extension any))))
 404      (org-publish-get-project-from-filename file)))
 405   (should
 406    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 407           (file (expand-file-name "noextension" base))
 408           (org-publish-project-alist
 409            `(("p" :base-directory ,base :base-extension any))))
 410      (org-publish-get-project-from-filename file)))
 411   ;; Pathological case: Handle both :extension any and :recursive t.
 412   (should
 413    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 414           (file (expand-file-name "sub/c.org" base))
 415           (org-publish-project-alist
 416            `(("p" :base-directory ,base :recursive t :base-extension any))))
 417      (org-publish-get-base-files (org-publish-get-project-from-filename file))))
 418   ;; Check :exclude property.
 419   (should-not
 420    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 421           (file (expand-file-name "a.org" base))
 422           (org-publish-project-alist
 423            `(("p" :base-directory ,base :exclude "a"))))
 424      (org-publish-get-project-from-filename file)))
 425   (should
 426    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 427           (file (expand-file-name "a.org" base))
 428           (org-publish-project-alist
 429            `(("p" :base-directory ,base :exclude "other"))))
 430      (org-publish-get-project-from-filename file)))
 431   ;; The regexp matches against relative file name, not absolute one.
 432   (should
 433    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 434           (file (expand-file-name "a.org" base))
 435           (org-publish-project-alist
 436            `(("p" :base-directory ,base :exclude "examples/pub"))))
 437      (org-publish-get-project-from-filename file)))
 438   ;; Check :include property.
 439   (should
 440    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 441           (file (expand-file-name "file.txt" base))
 442           (org-publish-project-alist
 443            `(("p" :base-directory ,base :include (,file)))))
 444      (org-publish-get-project-from-filename file)))
 445   ;; :include property has precedence over :exclude one.
 446   (should
 447    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 448           (file (expand-file-name "a.org" base))
 449           (org-publish-project-alist
 450            `(("p"
 451               :base-directory ,base
 452               :include (,(file-name-nondirectory file))
 453               :exclude "a"))))
 454      (org-publish-get-project-from-filename file)))
 455   ;; With optional argument, return a meta-project publishing provided
 456   ;; file.
 457   (should
 458    (equal "meta"
 459           (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 460                  (file (expand-file-name "a.org" base))
 461                  (org-publish-project-alist
 462                   `(("meta" :components ("p"))
 463                     ("p" :base-directory ,base))))
 464             (car (org-publish-get-project-from-filename file t))))))
 465
 466 (ert-deftest test-org-publish/file-relative-name ()
 467   "Test `org-publish-file-relative-name' specifications."
 468   ;; Turn absolute file names into relative ones if file belongs to
 469   ;; base directory.
 470   (should
 471    (equal "a.org"
 472           (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 473                  (file (expand-file-name "a.org" base)))
 474             (org-publish-file-relative-name file `(:base-directory ,base)))))
 475   (should
 476    (equal "pub/a.org"
 477           (let* ((base (expand-file-name "examples/" org-test-dir))
 478                  (file (expand-file-name "pub/a.org" base)))
 479             (org-publish-file-relative-name file `(:base-directory ,base)))))
 480   ;; Absolute file names that do not belong to base directory are
 481   ;; unchanged.
 482   (should
 483    (equal "/name.org"
 484           (let ((base (expand-file-name "examples/pub/" org-test-dir)))
 485             (org-publish-file-relative-name "/name.org"
 486                                             `(:base-directory ,base)))))
 487   ;; Relative file names are unchanged.
 488   (should
 489    (equal "a.org"
 490           (let ((base (expand-file-name "examples/pub/" org-test-dir)))
 491             (org-publish-file-relative-name "a.org" `(:base-directory ,base))))))
 492
 493
 494 (provide 'test-ox-publish)
 495 ;;; test-ox-publish.el ends here