PageRenderTime 20ms CodeModel.GetById 9ms app.highlight 6ms RepoModel.GetById 1ms app.codeStats 1ms

/dylan/wiki.dylan

http://github.com/cgay/wiki
Unknown | 600 lines | 479 code | 121 blank | 0 comment | 0 complexity | a44dd700579d81c64d41c9c2d56577a5 MD5 | raw file
  1Module: %wiki
  2Synopsis: Utilities, globals, protocols, base classes, ...
  3          Basically anything that needs to be defined first.
  4
  5
  6define taglib wiki () end;
  7
  8// Represents a DSP maintained in our source code tree. Not to be confused
  9// with <wiki-page>, which is a user-editable wiki page.
 10//
 11define class <wiki-dsp> (<dylan-server-page>)
 12end;
 13
 14// These are both set to something else when the config file is loaded.
 15define variable *static-directory* :: <directory-locator> = working-directory();
 16define variable *template-directory* :: <directory-locator> = working-directory();
 17
 18
 19define method make
 20    (class :: subclass(<wiki-dsp>), #rest args, #key source :: <pathname>)
 21 => (page :: <wiki-dsp>)
 22  apply(next-method, class,
 23        source: merge-locators(as(<file-locator>, source),
 24                               *template-directory*),
 25        args)
 26end;
 27
 28// The following will all be set after *template-directory* is set.
 29
 30define variable *edit-page-page* = #f;
 31define variable *view-page-page* = #f;
 32define variable *remove-page-page* = #f;
 33define variable *page-history-page* = #f;
 34define variable *connections-page* = #f;
 35define variable *view-diff-page* = #f;
 36define variable *search-page* = #f;
 37define variable *non-existing-page-page* = #f;
 38
 39define variable *view-user-page* = #f;
 40define variable *list-users-page* = #f;
 41define variable *edit-user-page* = #f;
 42define variable *deactivate-user-page* = #f;
 43define variable *non-existing-user-page* = #f;
 44
 45define variable *list-groups-page* = #f;
 46define variable *non-existing-group-page* = #f;
 47define variable *view-group-page* = #f;
 48define variable *edit-group-page* = #f;
 49define variable *remove-group-page* = #f;
 50define variable *edit-group-members-page* = #f;
 51
 52define variable *registration-page* = #f;
 53define variable *edit-access-page* = #f;
 54
 55
 56
 57//// Wiki object caches
 58
 59
 60// TODO: why's this not in table-extensions?
 61define class <case-insensitive-string-table> (<table>)
 62end;
 63
 64define sealed method table-protocol
 65    (table :: <case-insensitive-string-table>)
 66 => (test :: <function>, hash :: <function>)
 67  values(case-insensitive-equal, case-insensitive-string-hash)
 68end;
 69
 70
 71/// All objects stored in the wiki (pages, users, groups) must subclass this.
 72///
 73define class <wiki-object> (<object>)
 74  constant slot creation-date :: <date> = current-date(),
 75    init-keyword: creation-date:;
 76
 77  // TODO:
 78  //constant slot modification-date :: <date> = <same as creation-date>;
 79
 80  slot object-name :: <string>,
 81    required-init-keyword: name:;
 82end;
 83
 84
 85// If you need to hold more than one of these locks, acquire them in
 86// this order: $group-lock, $user-lock, $page-lock.
 87
 88/// Maps user name to newest revision of <wiki-user>.
 89define variable *users* :: <case-insensitive-string-table>
 90  = make(<case-insensitive-string-table>);
 91
 92/// Hold this when modifying *users*.
 93define constant $user-lock :: <lock> = make(<lock>);
 94
 95
 96/// Maps group name to newest revision of <wiki-group>.
 97define variable *groups* :: <case-insensitive-string-table>
 98  = make(<case-insensitive-string-table>);
 99
100/// Hold this when modifying *groups*.
101define constant $group-lock :: <lock> = make(<lock>);
102
103
104/// Maps page titles to newest revision of <wiki-page>.
105define variable *pages* :: <case-insensitive-string-table>
106  = make(<case-insensitive-string-table>);
107
108/// Hold this when modifying *pages*.
109define constant $page-lock :: <lock> = make(<lock>);
110
111
112
113//// General-use DSP tags
114
115// Prefix for all wiki URLs.  Set to "" for no prefix.
116// Note that some templates still hard-code this value,
117// until URL generation works.
118define variable *wiki-url-prefix* :: <string> = "/wiki";
119
120// This shouldn't be needed once generate-url is working.
121define tag base in wiki
122    (page :: <wiki-dsp>) ()
123  output("%s", *wiki-url-prefix*);
124end;
125
126define tag base-url in wiki
127    (page :: <wiki-dsp>)
128    ()
129  let url = current-request().request-absolute-url; // this may make a new url
130  output("%s", build-uri(make(<url>,
131                              scheme: url.uri-scheme,
132                              host: url.uri-host,
133                              port: url.uri-port)));
134end;
135
136// Mostly for use in setting the "redirect" parameter in templates.
137define tag current in wiki
138    (page :: <wiki-dsp>) ()
139  output("%s", build-uri(request-url(current-request())));
140end;
141
142define function wiki-url
143    (format-string, #rest format-args)
144 => (url :: <url>)
145  parse-url(concatenate(*wiki-url-prefix*,
146                        apply(format-to-string, format-string, format-args)))
147end;  
148
149define constant $past-tense-table
150  = make-table(<string-table>,
151               "activate" => "activated",
152               "create"   => "created",
153               "edit"     => "edited",
154               "remove"   => "removed",
155               "rename"   => "renamed",
156               "add-members"    => "group member added",
157               "remove-members" => "group member removed",
158
159               // I don't think these two are currently used.  --cgay Apr 2011
160               "add-group-owner"    => "added owner",
161               "remove-group-owner" => "removed owner");
162
163define generic permanent-link (obj :: <object>) => (url :: <url>);
164
165
166
167//// Storage protocol
168
169/// Any back-end storage mechanism must be a subclass of this and support
170/// the generics that specialize on it.
171define class <storage> (<object>)
172end;
173
174/// This is initialized when the config file is loaded.
175define variable *storage* :: false-or(<storage>) = #f;
176
177
178/// Initialize storage upon startup
179define generic initialize-storage-for-reads
180    (storage :: <storage>) => ();
181
182define generic initialize-storage-for-writes
183    (storage :: <storage>, admin-user :: <wiki-user>) => ();
184
185
186define generic load
187    (storage :: <storage>, class :: subclass(<wiki-object>), name :: <string>,
188     #key)
189 => (obj :: <wiki-object>);
190
191define generic load-all
192    (storage :: <storage>, class :: subclass(<wiki-object>))
193 => (objects :: <sequence>);
194
195define generic find-or-load-pages-with-tags
196    (storage :: <storage>, tags :: <sequence>) => (pages :: <sequence>);
197
198// If 'type' ~= <wiki-object>, the 'name' keyword argument is supported.
199// If 'type' == <wiki-page>, the 'diff?' keyword argument is supported.
200define generic find-changes
201    (storage :: <storage>, type :: subclass(<wiki-object>), #key start, count, #all-keys)
202 => (changes :: <sequence>);
203
204define generic store
205    (storage :: <storage>, obj :: <wiki-object>, author :: <wiki-user>,
206     comment :: <string>, meta-data :: <string-table>)
207 => (revision :: <string>);
208
209define generic delete
210    (storage :: <storage>, obj :: <wiki-object>, author :: <wiki-user>,
211     comment :: <string>, meta-data :: <string-table>)
212 => ();
213
214define generic rename
215    (storage :: <storage>, obj :: <wiki-object>, new-name :: <string>,
216     author :: <wiki-user>, comment :: <string>, meta-data :: <string-table>)
217 => (revision :: <string>);
218
219/// This is what the above methods should signal if they can't fullfill
220/// their contract.
221define class <storage-error> (<format-string-condition>, <serious-condition>)
222end;
223
224
225
226//// Changes
227
228define class <wiki-change> (<object>)
229  constant slot change-revision    :: <string>, required-init-keyword: revision:;
230  constant slot change-author      :: <string>, required-init-keyword: author:;
231  constant slot change-date        :: <date>,   required-init-keyword: date:;
232  constant slot change-comment     :: <string>, required-init-keyword: comment:;
233  constant slot change-diff        :: <string> = "", init-keyword: diff:;
234
235  // Keys that always exist: "name", "type", "action".
236  // TODO: Be resilient to by-hand edits, in which case these items may not have
237  //       been stored in the Notes for the commit.  This info could be recovered
238  //       by grovelling over the output of "git whatchanged".
239  constant slot change-meta-data   :: <string-table>, required-init-keyword: meta-data:;
240end;
241
242define function change-object-name
243    (change :: <wiki-change>) => (name :: <string>)
244  change.change-meta-data["name"]
245end;
246
247define function change-type-name
248    (change :: <wiki-change>) => (name :: <string>)
249  change.change-meta-data["type"]
250end;
251
252/* unused
253define function change-object-type
254    (change :: <wiki-change>) => (type :: subclass(<wiki-object>))
255  select (change.change-type-name by \=)
256    "page" => <wiki-page>;
257    "user" => <wiki-user>;
258    "group" => <wiki-group>;
259  end
260end;
261*/
262
263define function change-action
264    (change :: <wiki-change>) => (action :: <string>)
265  element(change.change-meta-data, "action", default: "change")
266end;
267
268define function standard-meta-data
269    (object :: <wiki-object>, action :: <string>)
270 => (meta-data :: <string-table>)
271  let meta-data = make(<string-table>);
272  meta-data["action"] := action;
273  meta-data["name"] := select (object.object-class)
274                         <wiki-page> => object.page-title;
275                         <wiki-user> => object.user-name;
276                         <wiki-group> => object.group-name;
277                       end;
278  meta-data["type"] := select (object.object-class)
279                         <wiki-page> => "page";
280                         <wiki-user> => "user";
281                         <wiki-group> => "group";
282                       end;
283  meta-data
284end;
285
286define method permanent-link
287    (change :: <wiki-change>) => (url :: <url>)
288  // Yet another place that needs to be fixed by using generate-url.
289  let location = wiki-url("/%s/view/%s/%s",
290                          change.change-type-name,
291                          change.change-object-name,
292                          change.change-revision);
293  transform-uris(request-url(current-request()), location, as: <url>)
294end;
295
296
297
298//// Recent Changes page
299
300define class <recent-changes-page> (<wiki-dsp>)
301end;
302
303define method respond-to-get
304    (page :: <recent-changes-page>, #key)
305  let changes = sort(find-recent-changes(),
306                     test: method (change1, change2)
307                             change1.change-date > change2.change-date   
308                           end);
309  let page-number = get-query-value("page", as: <integer>) | 1;
310  let paginator = make(<paginator>,
311                       sequence: changes,
312                       current-page-number: page-number);
313  set-attribute(page-context(), "recent-changes", paginator);
314  next-method();
315end;
316
317/// Synopsis: Find changes for wiki objects of type 'for-type'.
318///
319/// Arguments:
320///   for-type  - Should be <wiki-page>, <wiki-user>, or <wiki-group>
321///               or <wiki-object> (the default).  <wiki-object> will
322///               find changes for any object.
323///   start     - A revision number at which to start searching (backward)
324///               for changes.  With the git back-end this is a hash.
325///               The default (#f) means to start with the most recent change.
326///   name      - Only find changes for objects matching this name exactly.
327///               For pages this matches the title.  The default (#f) matches
328///               anything.
329/// Values:
330///   changes - a sequence of <wiki-change> objects representing object
331///             creations, edits, deletions, or renames.
332///
333define method find-recent-changes
334    (#key for-type :: subclass(<wiki-object>) = <wiki-object>,
335          start :: false-or(<string>),
336          name :: false-or(<string>))
337 => (changes :: <sequence>)
338  find-changes(*storage*, for-type, start: start, name: name, count: 300)
339end;
340
341define body tag list-recent-changes in wiki
342    (page :: <wiki-dsp>, do-body :: <function>)
343    ()
344  let pc = page-context();
345  let previous-change = #f;
346  let paginator :: <paginator> = get-attribute(pc, "recent-changes");
347  for (change :: <wiki-change> in paginator)
348    set-attribute(pc, "day", standard-date(change.change-date));
349    set-attribute(pc, "previous-day",
350                  previous-change & standard-date(previous-change.change-date));
351    set-attribute(pc, "time", standard-time(change.change-date));
352    set-attribute(pc, "revision-url", as(<string>, permanent-link(change)));
353    set-attribute(pc, "newest-url", as(<string>, permanent-link(change)));
354    set-attribute(pc, "diff-url",
355                  as(<string>, wiki-url("/page/diff/%s/%s",
356                                        change.change-object-name,
357                                        change.change-revision)));
358    set-attribute(pc, "object-type", change.change-type-name);
359    set-attribute(pc, "title", change.change-object-name);
360    set-attribute(pc, "action", as(<string>, change.change-action));
361    set-attribute(pc, "comment", change.change-comment);
362    set-attribute(pc, "version", change.change-revision);
363    set-attribute(pc, "verb", 
364                  element($past-tense-table, change.change-action, default: #f)
365                  | change.change-action);
366    set-attribute(pc, "author", change.change-author);
367    do-body();
368    previous-change := change;
369  end;
370end tag list-recent-changes;
371
372
373
374// TODO: replace all these date-related tags with one tag like
375//       <wiki:date object="page|group|user" format="..." />
376
377// Standard date format.  The plan is to make this customizable per user
378// and to use the user's timezone.  For now just ISO 8601...
379//
380define method standard-date-and-time
381    (date :: <date>) => (date-and-time :: <string>)
382  as-iso8601-string(date)
383end;
384
385define method standard-date
386    (date :: <date>) => (date :: <string>)
387  format-date("%Y.%m.%d", date)
388end;
389
390define method standard-time
391    (date :: <date>) => (time :: <string>)
392  format-date("%H:%M", date)
393end;
394
395define tag show-version-published in wiki
396    (page :: <wiki-dsp>)
397    (formatted :: <string>)
398  output("%s", format-date(formatted, *page*.creation-date));
399end;
400
401define tag show-page-published in wiki
402    (page :: <wiki-dsp>)
403    (formatted :: <string>)
404  if (*page*)
405    output("%s", format-date(formatted, *page*.creation-date));
406  end if;
407end;
408
409define tag page-creation-date in wiki
410    (page :: <wiki-dsp>)
411    ()
412  output("%s", as-iso8601-string(*page*.creation-date));
413end; 
414
415// Rename to show-comment
416define tag show-version-comment in wiki
417    (page :: <wiki-dsp>)
418    ()
419  output("%s", *page*.page-comment);
420end;
421
422
423define variable *not-logged-in-page* = #f;
424
425
426
427//// References (to other wiki objects)
428
429
430/// A wiki reference is a pointer to another wiki object.
431define class <wiki-reference> (<object>)
432
433  /// This holds the name of the page, user, or group.
434  constant slot reference-name :: <string>,
435    required-init-keyword: name:;
436
437  // The text to display for this reference.  Often the same as the name.
438  constant slot reference-text :: <string>,
439    required-init-keyword: text:;
440
441end class <wiki-reference>;
442
443
444/// Map from page name to a sequence of <wiki-object>s that refer to it.
445/// The keys here may be for non-existant objects.  e.g. pages that
446/// haven't yet been created, or that have been deleted.
447define constant $page-reference-map :: <case-insensitive-string-table>
448  = make(<case-insensitive-string-table>);
449
450/// Map from user name to a sequence of <wiki-object>s that refer to it.
451/// The keys here may be for non-existant objects.  e.g. users that
452/// haven't yet been created, or that have been deleted.
453define constant $user-reference-map :: <case-insensitive-string-table>
454  = make(<case-insensitive-string-table>);
455
456/// Map from group name to a sequence of <wiki-object>s that refer to it.
457/// The keys here may be for non-existant objects.  e.g. groups that
458/// haven't yet been created, or that have been deleted.
459define constant $group-reference-map :: <case-insensitive-string-table>
460  = make(<case-insensitive-string-table>);
461
462
463define generic as-rst
464    (x :: <object>) => (rst :: <string>);
465
466define generic resolve-reference
467    (ref :: <wiki-reference>) => (object :: false-or(<wiki-object>));
468
469       
470define class <page-reference> (<wiki-reference>) end;
471define class <user-reference> (<wiki-reference>) end;
472define class <group-reference> (<wiki-reference>) end;
473
474
475define method as-rst
476    (rst-markup :: <string>) => (rst :: <string>)
477  rst-markup
478end;
479
480define method as-rst
481    (ref :: <page-reference>) => (rst :: <string>)
482  format-to-string("`%s %s<%s/page/view/%s>`_",
483                   ref.reference-text,
484                   iff(ref.resolve-reference, "", "(?) "),
485                   *wiki-url-prefix*,
486                   percent-encode($uri-pchar, ref.reference-name))
487end;
488
489define method as-rst
490    (ref :: <user-reference>) => (rst :: <string>)
491  format-to-string("`%s %s<%s/user/view/%s>`_",
492                   ref.reference-text,
493                   iff(ref.resolve-reference, "", "(?) "),
494                   *wiki-url-prefix*,
495                   percent-encode($uri-pchar, ref.reference-name))
496end;
497
498define method as-rst
499    (ref :: <group-reference>) => (rst :: <string>)
500  format-to-string("`%s %s<%s/group/view/%s>`_",
501                   ref.reference-text,
502                   iff(ref.resolve-reference, "", "(?) "),
503                   *wiki-url-prefix*,
504                   percent-encode($uri-pchar, ref.reference-name))
505end;
506
507
508define method resolve-reference
509    (ref :: <page-reference>) => (page :: false-or(<wiki-page>))
510  find-page(ref.reference-name)
511end;
512
513define method resolve-reference
514    (ref :: <user-reference>) => (user :: false-or(<wiki-user>))
515  find-user(ref.reference-name)
516end;
517
518define method resolve-reference
519    (ref :: <group-reference>) => (group :: false-or(<wiki-group>))
520  find-group(ref.reference-name)
521end;
522
523
524define constant $reference-map-lock :: <lock> = make(<lock>);
525
526/// Update reference tables to reflect changes when an object is created,
527/// modified, or deleted.
528/// Arguments:
529///   source - The source of the references.
530///   old-refs - Sequence of <wiki-reference> from before the object was changed.
531///   new-refs - Sequence of <wiki-reference> from after the object was changed.
532define function update-reference-tables!
533    (source :: <wiki-object>, old-refs :: <sequence>, new-refs :: <sequence>)
534 => ()
535  local method same? (object1 :: <wiki-object>, object2 :: <wiki-object>)
536          case-insensitive-equal(object1.object-name, object2.object-name)
537        end;
538  let table = select (source by instance?)
539                <wiki-page> => $page-reference-map;
540                <wiki-user> => $user-reference-map;
541                <wiki-group> => $group-reference-map;
542              end;
543  with-lock ($reference-map-lock)
544    for (ref in old-refs)
545      let target-name = ref.reference-name;
546      let refs = element(table, target-name, default: #f);
547      if (refs)
548        table[target-name] := remove!(refs, source, test: same?);
549      end;
550    end;
551    for (ref in new-refs)
552      let target-name = ref.reference-name;
553      let refs = element(table, target-name, default: #());
554      table[target-name] := add!(refs, source);
555    end;
556  end;
557end function update-reference-tables!;
558
559
560/// Find references to the given wiki object.  Currently this cannot handle
561/// references to specific revisions of objects; all references are assumed
562/// to be to the latest revision.
563/// Arguments:
564///     target - The object being referred to.
565/// Values:
566///     wiki-objects - A sequence of <wiki-objects>s.
567define generic inbound-references
568    (target :: <wiki-object>) => (wiki-objects :: <sequence>);
569
570define method inbound-references
571    (target :: <wiki-page>) => (wiki-objects :: <sequence>)
572  element($page-reference-map, target.object-name, default: #())
573end;
574
575define method inbound-references
576    (target :: <wiki-user>) => (wiki-objects :: <sequence>)
577  element($user-reference-map, target.object-name, default: #())
578end;
579
580define method inbound-references
581    (target :: <wiki-group>) => (wiki-objects :: <sequence>)
582  element($group-reference-map, target.object-name, default: #())
583end;
584
585
586/// Return a sequence of <wiki-object>s that are referred to by 'source'.
587define generic outbound-references
588    (source :: <wiki-object>) => (refs :: <sequence>);
589
590define method outbound-references
591    (source :: <wiki-object>) => (refs :: <sequence>)
592  #()  // nothing yet
593end;
594
595define method outbound-references
596    (page :: <wiki-page>) => (refs :: <sequence>)
597  choose(rcurry(instance?, <wiki-reference>),
598         page.page-parsed-source)
599end method outbound-references;
600