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 \f
  98 ;;; Site-map
  99
 100 (ert-deftest test-org-publish/sitemap ()
 101   "Test site-map specifications."
 102   ;; Site-map creation is controlled with `:auto-sitemap'.  It
 103   ;; defaults to "sitemap.org".
 104   (should
 105    (org-test-publish
 106        '(:auto-sitemap t)
 107      (lambda (dir) (file-exists-p (expand-file-name "sitemap.org" dir)))))
 108   (should-not
 109    (org-test-publish
 110        '(:auto-sitemap nil)
 111      (lambda (dir) (file-exists-p (expand-file-name "sitemap.org" dir)))))
 112   ;; Site-map file name is controlled with `:sitemap-filename'.
 113   (should
 114    (org-test-publish
 115        '(:auto-sitemap t :sitemap-filename "mysitemap.org")
 116      (lambda (dir) (file-exists-p (expand-file-name "mysitemap.org" dir)))))
 117   ;; Site-map title is controlled with `:sitemap-title'.  It defaults
 118   ;; to the project name.
 119   (should
 120    (equal "#+TITLE: Sitemap for project test"
 121           (org-test-publish
 122               '(:auto-sitemap t)
 123             (lambda (dir)
 124               (with-temp-buffer
 125                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 126                 (buffer-substring (point) (line-end-position)))))))
 127   (should
 128    (equal "#+TITLE: My title"
 129           (org-test-publish
 130               '(:auto-sitemap t :sitemap-title "My title")
 131             (lambda (dir)
 132               (with-temp-buffer
 133                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 134                 (buffer-substring (point) (line-end-position)))))))
 135   ;; Allowed site-map styles: `list' and `tree'.
 136   (should
 137    (equal "
 138 - [[file:a.org][A]]
 139 - [[file:b.org][b]]
 140 - [[file:sub/c.org][C]]"
 141           (org-test-publish
 142               '(:auto-sitemap t
 143                               :sitemap-sort-folders ignore
 144                               :sitemap-style list
 145                               :exclude "."
 146                               :include ("a.org" "b.org" "sub/c.org"))
 147             (lambda (dir)
 148               (with-temp-buffer
 149                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 150                 (buffer-substring (line-beginning-position 2) (point-max)))))))
 151   (should
 152    (equal "
 153 - [[file:a.org][A]]
 154 - [[file:b.org][b]]
 155 - sub
 156   - [[file:sub/c.org][C]]"
 157           (org-test-publish
 158               '(:auto-sitemap t
 159                               :sitemap-style tree
 160                               :exclude "."
 161                               :include ("a.org" "b.org" "sub/c.org"))
 162             (lambda (dir)
 163               (with-temp-buffer
 164                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 165                 (buffer-substring (line-beginning-position 2) (point-max)))))))
 166   ;; When style is `list', `:sitemap-sort-folders' controls the order
 167   ;; of appearance of directories among published files.
 168   (should
 169    (equal
 170     "
 171 - sub/
 172 - [[file:a.org][A]]
 173 - [[file:sub/c.org][C]]"
 174     (org-test-publish
 175         '(:auto-sitemap t
 176                         :recursive t
 177                         :sitemap-style list
 178                         :sitemap-sort-folders first
 179                         :exclude "."
 180                         :include ("a.org" "sub/c.org"))
 181       (lambda (dir)
 182         (with-temp-buffer
 183           (insert-file-contents (expand-file-name "sitemap.org" dir))
 184           (buffer-substring (line-beginning-position 2) (point-max)))))))
 185   (should
 186    (equal
 187     "
 188 - [[file:a.org][A]]
 189 - [[file:sub/c.org][C]]
 190 - sub/"
 191     (org-test-publish
 192         '(:auto-sitemap t
 193                         :recursive t
 194                         :sitemap-style list
 195                         :sitemap-sort-folders last
 196                         :exclude "."
 197                         :include ("a.org" "sub/c.org"))
 198       (lambda (dir)
 199         (with-temp-buffer
 200           (insert-file-contents (expand-file-name "sitemap.org" dir))
 201           (buffer-substring (line-beginning-position 2) (point-max)))))))
 202   ;; When style is `list', `:sitemap-sort-folders' can be used to
 203   ;; toggle visibility of directories in the site-map.
 204   (should
 205    (let ((case-fold-search t))
 206      (string-match-p
 207       "- sub/$"
 208       (org-test-publish
 209           '(:auto-sitemap t
 210                           :recursive t
 211                           :sitemap-style list
 212                           :sitemap-sort-folders t
 213                           :exclude "."
 214                           :include ("a.org" "sub/c.org"))
 215         (lambda (dir)
 216           (with-temp-buffer
 217             (insert-file-contents (expand-file-name "sitemap.org" dir))
 218             (buffer-substring (line-beginning-position 2) (point-max))))))))
 219   (should-not
 220    (string-match-p
 221     "- sub/$"
 222     (org-test-publish
 223         '(:auto-sitemap t
 224                         :recursive t
 225                         :sitemap-style list
 226                         :sitemap-sort-folders ignore
 227                         :exclude "."
 228                         :include ("a.org" "sub/c.org"))
 229       (lambda (dir)
 230         (with-temp-buffer
 231           (insert-file-contents (expand-file-name "sitemap.org" dir))
 232           (buffer-substring (line-beginning-position 2) (point-max)))))))
 233   ;; Using `:sitemap-sort-files', files can be sorted alphabetically
 234   ;; (according to their title, or file name when there is none),
 235   ;; chronologically a anti-chronologically.
 236   (should
 237    (equal
 238     "
 239 - [[file:a.org][A]]
 240 - [[file:b.org][b]]
 241 - [[file:sub/c.org][C]]"
 242     (org-test-publish
 243         '(:auto-sitemap t
 244                         :recursive t
 245                         :sitemap-style list
 246                         :sitemap-sort-folders ignore
 247                         :sitemap-sort-files alphabetically
 248                         :exclude "."
 249                         :include ("a.org" "b.org" "sub/c.org"))
 250       (lambda (dir)
 251         (with-temp-buffer
 252           (insert-file-contents (expand-file-name "sitemap.org" dir))
 253           (buffer-substring (line-beginning-position 2) (point-max)))))))
 254   (should
 255    (equal
 256     "
 257 - [[file:b.org][b]]
 258 - [[file:sub/c.org][C]]
 259 - [[file:a.org][A]]"
 260     (org-test-publish
 261         '(:auto-sitemap t
 262                         :recursive t
 263                         :sitemap-style list
 264                         :sitemap-sort-folders ignore
 265                         :sitemap-sort-files chronologically
 266                         :exclude "."
 267                         :include ("a.org" "b.org" "sub/c.org"))
 268       (lambda (dir)
 269         (with-temp-buffer
 270           (insert-file-contents (expand-file-name "sitemap.org" dir))
 271           (buffer-substring (line-beginning-position 2) (point-max)))))))
 272   (should
 273    (equal
 274     "
 275 - [[file:a.org][A]]
 276 - [[file:sub/c.org][C]]
 277 - [[file:b.org][b]]"
 278     (org-test-publish
 279         '(:auto-sitemap t
 280                         :recursive t
 281                         :sitemap-style list
 282                         :sitemap-sort-folders ignore
 283                         :sitemap-sort-files anti-chronologically
 284                         :exclude "."
 285                         :include ("a.org" "b.org" "sub/c.org"))
 286       (lambda (dir)
 287         (with-temp-buffer
 288           (insert-file-contents (expand-file-name "sitemap.org" dir))
 289           (buffer-substring (line-beginning-position 2) (point-max)))))))
 290   ;; `:sitemap-format-entry' formats entries in the site-map whereas
 291   ;; `:sitemap-function' controls the full site-map.
 292   (should
 293    (equal "
 294 - a.org"
 295           (org-test-publish
 296               '(:auto-sitemap t
 297                               :exclude "."
 298                               :include ("a.org")
 299                               :sitemap-format-entry
 300                               (lambda (f _s _p) f))
 301             (lambda (dir)
 302               (with-temp-buffer
 303                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 304                 (buffer-substring (line-beginning-position 2) (point-max)))))))
 305   (should
 306    (equal "Custom!"
 307           (org-test-publish
 308               '(:auto-sitemap t
 309                               :exclude "."
 310                               :include ("a.org")
 311                               :sitemap-function (lambda (_title _f) "Custom!"))
 312             (lambda (dir)
 313               (with-temp-buffer
 314                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 315                 (buffer-string))))))
 316   (should
 317    (equal "[[file:a.org][A]]"
 318           (org-test-publish
 319               '(:auto-sitemap t
 320                               :exclude "."
 321                               :include ("a.org")
 322                               :sitemap-function
 323                               (lambda (_title f) (org-list-to-generic f nil)))
 324             (lambda (dir)
 325               (with-temp-buffer
 326                 (insert-file-contents (expand-file-name "sitemap.org" dir))
 327                 (buffer-string)))))))
 328
 329 \f
 330 ;;; Cross references
 331
 332 (ert-deftest test-org-publish/resolve-external-link ()
 333   "Test `org-publish-resolve-external-link' specifications."
 334   ;; Function should preserve internal reference when used between
 335   ;; published files.
 336   (should
 337    (apply
 338     #'equal
 339     (let* ((ids nil)
 340            (backend
 341             (org-export-create-backend
 342              :transcoders
 343              '((headline . (lambda (h c i)
 344                              (concat (org-export-get-reference h i) " " c)))
 345                (paragraph . (lambda (p c i) c))
 346                (section . (lambda (s c i) c))
 347                (link . (lambda (l c i)
 348                          (let ((option (org-element-property :search-option l))
 349                                (path (org-element-property :path l)))
 350                            (and option
 351                                 (org-publish-resolve-external-link
 352                                  option path))))))))
 353            (publish
 354             (lambda (plist filename pub-dir)
 355               (org-publish-org-to backend filename ".test" plist pub-dir))))
 356       (org-test-publish
 357           (list :publishing-function (list publish))
 358         (lambda (dir)
 359           (cl-subseq
 360            (split-string
 361             (mapconcat (lambda (f) (org-file-contents (expand-file-name f dir)))
 362                        (directory-files dir nil "\\.test\\'")
 363                        " "))
 364            1 3))))))
 365   ;; When optional argument PREFER-CUSTOM is non-nil, use custom ID
 366   ;; instead of internal reference, whenever possible.
 367   (should
 368    (equal
 369     '("a1" "b1")
 370     (let* ((ids nil)
 371            (link-transcoder
 372             (lambda (l c i)
 373               (let ((option (org-element-property :search-option l))
 374                     (path (org-element-property :path l)))
 375                 (push (org-publish-resolve-external-link option path t)
 376                       ids)
 377                 "")))
 378            (backend
 379             (org-export-create-backend
 380              :transcoders `((headline . (lambda (h c i) c))
 381                             (paragraph . (lambda (p c i) c))
 382                             (section . (lambda (s c i) c))
 383                             (link . ,link-transcoder))))
 384            (publish
 385             (lambda (plist filename pub-dir)
 386               (org-publish-org-to backend filename ".test" plist pub-dir))))
 387       (org-test-publish (list :publishing-function (list publish)
 388                               :exclude "."
 389                               :include '("a.org" "b.org"))
 390         #'ignore)
 391       (sort ids #'string<)))))
 392
 393 \f
 394 ;;; Tools
 395
 396 (ert-deftest test-org-publish/get-project-from-filename ()
 397   "Test `org-publish-get-project-from-filename' specifications."
 398   ;; Check base directory.
 399   (should
 400    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 401           (file (expand-file-name "a.org" base))
 402           (org-publish-project-alist `(("p" :base-directory ,base))))
 403      (org-publish-get-project-from-filename file)))
 404   ;; Return nil if no appropriate project is found.
 405   (should-not
 406    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 407           (file (expand-file-name "a.org" base))
 408           (org-publish-project-alist `(("p" :base-directory ,base))))
 409      (org-publish-get-project-from-filename "/other/file.org")))
 410   ;; Return the first project effectively publishing the provided
 411   ;; file.
 412   (should
 413    (equal "p2"
 414           (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 415                  (file (expand-file-name "a.org" base))
 416                  (org-publish-project-alist
 417                   `(("p1" :base-directory "/other/")
 418                     ("p2" :base-directory ,base)
 419                     ("p3" :base-directory ,base))))
 420             (car (org-publish-get-project-from-filename file)))))
 421   ;; When :recursive in non-nil, allow files in sub-directories.
 422   (should
 423    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 424           (file (expand-file-name "sub/c.org" base))
 425           (org-publish-project-alist
 426            `(("p" :base-directory ,base :recursive t))))
 427      (org-publish-get-project-from-filename file)))
 428   (should-not
 429    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 430           (file (expand-file-name "sub/c.org" base))
 431           (org-publish-project-alist
 432            `(("p" :base-directory ,base :recursive nil))))
 433      (org-publish-get-project-from-filename file)))
 434   ;; Also, when :recursive is non-nil, follow symlinks to directories.
 435   (should
 436    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 437           (file (expand-file-name "link/link.org" base))
 438           (org-publish-project-alist
 439            `(("p" :base-directory ,base :recursive t))))
 440      (org-publish-get-project-from-filename file)))
 441   (should-not
 442    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 443           (file (expand-file-name "link/link.org" base))
 444           (org-publish-project-alist
 445            `(("p" :base-directory ,base :recursive nil))))
 446      (org-publish-get-project-from-filename file)))
 447   ;; Check :base-extension.
 448   (should
 449    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 450           (file (expand-file-name "file.txt" base))
 451           (org-publish-project-alist
 452            `(("p" :base-directory ,base :base-extension "txt"))))
 453      (org-publish-get-project-from-filename file)))
 454   (should-not
 455    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 456           (file (expand-file-name "file.txt" base))
 457           (org-publish-project-alist
 458            `(("p" :base-directory ,base :base-extension "org"))))
 459      (org-publish-get-project-from-filename file)))
 460   ;; When :base-extension has the special value `any', allow any
 461   ;; extension, including none.
 462   (should
 463    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 464           (file (expand-file-name "file.txt" base))
 465           (org-publish-project-alist
 466            `(("p" :base-directory ,base :base-extension any))))
 467      (org-publish-get-project-from-filename file)))
 468   (should
 469    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 470           (file (expand-file-name "noextension" base))
 471           (org-publish-project-alist
 472            `(("p" :base-directory ,base :base-extension any))))
 473      (org-publish-get-project-from-filename file)))
 474   ;; Pathological case: Handle both :extension any and :recursive t.
 475   (should
 476    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 477           (file (expand-file-name "sub/c.org" base))
 478           (org-publish-project-alist
 479            `(("p" :base-directory ,base :recursive t :base-extension any))))
 480      (org-publish-get-base-files (org-publish-get-project-from-filename file))))
 481   ;; Check :exclude property.
 482   (should-not
 483    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 484           (file (expand-file-name "a.org" base))
 485           (org-publish-project-alist
 486            `(("p" :base-directory ,base :exclude "a"))))
 487      (org-publish-get-project-from-filename file)))
 488   (should
 489    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 490           (file (expand-file-name "a.org" base))
 491           (org-publish-project-alist
 492            `(("p" :base-directory ,base :exclude "other"))))
 493      (org-publish-get-project-from-filename file)))
 494   ;; The regexp matches against relative file name, not absolute one.
 495   (should
 496    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 497           (file (expand-file-name "a.org" base))
 498           (org-publish-project-alist
 499            `(("p" :base-directory ,base :exclude "examples/pub"))))
 500      (org-publish-get-project-from-filename file)))
 501   ;; Check :include property.
 502   (should
 503    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 504           (file (expand-file-name "file.txt" base))
 505           (org-publish-project-alist
 506            `(("p" :base-directory ,base :include (,file)))))
 507      (org-publish-get-project-from-filename file)))
 508   ;; :include property has precedence over :exclude one.
 509   (should
 510    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 511           (file (expand-file-name "a.org" base))
 512           (org-publish-project-alist
 513            `(("p"
 514               :base-directory ,base
 515               :include (,(file-name-nondirectory file))
 516               :exclude "a"))))
 517      (org-publish-get-project-from-filename file)))
 518   ;; With optional argument, return a meta-project publishing provided
 519   ;; file.
 520   (should
 521    (equal "meta"
 522           (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 523                  (file (expand-file-name "a.org" base))
 524                  (org-publish-project-alist
 525                   `(("meta" :components ("p"))
 526                     ("p" :base-directory ,base))))
 527             (car (org-publish-get-project-from-filename file t))))))
 528
 529 (ert-deftest test-org-publish/file-relative-name ()
 530   "Test `org-publish-file-relative-name' specifications."
 531   ;; Turn absolute file names into relative ones if file belongs to
 532   ;; base directory.
 533   (should
 534    (equal "a.org"
 535           (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 536                  (file (expand-file-name "a.org" base)))
 537             (org-publish-file-relative-name file `(:base-directory ,base)))))
 538   (should
 539    (equal "pub/a.org"
 540           (let* ((base (expand-file-name "examples/" org-test-dir))
 541                  (file (expand-file-name "pub/a.org" base)))
 542             (org-publish-file-relative-name file `(:base-directory ,base)))))
 543   ;; Absolute file names that do not belong to base directory are
 544   ;; unchanged.
 545   (should
 546    (equal "/name.org"
 547           (let ((base (expand-file-name "examples/pub/" org-test-dir)))
 548             (org-publish-file-relative-name "/name.org"
 549                                             `(:base-directory ,base)))))
 550   ;; Relative file names are unchanged.
 551   (should
 552    (equal "a.org"
 553           (let ((base (expand-file-name "examples/pub/" org-test-dir)))
 554             (org-publish-file-relative-name "a.org" `(:base-directory ,base))))))
 555
 556
 557 (provide 'test-ox-publish)
 558 ;;; test-ox-publish.el ends here