[Gd-chatter] r11060 - in trunk/libraries/network: web-framework wiki
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Tue Dec 12 00:24:18 CET 2006
Author: hannes
Date: Tue Dec 12 00:24:16 2006
New Revision: 11060
Modified:
trunk/libraries/network/web-framework/storage.dylan
trunk/libraries/network/web-framework/users.dylan
trunk/libraries/network/wiki/classes.dylan
Log:
Job: minor
*some storage improvements, write incremental files
*the call to dumper is no longer needed, since every save(object) does a write to disk,
max 1 transaction might be lost.
Modified: trunk/libraries/network/web-framework/storage.dylan
==============================================================================
--- trunk/libraries/network/web-framework/storage.dylan (original)
+++ trunk/libraries/network/web-framework/storage.dylan Tue Dec 12 00:24:16 2006
@@ -19,14 +19,15 @@
define variable *version* :: <integer> = 0;
-define constant $database-lock = make(<lock>);
-
-define method version () => (res :: <integer>)
- *version*;
-end;
+define variable *rev* :: <integer> = 0;
+define constant $database-lock = make(<recursive-lock>);
define open generic storage-type (type) => (res);
+define open generic key (class) => (res);
+define method key (class) => (res)
+ #f;
+end;
define method storage-type (type) => (res)
<stretchy-vector>;
end;
@@ -63,10 +64,23 @@
define method save (object) => ()
with-lock($database-lock)
- add!(storage(object.object-class), object);
+ add-object(storage(object.object-class), object);
+ if (*rev* = 100 | *version* = 0)
+ really-dump-all-data();
+ else
+ dump-single-object(object);
+ end;
end;
end;
+define method add-object (list :: <collection>, ele :: <object>)
+ *storage*[ele.object-class] := add!(list, ele);
+end;
+
+define method add-object (table :: <table>, ele :: <object>)
+ table[ele.key] := ele
+end;
+
define class <storage> (<object>)
constant slot hash-table = *storage*;
constant slot table-version = *version*;
@@ -74,36 +88,65 @@
define constant $filename = last(split(application-name(), '/'));
+define inline function generate-filename () => (res :: <string>)
+ concatenate(*directory*, $filename, ".", integer-to-string(*version*));
+end;
+
+define function dump-single-object (object :: <object>) => ()
+ let loc = concatenate(generate-filename(), ".", integer-to-string(*rev*));
+ let dood = make(<dood>, locator: loc, direction: #"output", if-exists: #"replace");
+ dood-root(dood) := object;
+ dood-commit(dood);
+ dood-close(dood);
+ *rev* := *rev* + 1;
+end;
+
+define function really-dump-all-data () => ()
+ *version* := *version* + 1;
+ let loc = generate-filename();
+ let dood = make(<dood>, locator: loc, direction: #"output", if-exists: #"replace");
+ dood-root(dood) := make(<storage>);
+ dood-commit(dood);
+ dood-close(dood);
+ *rev* := 0;
+end;
define method dump-data () => ()
with-lock ($database-lock)
- let loc = concatenate(*directory*,
- $filename,
- "-",
- integer-to-string(*version*));
- let dood = make(<dood>,
- locator: loc,
- direction: #"output",
- if-exists: #"replace");
- dood-root(dood) := make(<storage>);
- dood-commit(dood);
- dood-close(dood);
- *version* := *version* + 1;
+ really-dump-all-data();
end;
end;
-define method restore (filename :: <string>) => ()
- format-out("restoring %s\n", filename);
+define method restore (directory :: <string>, filename :: <string>) => ()
+ format-out("restoring %s/%s\n", directory, filename);
let dood = make(<dood>,
- locator: filename,
+ locator: merge-locators(as(<file-locator>, filename),
+ as(<directory-locator>, directory)),
direction: #"input");
- let storage = dood-root(dood);
+ let storage-root = dood-root(dood);
dood-close(dood);
+ let major = split-file(filename);
with-lock ($database-lock)
- *storage* := storage.hash-table;
- if (storage.table-version >= *version*)
- *version* := storage.table-version + 1;
- else
- *version* := *version* + 1;
+ *storage* := storage-root.hash-table;
+ *version* := storage-root.table-version;
+ //ok, restored major version, now restore all patches!
+ let minor-list = make(<vector>, size: 100, fill: #f);
+ do-directory(method (dir :: <pathname>, fname :: <string>, type :: <file-type>)
+ if (type == #"file")
+ let min = minor-version?(major, fname);
+ if (min)
+ minor-list[min] := fname;
+ end;
+ end;
+ end, directory);
+ for (minor in minor-list, i from 1)
+ if (minor)
+ let d = make(<dood>, locator: concatenate(directory, minor), direction: #"input");
+ let obj = dood-root(d);
+ dood-close(d);
+ add-object(storage(obj.object-class), obj);
+ //setup(obj);
+ *rev* := i;
+ end;
end;
end;
for (class in key-sequence(*storage*))
@@ -111,22 +154,31 @@
end for;
end;
+define inline function minor-version? (major :: <integer>, minor :: <string>)
+ => (res :: false-or(<integer>))
+ let filename-elements = split(minor, '.');
+ if ((filename-elements.size = 3)
+ & (filename-elements[0] = $filename)
+ & (string-to-integer(filename-elements[1]) = major))
+ string-to-integer(filename-elements[2]);
+ else
+ #f;
+ end;
+end;
define method restore-newest (directory :: <string>) => ()
let file = #f;
let latest-version = 0;
- do-directory(method(directory :: <pathname>,
- filename :: <string>,
- type :: <file-type>)
- if (type == #"file")
- let version = split-file(filename);
- if (version > latest-version)
- latest-version := version;
- file := filename
- end;
+ do-directory(method (dir :: <pathname>, filename :: <string>, type :: <file-type>)
+ if (type == #"file")
+ let version = split-file(filename);
+ if (version > latest-version)
+ latest-version := version;
+ file := filename
end;
+ end;
end, directory);
if (file)
- restore(concatenate(directory, "/", file));
+ restore(directory, file);
end;
end;
@@ -145,7 +197,7 @@
end;
define function split-file (filename :: <string>) => (version :: <integer>)
- let elements = split(filename, '-');
+ let elements = split(filename, '.');
if ((elements.size = 2) & (elements[0] = $filename))
string-to-integer(elements[1]);
else
Modified: trunk/libraries/network/web-framework/users.dylan
==============================================================================
--- trunk/libraries/network/web-framework/users.dylan (original)
+++ trunk/libraries/network/web-framework/users.dylan Tue Dec 12 00:24:16 2006
@@ -1,21 +1,23 @@
module: users
author: Hannes Mehnert <hannes at mehnert.org>
+define class <access-level> (<object>)
+end;
+
define open web-class <user> (<object>)
data username :: <string>;
data password :: <string>;
data email :: <string>;
- data access :: <list> = make(<list>);
+ slot access :: <list> = make(<list>);
+ has-a access-level;
end;
-
+/*
define method initialize (user :: <user>, #rest rest, #key, #all-keys)
next-method();
check(user);
- with-storage (table = <user>)
- table[user.username] := user;
- end;
+ save(user);
end;
-
+*/
define inline-only method key (user :: <user>)
=> (res :: <string>)
user.username;
Modified: trunk/libraries/network/wiki/classes.dylan
==============================================================================
--- trunk/libraries/network/wiki/classes.dylan (original)
+++ trunk/libraries/network/wiki/classes.dylan Tue Dec 12 00:24:16 2006
@@ -67,9 +67,7 @@
let page = find-page(title);
unless (page)
page := make(<wiki-page-content>, page-title: title);
- with-storage (pages = <wiki-page-content>)
- pages[title] := page;
- end;
+ save(page);
end;
let version = size(page.revisions) + 1;
unless (version > 1 & content = page.latest-text)
@@ -82,6 +80,8 @@
add!(page.revisions, revision);
end;
save(revision);
+ //need to store dependency (page, because page.revisions was updated)
+ save(page);
end;
end;
More information about the chatter
mailing list