/dylan/page.dylan
Unknown | 765 lines | 666 code | 99 blank | 0 comment | 0 complexity | cdefc73b2d102f6e4cf2f01fd4a566cd MD5 | raw file
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