/dylan/page.dylan

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;