[Gd-chatter] r10754 - in trunk/libraries: koala/sources/examples/wiki koala/www/wiki web-framework
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Mon May 29 01:07:41 CEST 2006
Author: hannes
Date: Mon May 29 01:07:38 2006
New Revision: 10754
Added:
trunk/libraries/koala/sources/examples/wiki/classes.dylan (contents, props changed)
trunk/libraries/koala/www/wiki/backlink.dsp (contents, props changed)
trunk/libraries/koala/www/wiki/diff.dsp (contents, props changed)
trunk/libraries/koala/www/wiki/index.dsp (contents, props changed)
Modified:
trunk/libraries/koala/sources/examples/wiki/library.dylan
trunk/libraries/koala/sources/examples/wiki/parser.dylan
trunk/libraries/koala/sources/examples/wiki/wiki.dylan
trunk/libraries/koala/sources/examples/wiki/wiki.lid
trunk/libraries/koala/www/wiki/edit.dsp
trunk/libraries/koala/www/wiki/footer.dsp
trunk/libraries/koala/www/wiki/header.dsp
trunk/libraries/koala/www/wiki/recent.dsp
trunk/libraries/web-framework/library.dylan
trunk/libraries/web-framework/storage.dylan
trunk/libraries/web-framework/users.dylan
Log:
Bug: 7219
*some improvements for the wiki
Added: trunk/libraries/koala/sources/examples/wiki/classes.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/koala/sources/examples/wiki/classes.dylan Mon May 29 01:07:38 2006
@@ -0,0 +1,89 @@
+module: wiki
+
+
+define web-class <wiki-page-diff> (<object>)
+ data content :: <string>;
+ data author :: <string> = if (current-user()) current-user().username else "foobar" end; //XXX: use IP here
+ data page-version :: <integer>;
+ data timestamp :: <date> = current-date();
+ data comment :: <string>;
+ has-a wiki-page-content;
+end;
+
+define web-class <wiki-page-content> (<reference-object>)
+ data page-title :: <string>;
+ has-many revision :: <wiki-page-diff>;
+end;
+
+define inline-only method key (page :: <wiki-page-content>) => (res :: <string>);
+ page.page-title;
+end;
+
+define method latest-text (page :: <wiki-page-content>) => (text :: <string>)
+ page.revisions.last.content
+end;
+
+define method find-page (title)
+ element(*pages*, title, default: #f);
+end;
+
+define method find-backlinks (title)
+ let res = make(<stretchy-vector>);
+ for (page in sort(key-sequence(*pages*)))
+ if (subsequence-position(latest-text(*pages*[page]), concatenate("[[", title, "]]")))
+ add!(res, *pages*[page])
+ end;
+ end;
+ res;
+end;
+
+define method remove-page (title)
+ remove-key!(*pages*, title);
+end;
+
+define method rename-page (old-title, new-title)
+ let page = find-page(old-title);
+ *pages*[new-title] := page;
+ //XXX write a changelog entry
+ remove-page(old-title);
+end;
+
+//undo last change
+define method undo (title)
+ let page = find-page(title);
+ if (page)
+ let previous-version = page.revisions[page.revisions.size - 2];
+ save-page(title, previous-version, comment: "revert to previous version");
+ end;
+end;
+
+define method save-page (title, content, #key comment = "")
+ let page = find-page(title);
+ unless (page)
+ page := make(<wiki-page-content>, page-title: title);
+ *pages*[title] := page;
+ end;
+ let version = size(page.revisions) + 1;
+ unless (version > 1 & content = page.latest-text)
+ let revision = make(<wiki-page-diff>,
+ content: content,
+ page-version: version,
+ wiki-page-content: page,
+ comment: comment);
+ add!(page.revisions, revision);
+ save(revision);
+ end;
+end;
+
+define responder worker-responder ("/worker")
+ (request, response)
+ if (user-logged-in?(request) & current-user().access <= 23)
+ let action = as(<symbol>, get-query-value("action"));
+ select (action)
+ #"undo" => undo(get-query-value("title"));
+ #"rename" => rename-page(get-query-value("oldtitle"), get-query-value("title"));
+ #"remove" => remove-page(get-query-value("title"))
+ end;
+ end;
+end;
+
Modified: trunk/libraries/koala/sources/examples/wiki/library.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/wiki/library.dylan (original)
+++ trunk/libraries/koala/sources/examples/wiki/library.dylan Mon May 29 01:07:38 2006
@@ -8,13 +8,16 @@
use io,
import: { streams, format };
use system,
- import: { file-system, locators };
+ import: { file-system, locators, date };
use koala,
import: { dsp };
use dylan-basics;
use regular-expressions;
use xml-rpc-common;
use strings;
+ use web-framework;
+ use xml-parser;
+ use collection-extensions, import: { sequence-diff };
//use meta;
export wiki;
end;
@@ -28,6 +31,7 @@
use file-system;
use threads;
use dylan-basics;
+ use date;
//use meta;
use dsp;
use regular-expressions,
@@ -35,6 +39,11 @@
use xml-rpc-common,
import: { base64-encode, base64-decode };
use strings, import: { index-of, case-insensitive-equal? };
+ use web-framework, exclude: { respond-to-get, respond-to-post };
+ use users;
+ use storage;
+ use simple-xml;
+ use sequence-diff;
end;
Modified: trunk/libraries/koala/sources/examples/wiki/parser.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/wiki/parser.dylan (original)
+++ trunk/libraries/koala/sources/examples/wiki/parser.dylan Mon May 29 01:07:38 2006
@@ -173,7 +173,7 @@
format(out, "<a href=\"%s%s\">%s%s</a>",
*wiki-link-url*,
title,
- if (page-exists?(title)) "" else "[?]" end,
+ if (find-page(title)) "" else "[?]" end,
title);
else
let bar = find(markup, '|', start: start, end: close);
@@ -216,7 +216,7 @@
let bullet-end = indexes[3];
let num-bullets = bullet-end - bullet-start;
let item-html = wiki-markup-to-html(line, start: bullet-end);
- item-html := copy-sequence(item-html, start: 0, end: item-html.size - 1);
+ item-html := copy-sequence(item-html, start: 0, end: max(item-html.size - 1, 0));
case
depth = 0 =>
format(stream, "<%s>\n<li>%s", tag, item-html);
Modified: trunk/libraries/koala/sources/examples/wiki/wiki.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/wiki/wiki.dylan (original)
+++ trunk/libraries/koala/sources/examples/wiki/wiki.dylan Mon May 29 01:07:38 2006
@@ -9,8 +9,20 @@
define variable *database-directory* :: <locator>
= as(<directory-locator>, "www/wiki/content");
+define method storage-type (type == <wiki-page-content>) => (res)
+ <string-table>;
+end;
+define variable *pages* = storage(<wiki-page-content>);
+
+
+//XXX: TODO:
+//"__" and "=" markup
+//renaming of wiki pages?
+//delete wiki pages
+//tags
+
define thread variable *title* = #f;
-define thread variable *version* = #"newest";
+define thread variable *version* = #f;
define variable *default-title* = "Home";
// This is only used to save the page content across requests when
@@ -32,22 +44,20 @@
#f
end;
-define method make-wiki-locator
- (title :: <string>, version :: <integer>)
- => (loc :: <file-locator>)
- merge-locators(as(<file-locator>,
- sformat("%s.%d", base64-encode(title), version)),
- *database-directory*)
-end;
-
// Lookup the editable wiki content of the given page based
// on the page title. Page content is HTML.
//
define method page-content
- (title :: <string>, #key format = #"raw", version = #"newest")
+ (title :: <string>, #key format = #"raw", version)
=> (content :: false-or(<string>))
- let raw-text = load-page(title, version: version);
- if (raw-text)
+ let page = find-page(title);
+ if (page)
+ let latest = page.revisions.last;
+ let raw-text = if (version & version > 0 & version <= latest.page-version)
+ page.revisions[version - 1].content;
+ else
+ latest.content
+ end;
select (format)
#"raw" => raw-text;
// HACK HACK HACK. Prepend a newline so the start-of-line context applies.
@@ -57,76 +67,6 @@
end
end;
-define method save-page
- (title :: <string>, content :: <string>)
- let version = newest-version-number(title) + 1;
- // TODO: compare with previous version and don't save if no changes.
- let loc = make-wiki-locator(title, version);
- with-open-file(out = loc,
- element-type: <character>,
- direction: #"output",
- if-exists: #"signal",
- if-does-not-exist: #"create")
- write(out, content);
- end;
- newest-version-table[base64-encode(title)] := version;
-end method save-page;
-
-define method load-page
- (title :: <string>, #key version = #"newest")
- => (raw-text :: false-or(<string>))
- let v = ((version == #"newest")
- & newest-version-number(title)
- | version);
- file-contents(make-wiki-locator(title, v));
-end method load-page;
-
-define method page-exists?
- (title :: <string>) => (exists? :: <boolean>)
- newest-version-number(title) ~== 0
-end;
-
-define function parse-version
- (v, #key default) => (v :: <object>)
- if (~v)
- default | #"newest"
- elseif (string-equal?(v, "newest"))
- #"newest"
- else
- ignore-errors(string-to-integer(v)) | default
- end
-end;
-
-define function split-version
- (filename :: <string>)
- => (filename :: <string>, version :: false-or(<integer>))
- let parts = split(filename, separator: ".");
- if (parts.size < 2)
- values(filename, #f)
- else
- let base = parts[0];
- if (parts.size > 2)
- base := join(copy-sequence(parts, end: parts.size - 1), ".");
- end;
- values(base,
- block ()
- string-to-integer(parts[parts.size - 1])
- exception (e :: <error>)
- #f
- end)
- end
-end function split-version;
-
-define constant newest-version-table :: <string-table> =
- make(<string-table>);
-
-// Title is the page title without any version number suffixed to it.
-// Returns the largest (newest) version number of the file with that title.
-// If no files with this title exist, returns 0.
-define method newest-version-number
- (title :: <string>) => (version :: <integer>)
- element(newest-version-table, base64-encode(title), default: 0);
-end method newest-version-number;
define page view-page (<wiki-page>)
(url: "/wiki/view.dsp",
@@ -141,7 +81,7 @@
define method respond-to-get
(page :: <view-page>, request :: <request>, response :: <response>)
dynamic-bind (*title* = get-query-value("title") | *default-title*,
- *version* = parse-version(get-query-value("v"), default: #"newest"),
+ *version* = ignore-errors(string-to-integer(get-query-value("v"))),
*content* = page-content(*title*, version: *version*, format: #"html")
| "(no content)")
next-method(); // process the DSP template
@@ -155,13 +95,13 @@
define method respond-to-get
(page :: <edit-page>, request :: <request>, response :: <response>)
- dynamic-bind (*title* = *title* | get-query-value("title") | *default-title*,
- *version* = parse-version(get-query-value("v")),
- *content* = page-content(*title*,
- version: *version*,
- format: #"raw")
- | "")
- log-debug("version = %=, content = %=", *version*, *content*);
+ dynamic-bind (*title* = get-query-value("title"),
+ *content* = if (*title* & find-page(*title*))
+ latest-text(find-page(*title*));
+ else
+ ""
+ end)
+ log-debug("title = %=, content = %=", *title*, *content*);
next-method(); // process the DSP template
end;
end;
@@ -178,30 +118,16 @@
respond-to-get(page, request, response);
end;
elseif (title = "")
- note-form-error("You must supply a valid page title.",
- field: "title");
+ note-form-error("You must supply a valid page title.", field: "title");
// redisplay edit page.
dynamic-bind (*title* = title,
*content* = content)
respond-to-get(page, request, response);
end;
else
- block ()
- save-page(title, content);
- // Show the page after editing
- respond-to-get(*view-page*, request, response);
- exception (e :: <file-exists-error>)
- note-form-error
- (format-to-string
- ("A page named '%s' already exists. Please choose a new title.",
- title),
- field:, "title");
- // redisplay edit page.
- dynamic-bind (*title* = title,
- *content* = content)
- respond-to-get(page, request, response);
- end;
- end;
+ save-page(title, content, comment: get-query-value("comment"));
+ // Show the page after editing
+ respond-to-get(*view-page*, request, response);
end;
end;
@@ -239,19 +165,13 @@
let email = get-query-value("email");
let email-supplied? = email & email ~= "";
if (email-supplied?)
- unless (adduser(username, password, email))
- note-form-error("Sorry, username already in use.");
- end unless;
+ make(<user>, username: username, password: password, email: email);
else
note-form-error("You must supply an eMail-address to add a new user.");
end if;
end if;
- if (valid-user?(username, password))
- //try to login with specified username and password
- let session = ensure-session(request);
- set-attribute(session, #"username", username);
- set-attribute(session, #"password", password);
+ if (login(request))
let referer = get-query-value("referer");
if (referer & referer ~= "")
let headers = response.response-headers;
@@ -267,61 +187,6 @@
next-method(); // process the DSP template
end;
-define variable *users* = make(<string-table>);
-
-define constant $user-db = "users.txt";
-
-define method adduser (username :: <string>,
- password :: <string>,
- email :: <string>)
- => (result :: <boolean>)
- unless (element(*users*, username, default: #f))
- #f;
- end unless;
- *users*[username] := list(password, email);
- with-open-file(stream = $user-db,
- direction: #"output",
- if-exists: #"append")
- write(stream, concatenate(username, ":", password, ":", email, "\n"));
- end;
- #t;
-end;
-
-define method restore-users () => ()
- with-open-file(stream = $user-db,
- direction: #"input",
- if-does-not-exist: #"create")
- until(stream-at-end?(stream))
- let line = read-line(stream, on-end-of-stream: #f);
- if (line)
- let password-start = char-position(':', line, 0, line.size);
- let email-start = char-position-from-end(':', line, 0, line.size);
- let user = copy-sequence(line,
- start: 0,
- end: password-start);
- let password = copy-sequence(line,
- start: password-start + 1,
- end: email-start);
- let email = copy-sequence(line,
- start: email-start + 1,
- end: line.size);
- *users*[user] := list(password, email);
- end if;
- end until;
- end;
-end;
-
-define method valid-user? (username :: <string>,
- password :: <string>)
- => (result :: <boolean>)
- if ((element(*users*, username, default: #f)) &
- (*users*[username][0] = password))
- #t;
- else
- #f;
- end if;
-end;
-
define page logout-page (<wiki-page>)
(url: "/wiki/logout.dsp",
source: "wiki/logout.dsp")
@@ -335,12 +200,21 @@
end;
+define page index-page (<wiki-page>)
+ (url: "/wiki/index.dsp",
+ source: "wiki/index.dsp")
+end;
define page search-page (<wiki-page>)
(url: "/wiki/search.dsp",
source: "wiki/search.dsp")
end;
+define page backlink-page (<wiki-page>)
+ (url: "/wiki/backlink.dsp",
+ source: "wiki/backlink.dsp")
+end;
+
define thread variable *search-results* = #();
define thread variable *search-result* = #f;
@@ -355,6 +229,11 @@
user-logged-in?(request)
end;
+define named-method admin? in wiki
+ (page, request)
+ login(request) & current-user().access <= 23;
+end;
+
define method user-logged-in? (request :: <request>)
let session = get-session(request);
session & get-attribute(session, #"username");
@@ -392,28 +271,31 @@
define method do-search
(search-string :: <collection>, #key include-old-versions?)
=> (results :: <collection>)
- // TODO: implement include-old-versions? = #f
let words = concatenate(list(search-string), split(search-string));
let matches = make(<string-table>);
- local method find-matches (dir-loc, file-name, file-type)
- if (file-type == #"file")
- let loc = merge-locators(as(<file-locator>, file-name), dir-loc);
- let (base, version) = split-version(file-name);
- let title = ignore-errors(base64-decode(base));
- let (weight, summary) = search-file(title, loc, words);
- if (weight > 0)
- if (title)
- matches[base] := add!(element(matches, base, default: list()),
- make(<search-result>,
- title: title,
- version: version,
- weight: weight,
- summary: summary));
- end;
- end;
+ local method maybe-add (string, version, title, title-weight)
+ let (weight, summary) = search-text(string, words);
+ weight := weight + title-weight;
+ if (weight > 0)
+ matches[title] := add!(element(matches, title, default: #()),
+ make(<search-result>,
+ title: title,
+ weight: weight,
+ version: version,
+ summary: summary));
end;
- end method find-matches;
- do-directory(find-matches, *database-directory*);
+ end;
+ for (title in key-sequence(*pages*))
+ let title-weight = search-text(title, words);
+ if (include-old-versions?)
+ map(method(x)
+ maybe-add(x.content, x.page-version, title, title-weight)
+ end, *pages*[title].revisions);
+ else
+ let page = *pages*[title].revisions.last;
+ maybe-add(page.content, page.page-version, title, title-weight);
+ end;
+ end;
local method sr-> (x, y)
x.search-result-weight > y.search-result-weight
end;
@@ -426,27 +308,6 @@
sort(table-values(matches), test: srl->)
end method do-search;
-// Search the given file for the given words and return a number
-// indicating how good a match was found. Bigger is better.
-// The first item in 'words' is the entire search string, so it
-// should be weighted more heavily.
-define method search-file
- (title :: <string>, file :: <file-locator>, words)
- => (weight :: <integer>, summary :: <string>)
- let text = file-contents(file) | "";
- let (weight, summary) = search-text(title, words);
- if (weight > 0)
- weight := weight * 2;
- summary := copy-sequence(text, start: 0, end: min(text.size, 200));
- end;
- let (weight2, summary2) = search-text(text, words);
- weight := weight + weight2;
- if (size(summary2) ~= 0)
- summary := summary2;
- end;
- values(weight, summary)
-end method search-file;
-
// TODO: This is truly awful. It needs to be rewritten in a way that
// * isn't hideously expensive
// * properly weights matches of several search terms in order
@@ -530,12 +391,15 @@
let out = output-stream(response);
let title = *title* | "(no title)";
write(out, title);
- if (v)
- // show version, if not newest
- let newest = newest-version-number(title);
- log-debug("newest = %=, *version* = %=", newest, *version*);
- if (*version* ~== #"newest" & *version* ~== newest)
- format(out, for-url & "&v=%s" | " (version %s)", *version*);
+ if (*title* & v)
+ let wiki-page = find-page(*title*);
+ if (wiki-page)
+ // show version, if not newest
+ let newest = page-version(last(wiki-page.revisions));
+ log-debug("newest = %=, *version* = %=", newest, *version*);
+ if (*version* & *version* < newest)
+ format(out, for-url & "&v=%s" | " (version %s)", *version*);
+ end;
end;
end;
end;
@@ -544,45 +408,45 @@
(page :: <wiki-page>, response :: <response>)
(format :: <string> = "raw")
write(output-stream(response),
- page-content(*title*, version: *version*, format: as(<symbol>, format))
- | *content* | "");
+ (*title* & page-content(*title*, version: *version*, format: as(<symbol>, format)))
+ | *content*);
end;
define body tag show-revisions in wiki
(page :: <wiki-page>, response :: <response>, do-body :: <function>)
- (first :: <string>, last :: <string>)
- let revisions = make(<list>);
- let last = as(<integer>,last);
- local method find-revisions (dir-loc, file-name, file-type)
- if (file-type == #"file")
- let loc = merge-locators(as(<file-locator>, file-name), dir-loc);
- let (base, version) = split-version(file-name);
- let title = ignore-errors(base64-decode(base));
- if (title & (title = *title*))
- revisions := add!(revisions, version);
- end;
- end;
- end;
- do-directory(find-revisions, *database-directory*);
- log-debug("%=", revisions);
- let esize = 0;
- if (size(revisions) <= last)
- esize := size(revisions);
- else
- esize := last;
- end;
- revisions := copy-sequence (reverse!(sort(revisions)), start: as(<integer>, first), end: esize);
- for(rev in revisions)
- dynamic-bind (*search-result* = rev)
- do-body();
+ (count :: <string>)
+ let content = find-page(*title* | "(no title)");
+ if (content)
+ let count = min(as(<integer>, count), *pages*[*title*].revisions.size);
+ let revs = copy-sequence(reverse(*pages*[*title*].revisions), end: count);
+ for(rev in revs)
+ dynamic-bind (*version* = rev.page-version)
+ do-body();
+ end;
end;
end;
end;
+define method respond-to-get
+ (page :: <backlink-page>, request :: <request>, response :: <response>)
+ dynamic-bind (*title* = get-query-value("title") | *default-title*)
+ next-method(); // process the DSP template
+ end;
+end;
+
+define body tag show-backlink in wiki
+ (page :: <backlink-page>, response :: <response>, do-body :: <function>)
+ ()
+ for (backlink in find-backlinks(*title*))
+ dynamic-bind (*title* = backlink.page-title)
+ do-body()
+ end;
+ end;
+end;
define tag version in wiki
(page :: <wiki-page>, response :: <response>)
()
- write(output-stream(response), integer-to-string(*search-result*));
+ write(output-stream(response), integer-to-string(*version*));
end;
define tag username in wiki
@@ -593,15 +457,141 @@
get-attribute(session, #"username"));
end;
+define body tag show-index in wiki
+ (page :: <wiki-page>, response :: <response>, do-body :: <function>)
+ ()
+ for (key in sort(key-sequence(*pages*)))
+ dynamic-bind(*title* = key)
+ do-body();
+ end;
+ end;
+end;
+
define page recent-changes-page (<wiki-page>)
(url: "/wiki/recent.dsp",
source: "wiki/recent.dsp")
end;
-define named-method gen-recent-changes
- (page :: <recent-changes-page>)
- // TODO
- #()
+define page diff-page (<wiki-page>)
+ (url: "/wiki/diff.dsp",
+ source: "wiki/diff.dsp")
+end;
+
+define thread variable *other-version* = #f;
+
+define method respond-to-get
+ (page :: <diff-page>, request :: <request>, response :: <response>)
+ dynamic-bind (*title* = get-query-value("title"),
+ *version* = string-to-integer(get-query-value("version")),
+ *other-version* = ignore-errors(string-to-integer(get-query-value("otherversion"))) | *version* - 1)
+ next-method();
+ end;
+end;
+
+define method print-diffs (out, diff, source, target)
+ do(rcurry(print-diff, out, source, target), diff);
+end;
+
+define method print-diff (diff :: <insert-entry>, out, source, target)
+ write(out, format-to-string("added lines %d - %d:<br>", diff.source-index, diff.element-count + diff.source-index - 1));
+ for (line in copy-sequence(target, start: diff.source-index, end: diff.source-index + diff.element-count),
+ lineno from diff.source-index)
+ write(out, format-to-string("%d: %s<br>", lineno, line));
+ end;
+end;
+
+define method print-diff (diff :: <delete-entry>, out, source, target)
+ write(out, format-to-string("removed lines %d - %d:<br>", diff.dest-index, diff.element-count + diff.dest-index - 1));
+ for (line in copy-sequence(source, start: diff.dest-index, end: diff.dest-index + diff.element-count),
+ lineno from diff.dest-index)
+ write(out, format-to-string("%d: %s<br>", lineno, line));
+ end;
+end;
+
+define tag show-diff in wiki
+ (page :: <diff-page>, response :: <response>)
+ ()
+ let page = find-page(*title*);
+ let version = *version* - 1;
+ let otherversion = *other-version* - 1;
+ if (version < page.revisions.size & otherversion < page.revisions.size)
+ let target = split(page.revisions[version].content, separator: "\n");
+ let source = if (otherversion = -1) #() else split(page.revisions[otherversion].content, separator: "\n") end;
+ print-diffs(output-stream(response), sequence-diff(source, target), source, target);
+ end;
+end;
+
+define tag otherversion in wiki
+ (page :: <wiki-page>, response :: <response>)
+ ()
+ write(output-stream(response), integer-to-string(*other-version*));
+end;
+
+define thread variable *change* = #f;
+
+define variable *changes* = storage(<wiki-page-diff>);
+define body tag gen-recent-changes in wiki
+ (page :: <recent-changes-page>, response :: <response>, do-body :: <function>)
+ (count)
+ let count = string-to-integer(get-query-value("count") | count);
+ for (i from 0 below count,
+ change in reverse(*changes*))
+ dynamic-bind(*change* = change)
+ do-body()
+ end;
+ end;
+end;
+
+define method print-date (date :: <date>)
+ let $month-names
+ = #["Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"];
+ let (iyear, imonth, iday, ihours, iminutes,
+ iseconds, day-of-week, time-zone-offset)
+ = decode-date(date);
+ local method wrap0 (i :: <integer>) => (string :: <string>)
+ if (i < 10)
+ concatenate("0", integer-to-string(i));
+ else
+ integer-to-string(i)
+ end;
+ end;
+ concatenate(integer-to-string(iday), " ",
+ $month-names[imonth - 1], " ",
+ integer-to-string(iyear), " ",
+ wrap0(ihours), ":",
+ wrap0(iminutes), ":",
+ wrap0(iseconds));
+end;
+
+define tag show-change-timestamp in wiki
+ (page :: <recent-changes-page>, response :: <response>)
+ ()
+ write(output-stream(response), print-date(*change*.timestamp));
+end;
+
+define tag show-change-title in wiki
+ (page :: <recent-changes-page>, response :: <response>)
+ ()
+ write(output-stream(response), *change*.wiki-page-content.page-title);
+end;
+
+define tag show-change-version in wiki
+ (page :: <recent-changes-page>, response :: <response>)
+ ()
+ write(output-stream(response), integer-to-string(*change*.page-version));
+end;
+
+define tag show-change-author in wiki
+ (page :: <recent-changes-page>, response :: <response>)
+ ()
+ write(output-stream(response), *change*.author);
+end;
+
+define tag show-change-comment in wiki
+ (page :: <recent-changes-page>, response :: <response>)
+ ()
+ write(output-stream(response), *change*.comment);
end;
// Tell Koala how to parse the wiki config element.
@@ -615,19 +605,39 @@
end;
*database-directory* := as(<directory-locator>, cdir);
log-info("Wiki content directory = %s", as(<string>, *database-directory*));
- populate-version-cache();
+ import-database();
end;
-define method populate-version-cache() => ()
- local method fun (dir-loc, filename, file-type)
+define method import-database ()
+ let changelist = make(<string-table>);
+ local method import-file (dir-loc, file-name, file-type)
if (file-type = #"file")
- let (base, version) = split-version(filename);
- let biggest = element(newest-version-table, base, default: 0);
- newest-version-table[base] := max(biggest, version | biggest);
- end;
- end method fun;
- do-directory(fun, *database-directory*);
-end method;
+ let filename-parts = split(file-name, separator: ".");
+ let title = base64-decode(filename-parts[0]);
+ unless(element(changelist, title, default: #f))
+ changelist[title] := make(<vector>, size: 42);
+ end;
+ let file-loc = merge-locators(as(<file-locator>, file-name), dir-loc);
+ let date = file-property(file-loc, #"creation-date");
+ let index = if (filename-parts.size = 2)
+ string-to-integer(filename-parts[1])
+ else
+ 0
+ end;
+ changelist[title][index] := file-contents(file-loc);
+ end;
+ end;
+ if (*pages*.size = 0)
+ do-directory(import-file, *database-directory*);
+ end;
+ for (name in key-sequence(changelist))
+ for (ele in changelist[name])
+ if (ele)
+ save-page(name, ele)
+ end;
+ end;
+ end;
+end;
define function main
() => ()
@@ -636,7 +646,6 @@
application-arguments()[0]
end;
//register-url("/wiki/wiki.css", maybe-serve-static-file);
- restore-users();
start-server(config-file: config-file);
end;
Modified: trunk/libraries/koala/sources/examples/wiki/wiki.lid
==============================================================================
--- trunk/libraries/koala/sources/examples/wiki/wiki.lid (original)
+++ trunk/libraries/koala/sources/examples/wiki/wiki.lid Mon May 29 01:07:38 2006
@@ -2,3 +2,4 @@
files: library
parser
wiki
+ classes
Added: trunk/libraries/koala/www/wiki/backlink.dsp
==============================================================================
--- (empty file)
+++ trunk/libraries/koala/www/wiki/backlink.dsp Mon May 29 01:07:38 2006
@@ -0,0 +1,22 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<%dsp:taglib name="wiki"/>
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+ <title>Dylan Wiki: Backlinks: <wiki:show-title/></title>
+ <link rel="stylesheet" href="/wiki/wiki.css"/>
+</head>
+
+<body>
+ <%dsp:include url="header.dsp"/>
+ <div id="content">
+ <h1>Backlinks for <wiki:show-title/></h1>
+ <ul>
+ <wiki:show-backlink>
+ <li><a href="/wiki/view.dsp?title=<wiki:show-title/>"><wiki:show-title/></a></li>
+ </wiki:show-backlink>
+ </ul>
+ </div>
+ <%dsp:include url="footer.dsp"/>
+</body>
+</html>
Added: trunk/libraries/koala/www/wiki/diff.dsp
==============================================================================
--- (empty file)
+++ trunk/libraries/koala/www/wiki/diff.dsp Mon May 29 01:07:38 2006
@@ -0,0 +1,18 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<%dsp:taglib name="wiki"/>
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+ <title>Dylan Wiki: Diff <wiki:show-title/></title>
+ <link rel="stylesheet" href="/wiki/wiki.css"/>
+</head>
+
+<body>
+ <%dsp:include url="header.dsp"/>
+ <div id="content">
+ <h1>Diff <wiki:show-title/> Versions <wiki:version/> - <wiki:otherversion/></h1>
+ <wiki:show-diff/>
+ </div>
+ <%dsp:include url="footer.dsp"/>
+</body>
+</html>
Modified: trunk/libraries/koala/www/wiki/edit.dsp
==============================================================================
--- trunk/libraries/koala/www/wiki/edit.dsp (original)
+++ trunk/libraries/koala/www/wiki/edit.dsp Mon May 29 01:07:38 2006
@@ -1,37 +1,39 @@
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
-<%dsp:taglib name="wiki"/>
-<html xmlns="http://www.w3.org/1999/xhtml">
-<head>
- <title>Dylan Wiki: <wiki:show-title/></title>
- <link rel="stylesheet" href="/wiki/wiki.css"/>
-</head>
-
-<body>
-
- <%dsp:include url="header.dsp"/>
-
- <div id="form-notes">
- <dsp:show-form-notes/>
- </div>
-
- <dsp:if test="logged-in?">
- <dsp:then>
- <form action="/wiki/edit.dsp" method="post">
- <div id="edit">
- Title: <input type="text" name="title" value="<wiki:show-title/>"/>
- <br/>
- <textarea name="page-content" cols="80" rows="20"><wiki:show-content format="raw"/></textarea>
- <br/>
- <input type="submit" value="Save"/>
- </div>
- </form>
- </dsp:then>
- <dsp:else>
- Error: you're not allowed to edit <wiki:show-title/>.
- </dsp:else>
- </dsp:if>
-
- <%dsp:include url="footer.dsp"/>
-
-</body>
-</html>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<%dsp:taglib name="wiki"/>
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+ <title>Dylan Wiki: <wiki:show-title/></title>
+ <link rel="stylesheet" href="/wiki/wiki.css"/>
+</head>
+
+<body>
+
+ <%dsp:include url="header.dsp"/>
+
+ <div id="form-notes">
+ <dsp:show-form-notes/>
+ </div>
+
+ <dsp:if test="logged-in?">
+ <dsp:then>
+ <form action="/wiki/edit.dsp" method="post">
+ <div id="edit">
+ Title: <input type="text" name="title" value="<wiki:show-title/>"/>
+ <br/>
+ <textarea name="page-content" cols="80" rows="20"><wiki:show-content format="raw"/></textarea>
+ <br/>
+ Comment: <input type="text" name="comment"/>
+ <br/>
+ <input type="submit" value="Save"/>
+ </div>
+ </form>
+ </dsp:then>
+ <dsp:else>
+ Error: you're not allowed to edit <wiki:show-title/>.
+ </dsp:else>
+ </dsp:if>
+
+ <%dsp:include url="footer.dsp"/>
+
+</body>
+</html>
Modified: trunk/libraries/koala/www/wiki/footer.dsp
==============================================================================
--- trunk/libraries/koala/www/wiki/footer.dsp (original)
+++ trunk/libraries/koala/www/wiki/footer.dsp Mon May 29 01:07:38 2006
@@ -1,27 +1,28 @@
-<%dsp:taglib name="wiki"/>
-<!-- standard wiki footer -->
-<div id="footer">
-<br/>
-<div class="navbar">
- <dsp:when test="editable?">
- <a href="/wiki/edit.dsp?title=<wiki:show-title v="true" for-url="true"/>">Edit This Page</a>
- </dsp:when>
-
- <dsp:if test="logged-in?">
- <dsp:then>
- Logged in as <wiki:username/>.
- <a href="/wiki/logout.dsp">Logout</a>
- </dsp:then>
- <dsp:else>
- <a href="/wiki/login.dsp">Login</a>
- </dsp:else>
- </dsp:if>
- <a href="/wiki/recent.dsp">Recent Changes</a>
- <span class="lastrevisions">
- <wiki:show-revisions first="0" last="10">
- <a class="revisionlink" href="/wiki/view.dsp?title=<wiki:show-title/>&v=<wiki:version/>">[<wiki:version/>]</a>
- </wiki:show-revisions>
- </span>
-</div>
- <p id="valid_xhtml"><a href="http://validator.w3.org/check?uri=referer"><img src="http://www.w3.org/Icons/valid-xhtml10" alt="Valid XHTML 1.0!" height="31" width="88" /></a></p>
-</div>
+<%dsp:taglib name="wiki"/>
+<!-- standard wiki footer -->
+<div id="footer">
+<br/>
+<div class="navbar">
+ <dsp:when test="editable?">
+ <a href="/wiki/edit.dsp?title=<wiki:show-title v="true" for-url="true"/>">Edit This Page</a>
+ </dsp:when>
+
+ <dsp:if test="logged-in?">
+ <dsp:then>
+ Logged in as <wiki:username/>.
+ <a href="/wiki/logout.dsp">Logout</a>
+ </dsp:then>
+ <dsp:else>
+ <a href="/wiki/login.dsp">Login</a>
+ </dsp:else>
+ </dsp:if>
+ <a href="/wiki/recent.dsp">Recent Changes</a>
+ <a href="/wiki/index.dsp">Index</a>
+ <span class="lastrevisions">
+ <wiki:show-revisions count="10">
+ <a class="revisionlink" href="/wiki/view.dsp?title=<wiki:show-title v="false"/>&v=<wiki:version/>">[<wiki:version/>]</a>
+ </wiki:show-revisions>
+ </span>
+</div>
+ <p id="valid_xhtml"><a href="http://validator.w3.org/check?uri=referer"><img src="http://www.w3.org/Icons/valid-xhtml10" alt="Valid XHTML 1.0!" height="31" width="88" /></a></p>
+</div>
Modified: trunk/libraries/koala/www/wiki/header.dsp
==============================================================================
--- trunk/libraries/koala/www/wiki/header.dsp (original)
+++ trunk/libraries/koala/www/wiki/header.dsp Mon May 29 01:07:38 2006
@@ -1,21 +1,22 @@
-<%dsp:taglib name="wiki"/>
-<!-- standard wiki header -->
-<div id="header">
- <div id="logo"><a href="http://www.gwydiondylan.org/dylan-wiki.html" class="logo">Dylan Wiki</a></div>
- <form action="/wiki/search.dsp" method="post">
- <div class="search">
- <input type="text" name="search-terms" size="20"/>
- <input type="submit" value="search"/>
- </div>
- </form>
- <div class="navbar">
- <a href="/wiki/view.dsp?title=Home">Home</a>
- <a href="/wiki/new.dsp">New Page</a>
- <a href="/wiki/view.dsp?title=Markup">Wiki Markup</a>
- <dsp:when test="editable?">
- <a href="/wiki/edit.dsp?title=<wiki:show-title v="true" for-url="true"/>">Edit This Page</a>
- </dsp:when>
- </div>
- <dsp:show-form-notes/>
-</div>
-<!-- begin user-generated page content -->
+<%dsp:taglib name="wiki"/>
+<!-- standard wiki header -->
+<div id="header">
+ <div id="logo"><a href="http://www.gwydiondylan.org/dylan-wiki.html" class="logo">Dylan Wiki</a></div>
+ <form action="/wiki/search.dsp" method="post">
+ <div class="search">
+ <input type="text" name="search-terms" size="20"/>
+ <input type="submit" value="search"/>
+ </div>
+ </form>
+ <div class="navbar">
+ <a href="/wiki/view.dsp?title=Home">Home</a>
+ <a href="/wiki/new.dsp">New Page</a>
+ <a href="/wiki/view.dsp?title=Markup">Wiki Markup</a>
+ <a href="/wiki/backlink.dsp?title=<wiki:show-title/>">Backlinks</a>
+ <dsp:when test="editable?">
+ <a href="/wiki/edit.dsp?title=<wiki:show-title v="true" for-url="true"/>">Edit This Page</a>
+ </dsp:when>
+ </div>
+ <dsp:show-form-notes/>
+</div>
+<!-- begin user-generated page content -->
Added: trunk/libraries/koala/www/wiki/index.dsp
==============================================================================
--- (empty file)
+++ trunk/libraries/koala/www/wiki/index.dsp Mon May 29 01:07:38 2006
@@ -0,0 +1,34 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<%dsp:taglib name="wiki"/>
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+ <title>Dylan Wiki: Index</title>
+ <link rel="stylesheet" href="/wiki/wiki.css"/>
+</head>
+
+<body>
+ <%dsp:include url="header.dsp"/>
+ <div id="content">
+ <h1>Index</h1>
+ <wiki:show-index>
+ <a href="/wiki/view.dsp?title=<wiki:show-title/>"><wiki:show-title/></a>
+ <dsp:if test="admin?">
+ <dsp:then>
+ <a href="/wiki/worker?title=<wiki:show-title/>&action=remove">remove</a>
+ <form action="/wiki/worker" method="post">
+ <input type="hidden" name="oldtitle" value="<wiki:show-title/>">
+ <input type="hidden" name="action" value="rename">
+ rename to <input type="text" name="title"><input type="submit" value="Save"/>
+ </form>
+ <br>
+ </dsp:then>
+ <dsp:else>
+ <br>
+ </dsp:else>
+ </dsp:if>
+ </wiki:show-index>
+ </div>
+ <%dsp:include url="footer.dsp"/>
+</body>
+</html>
Modified: trunk/libraries/koala/www/wiki/recent.dsp
==============================================================================
--- trunk/libraries/koala/www/wiki/recent.dsp (original)
+++ trunk/libraries/koala/www/wiki/recent.dsp Mon May 29 01:07:38 2006
@@ -1,19 +1,23 @@
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
-<%dsp:taglib name="wiki"/>
-<html xmlns="http://www.w3.org/1999/xhtml">
-<head>
- <title>Dylan Wiki: Recent Changes</title>
-</head>
-
-<body>
- <%dsp:include url="header.dsp"/>
- <div id="content">
-
- <dsp:show-form-notes/>
- <h3>Recent Changes</h3>
- Recent changes listings are not yet implemented.
-
- </div>
- <%dsp:include url="footer.dsp"/>
-</body>
-</html>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<%dsp:taglib name="wiki"/>
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+ <title>Dylan Wiki: Recent Changes</title>
+ <link rel="stylesheet" href="/wiki/wiki.css"/>
+</head>
+
+<body>
+ <%dsp:include url="header.dsp"/>
+ <div id="content">
+
+ <dsp:show-form-notes/>
+ <h3>Recent Changes</h3>
+ <ul>
+ <wiki:gen-recent-changes count="50">
+ <li><wiki:show-change-timestamp/> <a href="/wiki/view.dsp?title=<wiki:show-change-title/>&v=<wiki:show-change-version/>"><wiki:show-change-title/></a> version <wiki:show-change-version/> <a href="/wiki/diff.dsp?title=<wiki:show-change-title/>&version=<wiki:show-change-version/>">diff</a> by <wiki:show-change-author/> Comment <wiki:show-change-comment/></li>
+ </wiki:gen-recent-changes>
+ </ul>
+ </div>
+ <%dsp:include url="footer.dsp"/>
+</body>
+</html>
Modified: trunk/libraries/web-framework/library.dylan
==============================================================================
--- trunk/libraries/web-framework/library.dylan (original)
+++ trunk/libraries/web-framework/library.dylan Mon May 29 01:07:38 2006
@@ -1,158 +1,159 @@
-module: dylan-user
-author: Hannes Mehnert <hannes at mehnert.org>
-
-define library web-framework
- use common-dylan;
- use dylan;
- use io;
- use koala, import: { koala, dsp };
- use xml-parser, import: { simple-xml };
- use system, import: { file-system, date };
- use dood;
-
- export object-table,
- web-framework,
- storage,
- users,
- changes;
-end;
-
-define module object-table
- use common-dylan;
- use dylan-extensions,
- import: { address-of, <string-table> };
-
- export get-reference,
- get-object;
-end;
-
-define module storage
- use common-dylan;
- use dood;
- use file-system;
- use threads;
- use format-out;
- use koala;
-
- export storage,
- dump-data,
- dumper,
- save,
- restore,
- restore-newest,
- version;
-end;
-
-define module web-framework-macro
- use common-dylan;
- use dylan-extensions, import: { debug-name };
-
- export list-reference-slots,
- reference-slots,
- data-slots;
-
- export \web-class-definer;
-
- export <reference-object>,
- visible?,
- visible?-setter;
-
- export <slot>,
- slot-name,
- slot-type,
- slot-getter-method,
- slot-setter-method,
- default,
- default-function,
- default-help-text;
-
- export check,
- key,
- show,
- get-url-from-type;
-
- export <triple>,
- slot-name,
- old-value,
- new-value;
-
- export <web-form-warning>,
- <web-success>,
- <web-error>,
- error-string;
-end;
-
-define module users
- use common-dylan;
- use dylan;
- use dsp, import: { set-attribute, get-attribute };
- use koala;
- use storage;
- use web-framework-macro;
-
- //user stuff
- export <user>,
- username,
- password,
- email,
- admin?,
- current-user,
- valid-user?,
- login,
- logged-in;
-end;
-
-define module changes
- use common-dylan;
- use dylan;
- use date;
- use simple-xml;
-
- use object-table;
- use storage;
- use web-framework-macro;
- use users;
-
- //changes
- export <change>,
- author,
- date,
- command,
- undo,
- redo,
- print-xml;
-
- //commands
- export <add-command>,
- <remove-command>,
- <edit-command>;
-end;
-
-
-define module web-framework
- use common-dylan;
- use object-table;
- use simple-xml;
- use format-out;
- use koala;
-
- use web-framework-macro, export: all;
- use storage;
- use changes;
-
- export respond-to-get,
- respond-to-post;
-
- export edit-form,
- remove-form,
- add-form,
- list-forms;
-
- export browse-list,
- browse-table,
- remove-form,
- browse,
- to-table-header,
- to-table;
-end;
-
+module: dylan-user
+author: Hannes Mehnert <hannes at mehnert.org>
+
+define library web-framework
+ use common-dylan;
+ use dylan;
+ use io;
+ use koala, import: { koala, dsp };
+ use xml-parser, import: { simple-xml };
+ use system, import: { file-system, date };
+ use dood;
+
+ export object-table,
+ web-framework,
+ storage,
+ users,
+ changes;
+end;
+
+define module object-table
+ use common-dylan;
+ use dylan-extensions,
+ import: { address-of, <string-table> };
+
+ export get-reference,
+ get-object;
+end;
+
+define module storage
+ use common-dylan;
+ use dood;
+ use file-system;
+ use threads;
+ use format-out;
+ use koala;
+
+ export storage,
+ dump-data,
+ dumper,
+ save,
+ restore,
+ restore-newest,
+ version,
+ storage-type;
+end;
+
+define module web-framework-macro
+ use common-dylan;
+ use dylan-extensions, import: { debug-name };
+
+ export list-reference-slots,
+ reference-slots,
+ data-slots;
+
+ export \web-class-definer;
+
+ export <reference-object>,
+ visible?,
+ visible?-setter;
+
+ export <slot>,
+ slot-name,
+ slot-type,
+ slot-getter-method,
+ slot-setter-method,
+ default,
+ default-function,
+ default-help-text;
+
+ export check,
+ key,
+ show,
+ get-url-from-type;
+
+ export <triple>,
+ slot-name,
+ old-value,
+ new-value;
+
+ export <web-form-warning>,
+ <web-success>,
+ <web-error>,
+ error-string;
+end;
+
+define module users
+ use common-dylan;
+ use dylan;
+ use dsp, import: { set-attribute, get-attribute };
+ use koala;
+ use storage;
+ use web-framework-macro;
+
+ //user stuff
+ export <user>,
+ username,
+ password,
+ email,
+ current-user,
+ valid-user?,
+ login,
+ logged-in,
+ access;
+end;
+
+define module changes
+ use common-dylan;
+ use dylan;
+ use date;
+ use simple-xml;
+
+ use object-table;
+ use storage;
+ use web-framework-macro;
+ use users;
+
+ //changes
+ export <change>,
+ author,
+ date,
+ command,
+ undo,
+ redo,
+ print-xml;
+
+ //commands
+ export <add-command>,
+ <remove-command>,
+ <edit-command>;
+end;
+
+
+define module web-framework
+ use common-dylan;
+ use object-table;
+ use simple-xml;
+ use format-out;
+ use koala;
+
+ use web-framework-macro, export: all;
+ use storage;
+ use changes;
+
+ export respond-to-get,
+ respond-to-post;
+
+ export edit-form,
+ remove-form,
+ add-form,
+ list-forms;
+
+ export browse-list,
+ browse-table,
+ remove-form,
+ browse,
+ to-table-header,
+ to-table;
+end;
+
Modified: trunk/libraries/web-framework/storage.dylan
==============================================================================
--- trunk/libraries/web-framework/storage.dylan (original)
+++ trunk/libraries/web-framework/storage.dylan Mon May 29 01:07:38 2006
@@ -23,15 +23,23 @@
*version*;
end;
-define method storage (type) => (res :: <stretchy-vector>)
+define open generic storage-type (type) => (res);
+
+define method storage-type (type) => (res)
+ <stretchy-vector>;
+end;
+
+define method storage (type) => (res)
let res = element(*storage*, type, default: #f);
unless (res)
- res := make(<stretchy-vector>);
+ res := make(storage-type(type));
*storage*[type] := res;
end;
res;
end;
+define open generic save (object :: <object>) => ();
+
define method save (object) => ()
add!(storage(object.object-class), object);
end;
Modified: trunk/libraries/web-framework/users.dylan
==============================================================================
--- trunk/libraries/web-framework/users.dylan (original)
+++ trunk/libraries/web-framework/users.dylan Mon May 29 01:07:38 2006
@@ -5,8 +5,23 @@
data username :: <string>;
data password :: <string>;
data email :: <string>;
- //slot object-table :: <table>, init-keyword: table:;
- data admin? :: <boolean>;
+ data access :: <integer> = 999;
+end;
+
+define method initialize (user :: <user>, #rest rest, #key, #all-keys)
+ next-method();
+ check(user);
+ $users[user.username] := user;
+end;
+define variable $users = storage(<user>);
+
+define inline-only method key (user :: <user>)
+ => (res :: <string>)
+ user.username;
+end;
+
+define method storage-type (type == <user>) => (res)
+ <string-table>;
end;
define method as (class == <string>, user :: <user>)
@@ -20,14 +35,9 @@
*user*
end;
-define inline-only method key (user :: <user>)
- => (res :: <string>)
- user.username;
-end;
-
define method check (user :: <user>, #key test-result = 0)
=> (res :: <boolean>)
- if (any?(method(x) x.username = user.username end, storage(<user>)))
+ if (element($users, user.username, default: #f))
signal(make(<web-error>,
error: "User with same name already exists!"))
else
@@ -36,7 +46,7 @@
end;
define method valid-user? (user-name :: <string>, pass :: <string>)
- let user = choose(method(x) x.username = user-name end, storage(<user>))[0];
+ let user = element($users, user-name, default: #f);
if (user & (user.password = pass))
#t;
else
@@ -50,7 +60,7 @@
if (username & password)
if (valid-user?(user-name, password))
let session = ensure-session(request);
- *user* := choose(method(x) x.username = user-name end, storage(<user>))[0];
+ *user* := $users[user-name];
set-attribute(session, #"username", user-name);
end;
end;
@@ -61,7 +71,7 @@
let session = get-session(request);
if (session)
let user-name = get-attribute(session, #"username");
- *user* := choose(method(x) x.username = user-name end, storage(<user>))[0];
+ *user* := $users[user-name];
user-name;
end;
end;
More information about the chatter
mailing list