/dylan/wiki.dylan
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