/dylan/page.dylan
Unknown | 765 lines | 666 code | 99 blank | 0 comment | 0 complexity | cdefc73b2d102f6e4cf2f01fd4a566cd MD5 | raw file
- Module: %wiki
- /// Default number of pages to show on the list-pages page.
- define constant $default-list-size :: <integer> = 25;
- // Represents a user-editable wiki page revision. Not to be confused
- // with <wiki-dsp>, which is a DSP maintained in our source code tree.
- //
- define class <wiki-page> (<wiki-object>)
- constant slot page-source :: <string>,
- required-init-keyword: source:;
- // A sequence of <string>s (of RST source) or <wiki-reference>s.
- constant slot page-parsed-source :: <sequence>,
- init-keyword: parsed-source:;
- // Comment entered by the user describing the changes for this revision.
- constant slot page-comment :: <string>,
- required-init-keyword: comment:;
- // The owner has special rights over the page, depending on the ACLs.
- // The owner only changes if explicitly changed via the edit-acls page.
- // TODO: move this into <acls>.
- slot page-owner :: <wiki-user>,
- required-init-keyword: owner:;
- // The author is the one who saved this particular revision of the page.
- constant slot page-author :: <wiki-user>,
- required-init-keyword: author:;
- slot page-access-controls :: <acls>,
- required-init-keyword: access-controls:;
- // Tags (strings) entered by the author when the page was saved.
- constant slot page-tags :: <sequence> = #(),
- init-keyword: tags:;
- // e.g. a git commit hash or a revision number
- // Filled in by the storage back-end.
- slot page-revision :: <string>,
- init-keyword: revision:;
- end class <wiki-page>;
- /// Provide defaulting and a copy-from argument.
- define method make
- (class == <wiki-page>,
- #rest args,
- #key copy-from :: false-or(<wiki-page>),
- name, source, parsed-source, comment, owner,
- author, tags, access-controls, revision)
- => (page :: <wiki-page>)
- let p = copy-from;
- let name = name | (p & p.object-name);
- let source = source | (p & p.page-source);
- let owner = owner | (p & p.page-owner) | author;
- apply(next-method,
- class,
- name: name,
- source: source,
- parsed-source: parsed-source
- | (source & parse-wiki-markup(source, name))
- | (p & p.parsed-source),
- comment: comment | "",
- owner: owner,
- author: author | (p & p.page-author) | owner,
- tags: tags | (p & p.page-tags) | #(),
- access-controls: access-controls
- | (p & p.page-access-controls)
- | $default-access-controls,
- args)
- end method make;
- // back compat
- define inline function page-title
- (page :: <wiki-page>) => (title :: <string>)
- page.object-name
- end;
- // back compat
- /* unused
- define inline function page-title-setter
- (new-name :: <string>, page :: <wiki-page>) => (new-name :: <string>)
- page.object-name := new-name
- end;
- */
- define thread variable *page* :: false-or(<wiki-page>) = #f;
- define named-method page? in wiki
- (page :: <dylan-server-page>)
- *page* ~= #f
- end;
- //// URLs
- define method permanent-link
- (page :: <wiki-page>)
- => (url :: <url>)
- page-permanent-link(page.page-title)
- end;
- define method page-permanent-link
- (title :: <string>)
- => (url :: <url>)
- let location = wiki-url("/page/view/%s", title);
- transform-uris(request-url(current-request()), location, as: <url>)
- end;
- define method redirect-to (page :: <wiki-page>)
- redirect-to(permanent-link(page));
- end;
- /// Find a cached page.
- define method find-page
- (title :: <string>)
- => (page :: false-or(<wiki-page>))
- element(*pages*, title, default: #f)
- end;
- /* unused
- define method page-exists?
- (title :: <string>) => (exists? :: <boolean>)
- find-page(title) & #t
- end;
- */
- // The latest revisions of all pages are loaded at startup for now (to
- // simplify searches and iteration over lists of pages) so this will only
- // load anything if the 'revision' arg is supplied. Note that 'revision'
- // should never be "head" or any other symbolic revision.
- //
- define method find-or-load-page
- (title :: <string>, #key revision :: false-or(<string>))
- => (page :: false-or(<wiki-page>))
- let page = find-page(title);
- if (page & (~revision | page.page-revision = revision))
- page
- else
- block ()
- if (revision)
- // Don't attempt to cache older revisions of pages.
- load(*storage*, <wiki-page>, title, revision: revision);
- else
- // Load page is slow, do it without the lock held.
- let loaded-page = load(*storage*, <wiki-page>, title);
- with-lock ($page-lock)
- // check again with lock held
- find-page(title)
- | (*pages*[title] := loaded-page)
- end
- end
- exception (ex :: <git-storage-error>)
- #f
- end
- end
- end method find-or-load-page;
- // The plan is for this to eventually support many more search criteria,
- // such as searching by owner, author, date ranges, etc.
- //
- define method find-pages
- (#key tags :: <sequence> = #[],
- order-by :: <function> = title-less?)
- => (pages :: <sequence>)
- let pages = sort(with-lock ($page-lock)
- value-sequence(*pages*)
- end,
- test: order-by);
- if (~empty?(tags))
- local method page-has-tags? (page :: <wiki-page>)
- any?(method (tag)
- member?(tag, page.page-tags, test: \=)
- end,
- tags)
- end;
- pages := choose(page-has-tags?, pages);
- end;
- pages
- end;
- define function title-less?
- (p1 :: <wiki-page>, p2 :: <wiki-page>) => (less? :: <boolean>)
- as-lowercase(p1.page-title) < as-lowercase(p2.page-title)
- //case-insensitive-less?(p1.page-title, p2.page-title)
- end;
- define function creation-date-newer?
- (p1 :: <wiki-page>, p2 :: <wiki-page>) => (less? :: <boolean>)
- p1.creation-date > p2.creation-date
- end;
- // todo -- Implement this as a wiki page.
- define constant $reserved-tags :: <sequence> = #["news"];
- define method reserved-tag?
- (tag :: <string>) => (reserved? :: <boolean>)
- member?(tag, $reserved-tags, test: \=)
- end;
- define method save-page
- (title :: <string>, source :: <string>, comment :: <string>, tags :: <sequence>)
- => (page :: <wiki-page>)
- let user = authenticated-user();
- let old-page = find-page(title);
- let page = make(<wiki-page>,
- copy-from: old-page,
- name: title,
- source: source,
- tags: tags,
- comment: comment,
- author: user);
- update-reference-tables!(page,
- iff(old-page,
- outbound-references(old-page),
- #()),
- outbound-references(page));
- let action = "create";
- with-lock ($page-lock)
- if (key-exists?(*pages*, title))
- action := "edit";
- end;
- *pages*[title] := page;
- end;
- page.page-revision := store(*storage*, page, page.page-author, comment,
- standard-meta-data(page, action));
- /*
- TODO:
- block ()
- generate-connections-graph(page);
- exception (ex :: <serious-condition>)
- // we don't care about the graph (yet?)
- // maybe the server doesn't have "dot" installed.
- log-error("Error generating connections graph for page %s: %s",
- title, ex);
- end;
- */
- page
- end method save-page;
- /* Not converted to new git-backed wiki yet...
- define method generate-connections-graph
- (page :: <wiki-page>) => ()
- let graph = make(gvr/<graph>);
- let node = gvr/create-node(graph, label: page.page-title);
- let backlinks = find-backlinks(page);
- backlinks := map(page-title, backlinks);
- gvr/add-predecessors(node, backlinks);
- gvr/add-successors(node, last(page.page-versions).references);
- for (node in gvr/nodes(graph))
- node.gvr/attributes["URL"] := build-uri(page-permanent-link(node.gvr/label));
- node.gvr/attributes["color"] := "blue";
- node.gvr/attributes["style"] := "filled";
- node.gvr/attributes["fontname"] := "Verdana";
- node.gvr/attributes["shape"] := "note";
- end for;
- let temporary-graph = gvr/generate-graph(graph, node, format: "svg");
- let graph-file = as(<file-locator>, temporary-graph);
- if (file-exists?(graph-file))
- let destination = as(<file-locator>,
- concatenate("graphs/", page.page-title, ".svg"));
- rename-file(graph-file, destination, if-exists: #"replace");
- end if;
- end;
- */
- /* unused
- define method rename-page
- (page :: <wiki-page>, new-title :: <string>, comment ::<string>)
- => ()
- let author = authenticated-user();
- let old-title = page.page-title;
- let revision = rename(*storage*, page, new-title, author, comment,
- standard-meta-data(page, "rename"));
- with-lock ($page-lock)
- remove-key!(*pages*, old-title);
- *pages*[new-title] := page;
- end;
- page.page-title := new-title;
- page.page-revision := revision;
- end method rename-page;
- */
- define method discussion-page?
- (page :: <wiki-page>)
- => (is? :: <boolean>)
- let (matched?, discussion, title)
- = regex-search-strings(compile-regex("(Discussion: )(.*)"),
- page.page-title);
- matched? = #t;
- end;
- //// List Versions
- define class <page-history-page> (<wiki-dsp>)
- end;
- define method respond-to-get
- (dsp :: <page-history-page>,
- #key title :: <string>, revision :: false-or(<string>))
- let title = percent-decode(title);
- let page = find-or-load-page(title);
- if (page)
- dynamic-bind (*page* = page)
- let pc = page-context();
- set-attribute(pc, "title", title);
- local method change-to-table (change)
- // TODO: a way to define DSP accessors for objects such as
- // <wiki-change> so this isn't necessary.
- make-table(<string-table>,
- "author" => change.change-author,
- "date" => as-iso8601-string(change.change-date),
- "rev" => change.change-revision,
- "comment" => change.change-comment)
- end;
- set-attribute(pc, "page-changes",
- map(change-to-table,
- find-changes(*storage*, <wiki-page>,
- name: title, start: revision)));
- next-method();
- end;
- else
- respond-to-get(*non-existing-page-page*, title: title);
- end;
- end;
- //// Page references (connections, backlinks)
- define class <connections-page> (<wiki-dsp>)
- end;
- define method respond-to-get
- (page :: <connections-page>, #key title :: <string>)
- let title = percent-decode(title);
- dynamic-bind (*page* = find-or-load-page(title))
- if (*page*)
- next-method();
- else
- respond-to-get(*non-existing-page-page*, title: title);
- end;
- end;
- end method respond-to-get;
- // rename to list-referring-pages
- define body tag list-page-backlinks in wiki
- (page :: <wiki-dsp>, do-body :: <function>)
- ()
- let backlinks = sort(inbound-references(*page*),
- test: method (x, y)
- as-lowercase(x.object-name) < as-lowercase(y.object-name)
- end);
- if (empty?(backlinks))
- output("There are no connections to this page.");
- else
- let pc = page-context();
- for (backlink in backlinks)
- set-attribute(pc, "backlink", backlink.page-title);
- set-attribute(pc, "backlink-url", as(<string>, permanent-link(backlink)));
- do-body();
- end for;
- end if;
- end;
- //// List Pages
- define class <list-pages-page> (<wiki-dsp>) end;
- /// GET lists the pages in alphabetical order
- ///
- define method respond-to-get
- (dsp :: <list-pages-page>, #key)
- let pc = page-context();
- local method page-info (page :: <wiki-page>)
- make-table(<string-table>,
- "title" => page.page-title,
- "when-published" => standard-date-and-time(page.creation-date),
- "latest-authors" => page.page-author.user-name)
- end;
- let current-page = get-query-value("page", as: <integer>) | 1;
- let paginator = make(<paginator>,
- sequence: map(page-info, find-pages()),
- page-size: $default-list-size,
- current-page-number: current-page);
- set-attribute(pc, "wiki-pages", paginator);
- next-method();
- end method respond-to-get;
- /// POST finds a particular page (the 'query') and displays it.
- ///
- define method respond-to-post
- (dsp :: <list-pages-page>, #key)
- redirect-to(page-permanent-link(get-query-value("query")));
- end;
- //// Remove page
- define class <remove-page-page> (<wiki-dsp>)
- end;
- define method respond-to-get
- (dsp :: <remove-page-page>, #key title :: <string>)
- dynamic-bind (*page* = find-or-load-page(title))
- process-template(dsp);
- end;
- end;
- define method respond-to-post
- (dsp :: <remove-page-page>, #key title :: <string>)
- let page = find-or-load-page(percent-decode(title));
- if (page)
- delete(*storage*, page, authenticated-user(),
- get-query-value("comment") | "",
- standard-meta-data(page, "delete"));
- with-lock ($page-lock)
- remove-key!(*pages*, title);
- end;
- add-page-note("Page %= has been deleted.", title);
- redirect-to(wiki-url("/") /* generate-url("wiki.home") */);
- else
- respond-to-get(*non-existing-page-page*, title: title);
- end;
- end;
- //// View Page
- // Provide backward compatibility with old wiki URLs
- // /wiki/view.dsp?title=t&version=v
- //
- define method show-page-back-compatible
- (#key)
- with-query-values (title, version)
- let title = percent-decode(title);
- let version = version & percent-decode(version);
- let default = current-request().request-absolute-url;
- let url = make(<url>,
- scheme: default.uri-scheme,
- host: default.uri-host,
- port: default.uri-port,
- // No, I don't understand the empty string either.
- path: concatenate(list("", "pages", title),
- iff(version,
- list("versions", version),
- #())));
- let location = as(<string>, url);
- moved-permanently-redirect(location: location,
- header-name: "Location",
- header-value: location);
- end;
- end;
- define class <view-page-page> (<wiki-dsp>)
- end;
- define method respond-to-get
- (dsp :: <view-page-page>,
- #key title :: <string>, version :: false-or(<string>))
- let title = percent-decode(title);
- dynamic-bind (*page* = find-or-load-page(title, revision: version))
- if (*page*)
- process-template(dsp);
- elseif (authenticated-user())
- // Give the user a change to create the page.
- respond-to-get(*edit-page-page*, title: title);
- else
- respond-to-get(*non-existing-page-page*, title: title);
- end;
- end;
- end method respond-to-get;
- define tag render-page in wiki
- (page :: <wiki-dsp>)
- ()
- output("%s", as-html(*page*, *page*.page-title))
- end;
- //// Edit Page
- define class <edit-page-page> (<wiki-dsp>)
- end;
- define method respond-to-get
- (page :: <edit-page-page>, #key title :: <string>)
- let title = percent-decode(title);
- let pc = page-context();
- if (authenticated-user())
- set-attribute(pc, "title", title);
- set-attribute(pc, "previewing?", #f);
- dynamic-bind (*page* = find-or-load-page(title))
- set-attribute(pc, "original-title", title);
- if (*page*)
- // TODO: change this to "source"
- set-attribute(pc, "content", *page*.page-source);
- set-attribute(pc, "owner", *page*.page-owner);
- set-attribute(pc, "tags", unparse-tags(*page*.page-tags));
- end;
- next-method();
- end;
- else
- // This shouldn't happen unless the user typed in the /edit url,
- // since the edit option shouldn't be available unless logged in.
- add-page-error("You must be logged in to edit wiki pages.");
- respond-to-get(*view-page-page*, title: title);
- end;
- end method respond-to-get;
- // Note that when the title is changed and the page is being previewed
- // we have to keep track of the old title. The POST is always to the
- // existing title, and when it's not a preview, the rename is done.
- //
- define method respond-to-post
- (wiki-dsp :: <edit-page-page>, #key title :: <string>)
- let title = percent-decode(title);
- let page = find-or-load-page(title);
- with-query-values (content, comment, tags, button)
- let source = content | "";
- let tags = iff(tags, parse-tags(tags), #[]);
- let previewing? = (button = "Preview");
- let author = authenticated-user();
- if (page & ~has-permission?(author, page, $modify-content))
- add-page-error("You do not have permission to edit this page.");
- end;
- let reserved-tags = choose(reserved-tag?, tags);
- if (~empty?(reserved-tags) & ~administrator?(author))
- add-field-error("tags", "The tag%s %s %s reserved for administrator use.",
- iff(reserved-tags.size = 1, "", "s"),
- join(tags, ", ", conjunction: " and "),
- iff(reserved-tags.size = 1, "is", "are"));
- end;
- if (previewing? | page-has-errors?())
- dynamic-bind (*page* = make(<wiki-page>,
- copy-from: page,
- name: title,
- source: source,
- comment: comment,
- author: author))
- let pc = page-context();
- set-attribute(pc, "previewing?", #t);
- set-attribute(pc, "title", title);
- set-attribute(pc, "preview", as-html(source, title));
- process-template(wiki-dsp);
- end;
- else
- let page = save-page(title, source, comment, tags);
- redirect-to(page);
- end;
- end;
- end method respond-to-post;
- //// View Diff
- define class <view-diff-page> (<wiki-dsp>)
- end;
- // /page/diff/Title/n -- Show the diff for revision n.
- //
- define method respond-to-get
- (dsp :: <view-diff-page>,
- #key title :: <string>,
- revision :: false-or(<string>))
- let title = percent-decode(title);
- let changes = find-changes(*storage*, <wiki-page>,
- start: revision, name: title, count: 1, diff?: #t);
- if (empty?(changes))
- add-page-error("No diff for page %= found.", title);
- redirect-to(find-page(title) | *non-existing-page-page*);
- else
- let change :: <wiki-change> = changes[0];
- let pc = page-context();
- set-attribute(pc, "name", change.change-object-name);
- set-attribute(pc, "diff", change.change-diff);
- set-attribute(pc, "author", change.change-author);
- set-attribute(pc, "comment", change.change-comment);
- set-attribute(pc, "date", as-iso8601-string(change.change-date));
- process-template(dsp);
- end;
- end method respond-to-get;
- define method print-diff-entry
- (entry :: <insert-entry>, seq1 :: <sequence>, seq2 :: <sequence>)
- let lineno1 = entry.source-index + 1;
- let lineno2 = entry.element-count + entry.source-index;
- if (lineno1 = lineno2)
- output("Added line %d:<br/>", lineno1);
- else
- output("Added lines %d - %d:<br/>", lineno1, lineno2);
- end;
- for (line in copy-sequence(seq2, start: lineno1 - 1, end: lineno2),
- lineno from lineno1)
- output("%d: %s<br/>", lineno, line);
- end;
- end method print-diff-entry;
-
- define method print-diff-entry
- (entry :: <delete-entry>, seq1 :: <sequence>, seq2 :: <sequence>)
- let lineno1 = entry.dest-index + 1;
- let lineno2 = entry.element-count + entry.dest-index;
- if (lineno1 = lineno2)
- output("Removed line %d:<br/>", lineno1);
- else
- output("Removed lines %d - %d:<br/>", lineno1, lineno2);
- end;
- for (line in copy-sequence(seq1, start: lineno1 - 1, end: lineno2),
- lineno from lineno1)
- output("%d: %s<br/>", lineno, line);
- end;
- end method print-diff-entry;
- define tag show-diff-entry in wiki
- (page :: <view-diff-page>)
- (name :: <string>)
- let pc = page-context();
- let entry = get-attribute(pc, name);
- let seq1 = get-attribute(pc, "seq1");
- let seq2 = get-attribute(pc, "seq2");
- print-diff-entry(entry, seq1, seq2);
- end tag show-diff-entry;
- //// Tags
- define tag show-page-permanent-link in wiki
- (page :: <wiki-dsp>)
- ()
- if (*page*)
- output("%s", permanent-link(*page*))
- end;
- end;
- // Show the title of the main page corresponding to a discussion page.
- define tag show-main-page-title in wiki
- (page :: <wiki-dsp>) ()
- if (*page*)
- let main-title = regex-replace(*page*.page-title, compile-regex("^Discussion: "), "");
- output("%s", escape-xml(main-title));
- end;
- end tag show-main-page-title;
- // Show the title of the discussion page corresponding to a main page.
- define tag show-discussion-page-title in wiki
- (page :: <wiki-dsp>) ()
- if (*page*)
- let discuss-title = concatenate("Discussion: ", *page*.page-title);
- output("%s", escape-xml(discuss-title));
- end;
- end tag show-discussion-page-title;
- define tag show-page-title in wiki
- (page :: <wiki-dsp>)
- ()
- if (*page*)
- output("%s", escape-xml(*page*.page-title));
- end;
- end;
- define tag show-page-owner in wiki
- (page :: <wiki-dsp>)
- ()
- if (*page*)
- output("%s", escape-xml(*page*.page-owner.user-name))
- end;
- end;
- define tag show-version in wiki
- (page :: <wiki-dsp>)
- ()
- output("%s", *page*.page-revision);
- end;
- define tag include-page in wiki
- (dsp :: <wiki-dsp>)
- (title :: <string>)
- let page = find-or-load-page(title);
- if (page)
- output("%s", as-html(page, title));
- else
- output("PAGE '%S' NOT FOUND", title);
- end;
- end;
- // body tags
- define body tag list-page-tags in wiki
- (page :: <wiki-dsp>, do-body :: <function>)
- ()
- if (*page*)
- // Is it correct to be using the tags from the newest page version?
- // At least this DSP tag should be called show-latest-page-tags ...
- for (tag in *page*.page-tags)
- dynamic-bind(*tag* = tag)
- do-body();
- end;
- end for;
- elseif (get-query-value("tags"))
- output("%s", escape-xml(get-query-value("tags")));
- end if;
- end;
- // This is only used is main.dsp now, and only for news.
- // May want to make a special one for news instead.
- define body tag list-pages in wiki
- (page :: <wiki-dsp>, do-body :: <function>)
- (tags :: false-or(<string>),
- order-by :: false-or(<string>),
- use-query-tags :: <boolean>)
- let tagged = get-query-value("tagged");
- let tags = iff(use-query-tags & instance?(tagged, <string>),
- parse-tags(tagged),
- iff(tags, parse-tags(tags), #[]));
- for (page in find-pages(tags: tags, order-by: creation-date-newer?))
- dynamic-bind(*page* = page)
- do-body();
- end;
- end for;
- end;
- // named methods
- define named-method is-discussion-page? in wiki
- (page :: <wiki-dsp>)
- *page* & discussion-page?(*page*);
- end;
- define named-method latest-page-version? in wiki
- (page :: <wiki-dsp>)
- // TODO: Currently we assume the latest revision of the page is always
- // stored in *pages*.
- *page* & *page* == element(*pages*, *page*.page-title, default: $unfound)
- end;
- define named-method active-page-tags in wiki
- (page :: <wiki-dsp>) => (tags :: <sequence>)
- iff(*page*,
- sort(*page*.page-tags, test: \=),
- #[])
- end;