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"
 370     (let* ((ids nil)
 371            (backend
 372             (org-export-create-backend
 373              :transcoders
 374              '((headline . (lambda (h c i) c))
 375                (paragraph . (lambda (p c i) c))
 376                (section . (lambda (s c i) c))
 377                (link . (lambda (l c i)
 378                          (let ((option (org-element-property :search-option l))
 379                                (path (org-element-property :path l)))
 380                            (when option
 381                              (throw :exit (org-publish-resolve-external-link
 382                                            option path t)))))))))
 383            (publish
 384             (lambda (plist filename pub-dir)
 385               (push (catch :exit
 386                       (org-publish-org-to backend filename ".test" plist pub-dir))
 387                     ids))))
 388       (org-test-publish (list :publishing-function (list publish)) #'ignore)
 389       (car ids)))))
 390
 391 \f
 392 ;;; Tools
 393
 394 (ert-deftest test-org-publish/get-project-from-filename ()
 395   "Test `org-publish-get-project-from-filename' specifications."
 396   ;; Check base directory.
 397   (should
 398    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 399           (file (expand-file-name "a.org" base))
 400           (org-publish-project-alist `(("p" :base-directory ,base))))
 401      (org-publish-get-project-from-filename file)))
 402   ;; Return nil if no appropriate project is found.
 403   (should-not
 404    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 405           (file (expand-file-name "a.org" base))
 406           (org-publish-project-alist `(("p" :base-directory ,base))))
 407      (org-publish-get-project-from-filename "/other/file.org")))
 408   ;; Return the first project effectively publishing the provided
 409   ;; file.
 410   (should
 411    (equal "p2"
 412           (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 413                  (file (expand-file-name "a.org" base))
 414                  (org-publish-project-alist
 415                   `(("p1" :base-directory "/other/")
 416                     ("p2" :base-directory ,base))))
 417             (car (org-publish-get-project-from-filename file)))))
 418   ;; When :recursive in non-nil, allow files in sub-directories.
 419   (should
 420    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 421           (file (expand-file-name "sub/c.org" base))
 422           (org-publish-project-alist
 423            `(("p" :base-directory ,base :recursive t))))
 424      (org-publish-get-project-from-filename file)))
 425   (should-not
 426    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 427           (file (expand-file-name "sub/c.org" base))
 428           (org-publish-project-alist
 429            `(("p" :base-directory ,base :recursive nil))))
 430      (org-publish-get-project-from-filename file)))
 431   ;; Check :base-extension.
 432   (should
 433    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 434           (file (expand-file-name "file.txt" base))
 435           (org-publish-project-alist
 436            `(("p" :base-directory ,base :base-extension "txt"))))
 437      (org-publish-get-project-from-filename file)))
 438   (should-not
 439    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 440           (file (expand-file-name "file.txt" base))
 441           (org-publish-project-alist
 442            `(("p" :base-directory ,base :base-extension "org"))))
 443      (org-publish-get-project-from-filename file)))
 444   ;; When :base-extension has the special value `any', allow any
 445   ;; extension, including none.
 446   (should
 447    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 448           (file (expand-file-name "file.txt" base))
 449           (org-publish-project-alist
 450            `(("p" :base-directory ,base :base-extension any))))
 451      (org-publish-get-project-from-filename file)))
 452   (should
 453    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 454           (file (expand-file-name "noextension" base))
 455           (org-publish-project-alist
 456            `(("p" :base-directory ,base :base-extension any))))
 457      (org-publish-get-project-from-filename file)))
 458   ;; Pathological case: Handle both :extension any and :recursive t.
 459   (should
 460    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 461           (file (expand-file-name "sub/c.org" base))
 462           (org-publish-project-alist
 463            `(("p" :base-directory ,base :recursive t :base-extension any))))
 464      (org-publish-get-base-files (org-publish-get-project-from-filename file))))
 465
 466   ;; Check :exclude property.
 467   (should-not
 468    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 469           (file (expand-file-name "a.org" base))
 470           (org-publish-project-alist
 471            `(("p" :base-directory ,base :exclude "a"))))
 472      (org-publish-get-project-from-filename file)))
 473   (should
 474    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 475           (file (expand-file-name "a.org" base))
 476           (org-publish-project-alist
 477            `(("p" :base-directory ,base :exclude "other"))))
 478      (org-publish-get-project-from-filename file)))
 479   ;; The regexp matches against relative file name, not absolute one.
 480   (should
 481    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 482           (file (expand-file-name "a.org" base))
 483           (org-publish-project-alist
 484            `(("p" :base-directory ,base :exclude "examples/pub"))))
 485      (org-publish-get-project-from-filename file)))
 486   ;; Check :include property.
 487   (should
 488    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 489           (file (expand-file-name "file.txt" base))
 490           (org-publish-project-alist
 491            `(("p" :base-directory ,base :include (,file)))))
 492      (org-publish-get-project-from-filename file)))
 493   ;; :include property has precedence over :exclude one.
 494   (should
 495    (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 496           (file (expand-file-name "a.org" base))
 497           (org-publish-project-alist
 498            `(("p"
 499               :base-directory ,base
 500               :include (,(file-name-nondirectory file))
 501               :exclude "a"))))
 502      (org-publish-get-project-from-filename file)))
 503   ;; With optional argument, return a meta-project publishing provided
 504   ;; file.
 505   (should
 506    (equal "meta"
 507           (let* ((base (expand-file-name "examples/pub/" org-test-dir))
 508                  (file (expand-file-name "a.org" base))
 509                  (org-publish-project-alist
 510                   `(("meta" :components ("p"))
 511                     ("p" :base-directory ,base))))
 512             (car (org-publish-get-project-from-filename file t))))))
 513
 514
 515 (provide 'test-ox-publish)
 516 ;;; test-ox-publish.el ends here