WiLiKi:静的HTMLへの変換

WiLiKi:静的HTMLへの変換

WiLiKi-0.5でフォーマット関係のAPIを変更したので、このままでは 動かなくなってしまいました。 ぼちぼち直します。--Shiro


WiLiKiのデータベースからドキュメントを吸い出して、静的なHTMLページ群へと 変換するスクリプトです。

まだ、wilikiのAPIが整備されていないため、wiliki本体の関数を再定義するとか いろいろ怪しいことをやっていますが、wiliki-0.5までにはそのへんを綺麗に する予定です。

標準添付のマクロだけなら多分ちゃんと動きますが、 wilikiページ内への文書のリンクを直接生成するマクロを使っている場合には うまく変換できないと思います。

#!/usr/bin/env gosh
;;;
;;; wiliki2html - converts wiliki database to a static HTML document
;;;
;;;  Copyright (c) 2003 Shiro Kawai, All rights reserved.
;;;
;;;  Permission is hereby granted, free of charge, to any person
;;;  obtaining a copy of this software and associated documentation
;;;  files (the "Software"), to deal in the Software without restriction,
;;;  including without limitation the rights to use, copy, modify,
;;;  merge, publish, distribute, sublicense, and/or sell copies of
;;;  the Software, and to permit persons to whom the Software is
;;;  furnished to do so, subject to the following conditions:
;;;
;;;  The above copyright notice and this permission notice shall be
;;;  included in all copies or substantial portions of the Software.
;;;
;;;  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;;  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;;;  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;;  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;;;  BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
;;;  AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
;;;  OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
;;;  IN THE SOFTWARE.
;;;
;;;  $Id: wiliki2html,v 1.1 2003/11/19 14:51:51 shirok Exp $

;; NB: This is just a quick hack.  The next version of wiliki
;; will provide enough APIs so that users can create applications
;; like this by just "use"-ing wiliki, instead of overriding
;; internal procedures.  Please do not think this as an example
;; of wiliki-based applications!

(extend wiliki)
(use wiliki.db)
(use srfi-2)
(use wiliki.format)
(use gauche.sequence)
(use gauche.uvector)
(use gauche.parseopt)
(use gauche.parameter)
(use text.html-lite)
(use text.tree)
(use util.list)
(use file.util)

(require "wiliki/macro")

;; Wiliki 0.4 lacks these 'provide' directives, causing some undesirable
;; reloading of these modules.
(provide "wiliki")
(provide "wiliki/macro")
(provide "wiliki/db")

;; utilities ---------------------------------------------

(define (usage)
  (print "Usage: wiliki2html [-o <output-dir>] <wiliki.cgi>")
  (exit 0))

(define (app-error . args)
  (apply format (current-error-port) args)
  (newline (current-error-port))
  (exit 70))

(define (pagename->path pagename)
  (with-string-io pagename
    (lambda ()
      (let loop ((ch (read-char)))
        (cond ((eof-object? ch) (display ".html"))
              ((char-set-contains? #[[:alpha:][:digit:]] ch)
               (display ch) (loop (read-char)))
              (else (for-each (cut format #t "_~2,'0X" <>)
                              (string->u8vector (string ch)))
                    (loop (read-char))))))))

;; Loads wiliki.cgi.  Returns <wiliki> object.
(define (load-wiliki.cgi path)
  (let ((mod (make-module #f)))
    (with-error-handler
        (lambda (e)
          (app-error "Loading ~a failed: ~a" path (ref e 'message)))
      (lambda ()
        (eval '(define wiliki-main values) mod)
        (load path :paths '(".") :environment mod)
        (eval '(main '()) mod)))))

;; alternative formatters --------------------------------

(define (html-format-page title page . args)
  (let-keywords* args ((show-all?  #t)
                       (page-id title))
    (let* ((wlki (wiliki))
           (content (if (is-a? page <page>)
                      (list (format-content page)
                            (format-footer page))
                      page)))
      (html-page
       (html:title (html-escape-string title))
       (html:h1 (html-escape-string title))
       (html:div
        :align "right"
        (cond-list
         ((not (string=? title (top-page-of wlki)))
          (html:a :href (pagename->path (top-page-of wlki)) ($$ "[Top Page]")))
         ;(show-all?
         ; (html:a :href (url "c=a") ($$ "[All Pages]")))
         ))
       (html:hr)
       content))))

;; Redefine html-page in wiliki module
(define (html-page head-elements . body-elements)
  `(,(html-doctype :type :transitional)
    ,(html:html
      (html:head
       head-elements
       (or (and-let* ((w (wiliki)) (ss (style-sheet-of w)))
             (html:link :rel "stylesheet" :href ss :type "text/css"))
           ;; default
           "<style type=\"text/css\"> body { background-color: #eeeedd }</style>"))
      (html:body
       body-elements))))

;; Redefine wikiname anchor formatter
(define-in-module wiliki.format
  (format-wikiname-anchor wikiname)
  (html:a :href (pagename->path wikiname) (html-escape-string wikiname)))

(with-module wiliki.format
  (define (format-wiki-name name)
    (receive (prefix inner) (inter-wiki-name? name)
      (cond ((reader-macro-wiki-name? name))
            (prefix
             (let ((scheme
                    (if (#/^(https?|ftp|mailto):/ prefix) "" "http://")))
               (tree->string (html:a
                              :href (format "~a~a~a" scheme prefix
                                            (uri-encode-string (cv-out inner)))
                              (html-escape-string name)))))
            ((or (wdb-exists? (db) name) (virtual-page? name))
             (tree->string (format-wikiname-anchor name)))
            (else
             (html-escape-string name))
            )))
  )

;; override toc macro
(with-module wiliki
  (set! *reader-macro-alist*
        (alist-delete "$$toc" *reader-macro-alist* equal?)))

(define-reader-macro (toc . maybe-page)
  (let1 pagename (get-optional maybe-page (key-of (current-formatting-page)))
    (define (anchor id line)
      (html:a :href #`",(pagename->path pagename)#,id"
              (html-escape-string line)))
    (define (make-toc page)
      (with-input-from-string (content-of page)
        (lambda ()
          (let loop ((line (read-line))
                     (depth 0)
                     (r '())
                     (id 0))
            (cond
             ((eof-object? line)
              (reverse (append (make-list depth "</ul>") r)))
             ((string=? line "{{{")
              ;; need to skip <pre> section
              (let skip ((line (read-line)))
                (cond ((eof-object? line) (loop line depth r id))
                      ((string=? line "}}}") (loop (read-line) depth r id))
                      (else (skip (read-line))))))
             ((rxmatch #/^\*+ / line) =>
              (lambda (m)
                (let1 newdepth (- (string-length (m)) 1)
                  (cond ((= newdepth depth)
                         (loop (read-line)
                               newdepth
                               (cons* (anchor id (rxmatch-after m)) "<li> " r)
                               (+ id 1)))
                        ((> newdepth depth)
                         (loop (read-line)
                               newdepth
                               (cons* (anchor id (rxmatch-after m)) "<li> "
                                      (make-list (- newdepth depth) "<ul>")
                                      r)
                               (+ id 1)))
                        (else
                         (loop (read-line)
                               newdepth
                               (cons* (anchor id (rxmatch-after m)) "<li>"
                                      (make-list (- depth newdepth) "</ul>")
                                      r)
                               (+ id 1)))
                        ))))
             (else (loop (read-line) depth r id)))))))
    (cond ((wdb-get (db) pagename) => make-toc)
          (else #`"[[$$toc]]"))
    ))

;; main entry ---------------------------------------------

(define (process-wiliki output-dir)
  (wdb-map (db)
           (lambda (key record)
             (let ((page (wdb-record->page (db) key record)))
               (with-output-to-file
                   (build-path output-dir (pagename->path key))
                 (cut write-tree (html-format-page key page)))))
           ))

(define (main args)
  (let-args (cdr args)
      ((output-dir "o=s")
       . args)
    (unless (= (length args) 1) (usage))
    (unless (file-is-readable? (car args))
      (app-error "Cannot read ~a" (car args)))
    (let* ((wlki (load-wiliki.cgi (car args)))
           (odir (or output-dir (sys-basename (ref wlki 'db-path)))))
      (when (file-exists? odir)
        (app-error "A file is in the way to create output directory: ~a" odir))
      (make-directory* odir)
      ;; fake parameters
      (wiliki wlki)
      (lang 'jp)
      (with-db (cut process-wiliki odir)))
    )
  0)

;; Local variables:
;; mode: scheme
;; end:
More ...