/dylan/page.dylan

  1Module: %wiki
  2
  3
  4/// Default number of pages to show on the list-pages page.
  5define constant $default-list-size :: <integer> = 25;
  6
  7
  8// Represents a user-editable wiki page revision.  Not to be confused
  9// with <wiki-dsp>, which is a DSP maintained in our source code tree.
 10//
 11define class <wiki-page> (<wiki-object>)
 12
 13  constant slot page-source :: <string>,
 14    required-init-keyword: source:;
 15
 16  // A sequence of <string>s (of RST source) or <wiki-reference>s.
 17  constant slot page-parsed-source :: <sequence>,
 18    init-keyword: parsed-source:;
 19
 20  // Comment entered by the user describing the changes for this revision.
 21  constant slot page-comment :: <string>,
 22    required-init-keyword: comment:;
 23
 24  // The owner has special rights over the page, depending on the ACLs.
 25  // The owner only changes if explicitly changed via the edit-acls page.
 26  // TODO: move this into <acls>.
 27  slot page-owner :: <wiki-user>,
 28    required-init-keyword: owner:;
 29
 30  // The author is the one who saved this particular revision of the page.
 31  constant slot page-author :: <wiki-user>,
 32    required-init-keyword: author:;
 33
 34  slot page-access-controls :: <acls>,
 35    required-init-keyword: access-controls:;
 36
 37  // Tags (strings) entered by the author when the page was saved.
 38  constant slot page-tags :: <sequence> = #(),
 39    init-keyword: tags:;
 40
 41  // e.g. a git commit hash or a revision number
 42  // Filled in by the storage back-end.
 43  slot page-revision :: <string>,
 44    init-keyword: revision:;
 45
 46end class <wiki-page>;
 47
 48
 49/// Provide defaulting and a copy-from argument.
 50define method make
 51    (class == <wiki-page>,
 52     #rest args,
 53     #key copy-from :: false-or(<wiki-page>),
 54     name, source, parsed-source, comment, owner,
 55     author, tags, access-controls, revision)
 56 => (page :: <wiki-page>)
 57  let p = copy-from;
 58  let name = name | (p & p.object-name);
 59  let source = source | (p & p.page-source);
 60  let owner = owner | (p & p.page-owner) | author;
 61  apply(next-method,
 62        class,
 63        name: name,
 64        source: source,
 65        parsed-source: parsed-source
 66                       | (source & parse-wiki-markup(source, name))
 67                       | (p & p.parsed-source),
 68        comment: comment | "",
 69        owner: owner,
 70        author: author | (p & p.page-author) | owner,
 71        tags: tags | (p & p.page-tags) | #(),
 72        access-controls: access-controls
 73                         | (p & p.page-access-controls)
 74                         | $default-access-controls,
 75        args)
 76end method make;
 77
 78
 79// back compat
 80define inline function page-title
 81    (page :: <wiki-page>) => (title :: <string>)
 82  page.object-name
 83end;
 84
 85// back compat
 86/* unused
 87define inline function page-title-setter
 88    (new-name :: <string>, page :: <wiki-page>) => (new-name :: <string>)
 89  page.object-name := new-name
 90end;
 91*/
 92
 93
 94define thread variable *page* :: false-or(<wiki-page>) = #f;
 95
 96define named-method page? in wiki
 97    (page :: <dylan-server-page>)
 98  *page* ~= #f
 99end;
100
101
102//// URLs
103
104define method permanent-link
105    (page :: <wiki-page>)
106 => (url :: <url>)
107  page-permanent-link(page.page-title)
108end;
109
110define method page-permanent-link
111    (title :: <string>)
112 => (url :: <url>)
113  let location = wiki-url("/page/view/%s", title);
114  transform-uris(request-url(current-request()), location, as: <url>)
115end;
116
117define method redirect-to (page :: <wiki-page>)
118  redirect-to(permanent-link(page));
119end;
120
121/// Find a cached page.
122define method find-page
123    (title :: <string>)
124 => (page :: false-or(<wiki-page>))
125  element(*pages*, title, default: #f)
126end;
127
128/* unused
129define method page-exists?
130    (title :: <string>) => (exists? :: <boolean>)
131  find-page(title) & #t
132end;
133*/
134
135// The latest revisions of all pages are loaded at startup for now (to
136// simplify searches and iteration over lists of pages) so this will only
137// load anything if the 'revision' arg is supplied.  Note that 'revision'
138// should never be "head" or any other symbolic revision.
139//
140define method find-or-load-page
141    (title :: <string>, #key revision :: false-or(<string>))
142 => (page :: false-or(<wiki-page>))
143  let page = find-page(title);
144  if (page & (~revision | page.page-revision = revision))
145    page
146  else
147    block ()
148      if (revision)
149        // Don't attempt to cache older revisions of pages.
150        load(*storage*, <wiki-page>, title, revision: revision);
151      else
152        // Load page is slow, do it without the lock held.
153        let loaded-page = load(*storage*, <wiki-page>, title);
154        with-lock ($page-lock)
155          // check again with lock held
156          find-page(title)
157          | (*pages*[title] := loaded-page)
158        end
159      end
160    exception (ex :: <git-storage-error>)
161      #f
162    end
163  end
164end method find-or-load-page;
165
166// The plan is for this to eventually support many more search criteria,
167// such as searching by owner, author, date ranges, etc.
168//
169define method find-pages
170    (#key tags :: <sequence> = #[],
171          order-by :: <function> = title-less?)
172 => (pages :: <sequence>)
173  let pages = sort(with-lock ($page-lock)
174                     value-sequence(*pages*)
175                   end,
176                   test: order-by);
177  if (~empty?(tags))
178    local method page-has-tags? (page :: <wiki-page>)
179            any?(method (tag)
180                   member?(tag, page.page-tags, test: \=)
181                 end,
182                 tags)
183          end;
184    pages := choose(page-has-tags?, pages);
185  end;
186  pages
187end;
188
189define function title-less?
190    (p1 :: <wiki-page>, p2 :: <wiki-page>) => (less? :: <boolean>)
191  as-lowercase(p1.page-title) < as-lowercase(p2.page-title)
192  //case-insensitive-less?(p1.page-title, p2.page-title)
193end;
194
195define function creation-date-newer?
196    (p1 :: <wiki-page>, p2 :: <wiki-page>) => (less? :: <boolean>)
197  p1.creation-date > p2.creation-date
198end;
199
200
201// todo -- Implement this as a wiki page.
202define constant $reserved-tags :: <sequence> = #["news"];
203
204define method reserved-tag?
205    (tag :: <string>) => (reserved? :: <boolean>)
206  member?(tag, $reserved-tags, test: \=)
207end;
208
209define method save-page
210    (title :: <string>, source :: <string>, comment :: <string>, tags :: <sequence>)
211 => (page :: <wiki-page>)
212  let user = authenticated-user();
213  let old-page = find-page(title);
214  let page = make(<wiki-page>,
215                  copy-from: old-page,
216                  name: title,
217                  source: source,
218                  tags: tags,
219                  comment: comment,
220                  author: user);
221  update-reference-tables!(page,
222                           iff(old-page,
223                               outbound-references(old-page),
224                               #()),
225                           outbound-references(page));
226  let action = "create";
227  with-lock ($page-lock)
228    if (key-exists?(*pages*, title))
229      action := "edit";
230    end;
231    *pages*[title] := page;
232  end;
233  page.page-revision := store(*storage*, page, page.page-author, comment,
234                              standard-meta-data(page, action));
235/*
236  TODO: 
237  block ()
238    generate-connections-graph(page);
239  exception (ex :: <serious-condition>)
240    // we don't care about the graph (yet?)
241    // maybe the server doesn't have "dot" installed.
242    log-error("Error generating connections graph for page %s: %s",
243              title, ex);
244  end;
245*/
246  page
247end method save-page;
248
249/* Not converted to new git-backed wiki yet...
250define method generate-connections-graph
251    (page :: <wiki-page>) => ()
252  let graph = make(gvr/<graph>);
253  let node = gvr/create-node(graph, label: page.page-title);
254  let backlinks = find-backlinks(page);
255  backlinks := map(page-title, backlinks);
256  gvr/add-predecessors(node, backlinks);
257  gvr/add-successors(node, last(page.page-versions).references);
258  for (node in gvr/nodes(graph))
259    node.gvr/attributes["URL"] := build-uri(page-permanent-link(node.gvr/label));
260    node.gvr/attributes["color"] := "blue";
261    node.gvr/attributes["style"] := "filled";
262    node.gvr/attributes["fontname"] := "Verdana"; 
263    node.gvr/attributes["shape"] := "note";
264  end for;
265  let temporary-graph = gvr/generate-graph(graph, node, format: "svg");
266  let graph-file = as(<file-locator>, temporary-graph);
267  if (file-exists?(graph-file))
268    let destination = as(<file-locator>,
269                         concatenate("graphs/", page.page-title, ".svg"));
270    rename-file(graph-file, destination, if-exists: #"replace");
271  end if;
272end;
273*/
274
275/* unused
276define method rename-page
277    (page :: <wiki-page>, new-title :: <string>, comment ::<string>)
278 => ()
279  let author = authenticated-user();
280  let old-title = page.page-title;
281  let revision = rename(*storage*, page, new-title, author, comment,
282                        standard-meta-data(page, "rename"));
283  with-lock ($page-lock)
284    remove-key!(*pages*, old-title);
285    *pages*[new-title] := page;
286  end;
287  page.page-title := new-title;
288  page.page-revision := revision;
289end method rename-page;
290*/
291
292define method discussion-page?
293    (page :: <wiki-page>)
294 => (is? :: <boolean>)
295  let (matched?, discussion, title)
296    = regex-search-strings(compile-regex("(Discussion: )(.*)"),
297                           page.page-title);
298  matched? = #t;
299end;
300
301
302
303//// List Versions
304
305define class <page-history-page> (<wiki-dsp>)
306end;
307
308define method respond-to-get
309    (dsp :: <page-history-page>,
310     #key title :: <string>, revision :: false-or(<string>))
311  let title = percent-decode(title);
312  let page = find-or-load-page(title);
313  if (page)
314    dynamic-bind (*page* = page)
315      let pc = page-context();
316      set-attribute(pc, "title", title);
317      local method change-to-table (change)
318              // TODO: a way to define DSP accessors for objects such as
319              //       <wiki-change> so this isn't necessary.
320              make-table(<string-table>,
321                         "author" => change.change-author,
322                         "date" => as-iso8601-string(change.change-date),
323                         "rev" => change.change-revision,
324                         "comment" => change.change-comment)
325            end;
326      set-attribute(pc, "page-changes",
327                    map(change-to-table,
328                        find-changes(*storage*, <wiki-page>,
329                                     name: title, start: revision)));
330      next-method();
331    end;
332  else
333    respond-to-get(*non-existing-page-page*, title: title);
334  end;
335end;
336
337
338
339//// Page references (connections, backlinks)
340
341define class <connections-page> (<wiki-dsp>)
342end;
343
344define method respond-to-get
345    (page :: <connections-page>, #key title :: <string>)
346  let title = percent-decode(title);
347  dynamic-bind (*page* = find-or-load-page(title))
348    if (*page*)
349      next-method();
350    else
351      respond-to-get(*non-existing-page-page*, title: title);
352    end;
353  end;
354end method respond-to-get;
355
356// rename to list-referring-pages
357define body tag list-page-backlinks in wiki
358    (page :: <wiki-dsp>, do-body :: <function>)
359    ()
360  let backlinks = sort(inbound-references(*page*),
361                       test: method (x, y)
362                               as-lowercase(x.object-name) < as-lowercase(y.object-name)
363                             end);
364  if (empty?(backlinks))
365    output("There are no connections to this page.");
366  else
367    let pc = page-context();
368    for (backlink in backlinks)
369      set-attribute(pc, "backlink", backlink.page-title);
370      set-attribute(pc, "backlink-url", as(<string>, permanent-link(backlink)));
371      do-body();
372    end for;
373  end if;
374end;
375
376
377
378//// List Pages
379
380define class <list-pages-page> (<wiki-dsp>) end;
381
382/// GET lists the pages in alphabetical order
383///
384define method respond-to-get
385    (dsp :: <list-pages-page>, #key)
386  let pc = page-context();
387  local method page-info (page :: <wiki-page>)
388          make-table(<string-table>,
389                     "title" => page.page-title,
390                     "when-published" => standard-date-and-time(page.creation-date),
391                     "latest-authors" => page.page-author.user-name)
392        end;
393  let current-page = get-query-value("page", as: <integer>) | 1;
394  let paginator = make(<paginator>,
395                       sequence: map(page-info, find-pages()),
396                       page-size: $default-list-size,
397                       current-page-number: current-page);
398  set-attribute(pc, "wiki-pages", paginator);
399  next-method();
400end method respond-to-get;
401
402/// POST finds a particular page (the 'query') and displays it.
403///
404define method respond-to-post
405    (dsp :: <list-pages-page>, #key)
406  redirect-to(page-permanent-link(get-query-value("query")));
407end;
408
409
410
411//// Remove page
412
413define class <remove-page-page> (<wiki-dsp>)
414end;
415
416define method respond-to-get
417    (dsp :: <remove-page-page>, #key title :: <string>)
418  dynamic-bind (*page* = find-or-load-page(title))
419    process-template(dsp);
420  end;
421end;
422
423define method respond-to-post
424    (dsp :: <remove-page-page>, #key title :: <string>)
425  let page = find-or-load-page(percent-decode(title));
426  if (page)
427    delete(*storage*, page, authenticated-user(),
428           get-query-value("comment") | "",
429           standard-meta-data(page, "delete"));
430    with-lock ($page-lock)
431      remove-key!(*pages*, title);
432    end;
433    add-page-note("Page %= has been deleted.", title);
434    redirect-to(wiki-url("/") /* generate-url("wiki.home") */);
435  else
436    respond-to-get(*non-existing-page-page*, title: title);
437  end;
438end;
439
440
441//// View Page
442
443// Provide backward compatibility with old wiki URLs
444// /wiki/view.dsp?title=t&version=v
445// 
446define method show-page-back-compatible
447    (#key)
448  with-query-values (title, version)
449    let title = percent-decode(title);
450    let version = version & percent-decode(version);
451    let default = current-request().request-absolute-url;
452    let url = make(<url>,
453                   scheme: default.uri-scheme,
454                   host: default.uri-host,
455                   port: default.uri-port,
456                   // No, I don't understand the empty string either.
457                   path: concatenate(list("", "pages", title),
458                                     iff(version,
459                                         list("versions", version),
460                                         #())));
461    let location = as(<string>, url);
462    moved-permanently-redirect(location: location,
463                               header-name: "Location",
464                               header-value: location);
465  end;
466end;
467
468define class <view-page-page> (<wiki-dsp>)
469end;
470
471define method respond-to-get
472    (dsp :: <view-page-page>,
473     #key title :: <string>, version :: false-or(<string>))
474  let title = percent-decode(title);
475  dynamic-bind (*page* = find-or-load-page(title, revision: version))
476    if (*page*)
477      process-template(dsp);
478    elseif (authenticated-user())
479      // Give the user a change to create the page.
480      respond-to-get(*edit-page-page*, title: title);
481    else
482      respond-to-get(*non-existing-page-page*, title: title);
483    end;
484  end;
485end method respond-to-get;
486
487define tag render-page in wiki
488    (page :: <wiki-dsp>)
489    ()
490  output("%s", as-html(*page*, *page*.page-title))
491end;
492
493
494
495//// Edit Page
496
497define class <edit-page-page> (<wiki-dsp>)
498end;
499
500define method respond-to-get
501    (page :: <edit-page-page>, #key title :: <string>)
502  let title = percent-decode(title);
503  let pc = page-context();
504  if (authenticated-user())
505    set-attribute(pc, "title", title);
506    set-attribute(pc, "previewing?", #f);
507    dynamic-bind (*page* = find-or-load-page(title))
508      set-attribute(pc, "original-title", title);
509      if (*page*)
510        // TODO: change this to "source"
511        set-attribute(pc, "content", *page*.page-source);
512        set-attribute(pc, "owner", *page*.page-owner);
513        set-attribute(pc, "tags", unparse-tags(*page*.page-tags));
514      end;
515      next-method();
516    end;
517  else
518    // This shouldn't happen unless the user typed in the /edit url,
519    // since the edit option shouldn't be available unless logged in.
520    add-page-error("You must be logged in to edit wiki pages.");
521    respond-to-get(*view-page-page*, title: title);
522  end;
523end method respond-to-get;
524
525// Note that when the title is changed and the page is being previewed
526// we have to keep track of the old title.  The POST is always to the
527// existing title, and when it's not a preview, the rename is done.
528//
529define method respond-to-post
530    (wiki-dsp :: <edit-page-page>, #key title :: <string>)
531  let title = percent-decode(title);
532  let page = find-or-load-page(title);
533  with-query-values (content, comment, tags, button)
534    let source = content | "";
535    let tags = iff(tags, parse-tags(tags), #[]);
536    let previewing? = (button = "Preview");
537    let author = authenticated-user();
538    if (page & ~has-permission?(author, page, $modify-content))
539      add-page-error("You do not have permission to edit this page.");
540    end;
541
542    let reserved-tags = choose(reserved-tag?, tags);
543    if (~empty?(reserved-tags) & ~administrator?(author))
544      add-field-error("tags", "The tag%s %s %s reserved for administrator use.",
545                      iff(reserved-tags.size = 1, "", "s"),
546                      join(tags, ", ", conjunction: " and "),
547                      iff(reserved-tags.size = 1, "is", "are"));
548    end;
549
550    if (previewing? | page-has-errors?())
551      dynamic-bind (*page* = make(<wiki-page>,
552                                  copy-from: page,
553                                  name: title,
554                                  source: source,
555                                  comment: comment,
556                                  author: author))
557        let pc = page-context();
558        set-attribute(pc, "previewing?", #t);
559        set-attribute(pc, "title", title);
560        set-attribute(pc, "preview", as-html(source, title));
561        process-template(wiki-dsp);
562      end;
563    else
564      let page = save-page(title, source, comment, tags);
565      redirect-to(page);
566    end;
567  end;
568end method respond-to-post;
569
570
571
572//// View Diff
573
574define class <view-diff-page> (<wiki-dsp>)
575end;
576
577// /page/diff/Title/n -- Show the diff for revision n.
578//
579define method respond-to-get
580    (dsp :: <view-diff-page>,
581     #key title :: <string>,
582          revision :: false-or(<string>))
583  let title = percent-decode(title);
584  let changes = find-changes(*storage*, <wiki-page>,
585                             start: revision, name: title, count: 1, diff?: #t);
586  if (empty?(changes))
587    add-page-error("No diff for page %= found.", title);
588    redirect-to(find-page(title) | *non-existing-page-page*);
589  else
590    let change :: <wiki-change> = changes[0];
591    let pc = page-context();
592    set-attribute(pc, "name", change.change-object-name);
593    set-attribute(pc, "diff", change.change-diff);
594    set-attribute(pc, "author", change.change-author);
595    set-attribute(pc, "comment", change.change-comment);
596    set-attribute(pc, "date", as-iso8601-string(change.change-date));
597    process-template(dsp);
598  end;
599end method respond-to-get;
600
601
602define method print-diff-entry
603    (entry :: <insert-entry>, seq1 :: <sequence>, seq2 :: <sequence>)
604  let lineno1 = entry.source-index + 1;
605  let lineno2 = entry.element-count + entry.source-index;
606  if (lineno1 = lineno2)
607    output("Added line %d:<br/>", lineno1);
608  else
609    output("Added lines %d - %d:<br/>", lineno1, lineno2);
610  end;
611  for (line in copy-sequence(seq2, start: lineno1 - 1, end: lineno2),
612       lineno from lineno1)
613    output("%d: %s<br/>", lineno, line);
614  end;
615end method print-diff-entry;
616
617  
618define method print-diff-entry
619    (entry :: <delete-entry>, seq1 :: <sequence>, seq2 :: <sequence>)
620  let lineno1 = entry.dest-index + 1;
621  let lineno2 = entry.element-count + entry.dest-index;
622  if (lineno1 = lineno2)
623    output("Removed line %d:<br/>", lineno1);
624  else
625    output("Removed lines %d - %d:<br/>", lineno1, lineno2);
626  end;
627  for (line in copy-sequence(seq1, start: lineno1 - 1, end: lineno2),
628       lineno from lineno1)
629    output("%d: %s<br/>", lineno, line);
630  end;
631end method print-diff-entry;
632
633define tag show-diff-entry in wiki
634    (page :: <view-diff-page>)
635    (name :: <string>)
636  let pc = page-context();
637  let entry = get-attribute(pc, name);
638  let seq1 = get-attribute(pc, "seq1");
639  let seq2 = get-attribute(pc, "seq2");
640  print-diff-entry(entry, seq1, seq2);
641end tag show-diff-entry;
642
643
644
645//// Tags
646
647define tag show-page-permanent-link in wiki
648    (page :: <wiki-dsp>)
649    ()
650  if (*page*)
651    output("%s", permanent-link(*page*))
652  end;
653end;
654
655// Show the title of the main page corresponding to a discussion page.
656define tag show-main-page-title in wiki
657    (page :: <wiki-dsp>) ()
658  if (*page*)
659    let main-title = regex-replace(*page*.page-title, compile-regex("^Discussion: "), "");
660    output("%s", escape-xml(main-title));
661  end;
662end tag show-main-page-title;
663
664// Show the title of the discussion page corresponding to a main page.
665define tag show-discussion-page-title in wiki
666    (page :: <wiki-dsp>) ()
667  if (*page*)
668    let discuss-title = concatenate("Discussion: ", *page*.page-title);
669    output("%s", escape-xml(discuss-title));
670  end;
671end tag show-discussion-page-title;
672
673define tag show-page-title in wiki
674    (page :: <wiki-dsp>)
675    ()
676  if (*page*)
677    output("%s", escape-xml(*page*.page-title));
678  end;
679end;
680
681define tag show-page-owner in wiki
682    (page :: <wiki-dsp>)
683    ()
684  if (*page*)
685    output("%s", escape-xml(*page*.page-owner.user-name))
686  end;
687end;
688
689define tag show-version in wiki
690    (page :: <wiki-dsp>)
691    ()
692  output("%s", *page*.page-revision);
693end;
694
695define tag include-page in wiki
696    (dsp :: <wiki-dsp>)
697    (title :: <string>)
698  let page = find-or-load-page(title);
699  if (page)
700    output("%s", as-html(page, title));
701  else
702    output("PAGE '%S' NOT FOUND", title);
703  end;
704end;
705
706
707// body tags 
708
709define body tag list-page-tags in wiki
710    (page :: <wiki-dsp>, do-body :: <function>)
711    ()
712  if (*page*)
713    // Is it correct to be using the tags from the newest page version?
714    // At least this DSP tag should be called show-latest-page-tags ...
715    for (tag in *page*.page-tags)
716      dynamic-bind(*tag* = tag)
717        do-body();
718      end;
719    end for;
720  elseif (get-query-value("tags"))
721    output("%s", escape-xml(get-query-value("tags")));
722  end if;
723end;
724
725// This is only used is main.dsp now, and only for news.
726// May want to make a special one for news instead.
727define body tag list-pages in wiki
728    (page :: <wiki-dsp>, do-body :: <function>)
729    (tags :: false-or(<string>),
730     order-by :: false-or(<string>),
731     use-query-tags :: <boolean>)
732  let tagged = get-query-value("tagged");
733  let tags = iff(use-query-tags & instance?(tagged, <string>),
734                 parse-tags(tagged),
735                 iff(tags, parse-tags(tags), #[]));
736  for (page in find-pages(tags: tags, order-by: creation-date-newer?))
737    dynamic-bind(*page* = page)
738      do-body();
739    end;
740  end for;
741end;
742
743
744// named methods
745
746define named-method is-discussion-page? in wiki
747    (page :: <wiki-dsp>)
748  *page* & discussion-page?(*page*);
749end;
750
751define named-method latest-page-version? in wiki
752    (page :: <wiki-dsp>)
753  // TODO: Currently we assume the latest revision of the page is always
754  //       stored in *pages*.
755  *page* & *page* == element(*pages*, *page*.page-title, default: $unfound)
756end;
757
758define named-method active-page-tags in wiki
759    (page :: <wiki-dsp>) => (tags :: <sequence>)
760  iff(*page*,
761      sort(*page*.page-tags, test: \=),
762      #[])
763end;
764
765