Author: hannes
Date: Tue Feb 21 01:09:58 2006
New Revision: 10538
Added:
trunk/libraries/registry/generic/web-framework
trunk/libraries/web-framework/
trunk/libraries/web-framework/change.dylan
- copied, changed from r10535,
trunk/libraries/koala/sources/examples/buddha/change.dylan
trunk/libraries/web-framework/changes.dylan
- copied unchanged from r10535,
trunk/libraries/koala/sources/examples/buddha/changes.dylan
trunk/libraries/web-framework/class-browser.dylan
- copied, changed from r10535,
trunk/libraries/koala/sources/examples/buddha/class-browser.dylan
trunk/libraries/web-framework/class-editor.dylan
- copied, changed from r10535,
trunk/libraries/koala/sources/examples/buddha/class-editor.dylan
trunk/libraries/web-framework/command.dylan
- copied, changed from r10535,
trunk/libraries/koala/sources/examples/buddha/command.dylan
trunk/libraries/web-framework/object-table.dylan
- copied unchanged from r10535,
trunk/libraries/koala/sources/examples/buddha/object-table.dylan
trunk/libraries/web-framework/users.dylan
- copied, changed from r10535,
trunk/libraries/koala/sources/examples/buddha/users.dylan
trunk/libraries/web-framework/web-macro.dylan
- copied, changed from r10535,
trunk/libraries/koala/sources/examples/buddha/web-macro.dylan
Removed:
trunk/libraries/koala/sources/examples/buddha/change.dylan
trunk/libraries/koala/sources/examples/buddha/changes.dylan
trunk/libraries/koala/sources/examples/buddha/class-browser.dylan
trunk/libraries/koala/sources/examples/buddha/class-editor.dylan
trunk/libraries/koala/sources/examples/buddha/command.dylan
trunk/libraries/koala/sources/examples/buddha/object-table.dylan
trunk/libraries/koala/sources/examples/buddha/users.dylan
trunk/libraries/koala/sources/examples/buddha/web-macro.dylan
Modified:
trunk/libraries/koala/sources/examples/buddha/buddha.dylan
trunk/libraries/koala/sources/examples/buddha/buddha.lid
trunk/libraries/koala/sources/examples/buddha/config.dylan
trunk/libraries/koala/sources/examples/buddha/library.dylan
trunk/libraries/koala/sources/examples/buddha/util.dylan
trunk/libraries/koala/sources/examples/buddha/zone.dylan
Log:
Bug: 7257
*moved code from buddha to web-framework
*doesn't work yet completely
Modified: trunk/libraries/koala/sources/examples/buddha/buddha.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/buddha.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/buddha.dylan Tue Feb 21
01:09:58 2006
@@ -4,15 +4,12 @@
define variable *config* = make(<config>,
config-name: "config");
-//list containing recent changes
-define variable *changes* = #();
-
define variable *version* = 0;
define class <buddha> (<object>)
constant slot config :: <config> = *config*;
constant slot version :: <integer> = *version*;
- constant slot changes = *changes*;
+ constant slot changes = get-all-changes();
constant slot users = *users*;
end;
@@ -73,7 +70,7 @@
let buddha = dood-root(dood);
dood-close(dood);
*config* := buddha.config;
- *changes* := buddha.changes;
+ set-changes(buddha.changes);
*users* := buddha.users;
if (buddha.version > *version*)
*version* := buddha.version + 1;
@@ -113,10 +110,6 @@
end;
end;
-define generic respond-to-get (page,
- request :: <request>,
- response :: <response>,
- #key errors);
define macro page-definer
{ define page ?:name end }
@@ -134,7 +127,7 @@
unless (logged-in(request))
//error
respond-to-get(#"login", request, response,
- errors: list(make(<buddha-form-error>,
+ errors: list(make(<web-error>,
error: "No valid user
supplied\n")));
return();
end;
@@ -265,17 +258,6 @@
end; }
end;
-define class <buddha-form-warning> (<condition>)
- constant slot error-string :: <string>, required-init-keyword: warning:;
-end;
-
-define class <buddha-success> (<buddha-form-warning>)
-end;
-
-define class <buddha-form-error> (<error>)
- constant slot error-string :: <string>, required-init-keyword: error:;
-end;
-
define method respond-to-get (page == #"admin",
request :: <request>,
response :: <response>,
@@ -288,7 +270,7 @@
{ h2("Welcome, stranger"),
ul {
li(concatenate("Database version is ", show(*version*))),
- li(concatenate("There were ", show(*changes*.size), "
changes")),
+ li(concatenate("There were ", show(size(get-all-changes())),
" changes")),
li(concatenate("There are ", show(*users*.size), " users")),
li{ a("User stats", href => "/koala/user-agents") }
},
@@ -323,7 +305,7 @@
end)
end;
else
- errors := add!(errors, make(<buddha-form-error>, error: "Permission
denied"));
+ errors := add!(errors, make(<web-error>, error: "Permission denied"));
respond-to-get (#"network", request, response, errors: errors);
end;
end;
@@ -420,7 +402,7 @@
elseif (action = "redo")
redo(change)
end
- exception (e :: <buddha-form-error>)
+ exception (e :: <web-error>)
errors := add!(errors, e);
return();
end;
@@ -428,7 +410,7 @@
let count = get-query-value("count");
if (count & (count ~= ""))
if (count = "all")
- count := *changes*.size
+ count := size(get-all-changes())
else
count := integer-to-string(count)
end
@@ -439,10 +421,10 @@
collect(show-errors(errors));
collect(with-xml()
div(id => "content") {
- a(concatenate("View all ", integer-to-string(*changes*.size),
" changes"),
+ a(concatenate("View all ",
integer-to-string(size(get-all-changes())), " changes"),
href => "/changes?count=all"),
ul {
- do(for (change in *changes*,
+ do(for (change in get-all-changes(),
i from 0 to count)
block(ret)
collect(with-xml()
@@ -545,7 +527,7 @@
do(for(error in errors)
collect(with-xml()
li(error.error-string,
- class => if(instance?(error,
<buddha-form-warning>))
+ class => if(instance?(error,
<web-form-warning>))
"green"
else
"red"
@@ -1227,6 +1209,7 @@
end;
end;
+/*
define constant $yourname-users = make(<string-table>);
define class <yourname-user> (<object>)
@@ -1246,7 +1229,7 @@
let errs = #();
format-out("ip %= pass %= host %= mac %= user %=\n",
remote-ip, entered-password, hostname, entered-mac-address, user);
-end; /*
+end;
block(ret)
if (user)
if (user.password = entered-password)
@@ -1273,12 +1256,12 @@
redo(command);
let change = make(<change>,
command: command);
- *changes* := add!(*changes*, change);
+ add-change(change);
let slot-names = apply(concatenate, map(method(x)
concatenate(x.slot-name, " to ",
show(x.new-value), " ")
end, changes));
- signal(make(<buddha-success>,
+ signal(make(<web-success>,
warning: concatenate("Saved Host ",
show(user.host),
" changed slots: ",
@@ -1304,23 +1287,23 @@
redo(command);
let change = make(<change>,
command: command);
- *changes* := add!(*changes*, change);
- signal(make(<buddha-success>,
+ add-change(change);
+ signal(make(<web-success>,
warning: concatenate("Added host: ", show(new-host))));
end;
else
//wrong password
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Invalid user/password"));
end;
//post before get
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "POST before GET, go away"));
end;
exception (e :: <condition>)
errs := add!(errs, e);
ret()
- exception (e :: <buddha-form-error>)
+ exception (e :: <web-error>)
errs := add!(errs, e);
ret()
exception (e :: <error>)
Modified: trunk/libraries/koala/sources/examples/buddha/buddha.lid
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/buddha.lid (original)
+++ trunk/libraries/koala/sources/examples/buddha/buddha.lid Tue Feb 21
01:09:58 2006
@@ -2,8 +2,6 @@
executable: buddha
files: library
util
- web-macro
- object-table
config
network
vlan
@@ -14,9 +12,4 @@
zone
mac
cisco-telnet
- class-browser
- command
- change
- class-editor
- users
buddha
Modified: trunk/libraries/koala/sources/examples/buddha/config.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/config.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/config.dylan Tue Feb 21
01:09:58 2006
@@ -1,10 +1,6 @@
module: buddha
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
-define class <reference-object> (<object>)
- slot visible? :: <boolean> = #t, init-keyword: visible?:;
-end;
-
define web-class <config> (<object>)
data config-name :: <string>;
has-many vlan;
@@ -64,14 +60,14 @@
define method check-in-context (tzone :: <zone>, tcname :: <cname>)
=> (res :: <boolean>)
if (any?(method(x) x.source = tcname.source end, tzone.cnames))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Same A record already exists"));
elseif (any?(method(x) x.host-name = tcname.source end, tzone.a-records))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Same A record already exists"));
elseif (any?(method(x) x.host-name = tcname.source end,
choose(method(y) y.zone = tzone end, *config*.hosts)))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Same A record already exists"));
else
#t;
@@ -81,14 +77,14 @@
define method check-in-context (tzone :: <zone>, a-record :: <a-record>)
=> (res :: <boolean>)
if (any?(method(x) x.source = a-record.host-name end, tzone.cnames))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Same A record already exists"));
elseif (any?(method(x) x.host-name = a-record.host-name end,
tzone.a-records))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Same A record already exists"));
elseif (any?(method(x) x.host-name = a-record.host-name end,
choose(method(y) y.zone = tzone end, *config*.hosts)))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Same A record already exists"));
else
#t;
@@ -98,7 +94,7 @@
define method check (zone :: <zone>, #key test-result = 0)
=> (res :: <boolean>)
if (size(choose(method(x) x.zone-name = zone.zone-name end ,
*config*.zones)) > test-result)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Zone with same name already exists"));
else
if (zone.reverse?)
@@ -112,32 +108,32 @@
=> (res :: <boolean>)
if (size(choose(method(x) x.host-name = host.host-name end,
choose(method(x) x.zone = host.zone end, *config*.hosts))) >
test-result)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Host with same name already exists in zone"));
elseif (size(choose(method(x) x.host-name = host.host-name end,
host.zone.a-records)) > 0)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "A record for host already exists in zone"));
elseif (size(choose(method(x) x.target = host.host-name end,
host.zone.cnames)) > 0)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "A record already exists in zone"));
elseif (size(choose(method(x) x.ipv4-address = host.ipv4-address end,
choose(method(x) x.subnet = host.subnet end,
*config*.hosts))) > test-result)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Host with same IP address already exists in subnet"));
elseif (host.subnet.dhcp?
& size(choose(method(x) x.mac-address = host.mac-address end,
choose(method(x) x.subnet = host.subnet end,
*config*.hosts))) > test-result)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Host with same MAC address already exists in subnet"));
elseif ((host.ipv4-address = network-address(host.subnet.cidr)) |
(host.ipv4-address = broadcast-address(host.subnet.cidr)))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Host can't have the network or broadcast address as
IP"));
elseif (~ ip-in-net?(host.subnet, host.ipv4-address))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Host is not in specified network"))
else
#t;
@@ -147,13 +143,13 @@
define method check (vlan :: <vlan>, #key test-result = 0)
=> (res :: <boolean>)
if ((vlan.number < 0) | (vlan.number > 4095))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "VLAN not in range 0 - 4095"));
elseif (size(choose(method(x) x.number = vlan.number end , *config*.vlans))
> test-result)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "VLAN with same number already exists"));
elseif (size(choose(method(x) x.vlan-name = vlan.vlan-name end,
*config*.vlans)) > test-result)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "VLAN with same name already exists"));
else
#t;
@@ -163,7 +159,7 @@
define method check (network :: <network>, #key test-result = 0)
=> (res :: <boolean>)
unless (network-address(network.cidr) = base-network-address(network.cidr))
- signal(make(<buddha-form-warning>,
+ signal(make(<web-form-warning>,
warning: "Network address is not the base network address,
fixing this!"));
network.cidr.cidr-network-address := base-network-address(network.cidr);
end;
@@ -174,7 +170,7 @@
end;
#t;
else
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Network overlaps with another network"));
end if;
end;
@@ -182,32 +178,32 @@
define method check (subnet :: <subnet>, #key test-result = 0)
=> (res :: <boolean>)
unless (network-address(subnet.cidr) = base-network-address(subnet.cidr))
- signal(make(<buddha-form-warning>,
+ signal(make(<web-form-warning>,
warning: "Network address is not the base network address,
fixing this!"));
subnet.cidr.cidr-network-address := base-network-address(subnet.cidr);
end;
if (every?(method(x) x = subnet end, overlaps(subnet)))
if (subnet-in-network?(subnet))
if (subnet.dhcp-start > subnet.dhcp-end)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP start greater than DHCP end"));
elseif (subnet.dhcp-start = broadcast-address(subnet.cidr))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP start can't be broadcast address"))
elseif (subnet.dhcp-start = network-address(subnet.cidr))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP start can't be network address"))
elseif (subnet.dhcp-end = broadcast-address(subnet.cidr))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP end can't be broadcast address"))
elseif (subnet.dhcp-end = network-address(subnet.cidr))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP end can't be network address"))
elseif (subnet.dhcp-router = broadcast-address(subnet.cidr))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP router can't be broadcast address"))
elseif (subnet.dhcp-router = network-address(subnet.cidr))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP router can't be network address"))
end;
if (ip-in-net?(subnet, subnet.dhcp-start))
@@ -215,29 +211,29 @@
if (ip-in-net?(subnet, subnet.dhcp-router))
if ((subnet.dhcp-router > subnet.dhcp-start)
& (subnet.dhcp-router < subnet.dhcp-end))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Router has to be outside of dhcp-range"));
else
#t;
end if;
else
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP router not in subnet"));
end
else
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP end not in subnet"));
end
else
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "DHCP start not in subnet"));
end
else
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Subnet not in a defined network"));
end
else
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "Subnet overlaps with another subnet"));
end if;
end;
Modified: trunk/libraries/koala/sources/examples/buddha/library.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/library.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/library.dylan Tue Feb 21
01:09:58 2006
@@ -13,48 +13,10 @@
use xml-rpc-common;
use xml-parser;
use dylan;
+ use web-framework;
export buddha;
end;
-define module web-macro
- use common-dylan;
-
- export <slot>,
- slot-name,
- slot-type,
- slot-getter-method,
- slot-setter-method,
- slot-global-list,
- default,
- default-function,
- default-help-text;
-
- export list-reference-slots,
- reference-slots,
- data-slots;
-
- export \web-class-definer;
-end;
-
-
-/*
-define module changes
- use common-dylan;
- use xml;
-
- export <entry>;
-end;
-*/
-
-define module object-table
- use common-dylan;
- use dylan-extensions, import: { address-of,
- <string-table> };
-
- export get-reference,
- get-object;
-end;
-
define module utils
use common-dylan;
use dylan-extensions, import: { debug-name };
@@ -66,37 +28,6 @@
data;
end;
-/*
-define module class-editor
- use common-dylan;
- use xml;
- use web-macro;
- use object-table;
- use utils;
- export edit-form,
- remove-form,
- add-form,
- check;
-end;
-*/
-
-define module class-browser
- use common-dylan;
- use simple-xml;
- use web-macro;
- use object-table;
- use format-out;
- use utils;
-// use class-editor;
- export browse-list,
- browse-table,
- remove-form, //this shouldn't be here
- show,
- browse,
- to-table-header,
- to-table;
-end;
-
define module buddha
use regular-expressions;
use common-dylan;
@@ -121,9 +52,7 @@
use xml-rpc-common, import: { base64-encode, base64-decode };
use simple-xml;
- use web-macro;
+ use web-framework;
use object-table;
- use class-browser;
-// use class-editor;
use utils;
end;
Modified: trunk/libraries/koala/sources/examples/buddha/util.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/util.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/util.dylan Tue Feb 21
01:09:58 2006
@@ -29,12 +29,6 @@
res;
end;
-define method get-url-from-type (type) => (string :: <string>)
- copy-sequence(type.debug-name,
- start: 1,
- end: type.debug-name.size - 1)
-end;
-
define class <wrapper-sequence> (<sequence>)
slot data :: <sequence>, init-keyword: data:;
end;
@@ -95,3 +89,10 @@
//<byte-vector>
type-for-copy(seq.data);
end;
+
+define method get-url-from-type (type) => (string :: <string>)
+ copy-sequence(type.debug-name,
+ start: 1,
+ end: type.debug-name.size - 1)
+end;
+
Modified: trunk/libraries/koala/sources/examples/buddha/zone.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/zone.dylan (original)
+++ trunk/libraries/koala/sources/examples/buddha/zone.dylan Tue Feb 21
01:09:58 2006
@@ -278,12 +278,12 @@
arguments: list(zone, *config*.zones));
let change = make(<change>,
command: command);
- *changes* := add!(*changes*, change);
+ add-change(change);
redo(command);
- signal(make(<buddha-success>,
+ signal(make(<web-success>,
warning: concatenate("Added zone: ", show(zone))));
- exception (e :: <buddha-form-error>)
- signal(make(<buddha-form-warning>,
+ exception (e :: <web-error>)
+ signal(make(<web-form-warning>,
warning: concatenate("Couldn't add reverse zone, error was:
", e.error-string)));
ret();
end;
Added: trunk/libraries/registry/generic/web-framework
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/web-framework Tue Feb 21 01:09:58 2006
@@ -0,0 +1 @@
+abstract://dylan/web-framework/web-framework.lid
Copied: trunk/libraries/web-framework/change.dylan (from r10535,
trunk/libraries/koala/sources/examples/buddha/change.dylan)
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/change.dylan (original)
+++ trunk/libraries/web-framework/change.dylan Tue Feb 21 01:09:58 2006
@@ -1,6 +1,20 @@
-module: buddha
+module: web-framework
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
+define variable *changes* = #();
+
+define method get-all-changes () => (changes :: <list>)
+ *changes*;
+end;
+
+define method set-changes (changes :: <list>) => ()
+ *changes* := changes;
+end;
+
+define method add-change (change :: <change>) => ()
+ *changes* := add!(*changes*, change);
+end;
+
define class <change> (<object>)
slot author :: <string>;
slot date :: <date>;
@@ -10,63 +24,18 @@
define method initialize (change :: <change>, #rest rest, #key, #all-keys)
next-method();
change.date := current-date();
- change.author := *user*.username;
+ change.author := current-user().username;
end;
define method undo (change :: <change>)
- //rollback to change
- /* let redo-start =
- block(return)
- for (ele in *changes*,
- i from 0)
- if (change = ele)
- return(i - 1);
- else
- undo(ele.command)
- end;
- end;
- end; */
//undo the change
undo(change.command);
- //redo all other changes
- /* for (i from redo-start to 0 by -1)
- let ele = *changes*[i];
- redo(ele.command);
- end; */
//on success, make a new <change> object, add it to *changes*
let change = make(<change>,
command: reverse-command(change.command));
*changes* := add!(*changes*, change);
end;
-/*
-define method redo (change :: <change>)
- //rollback to change
- let redo-start =
- block(return)
- for (ele in *changes*,
- i from 0)
- if (change = ele)
- return(i - 1);
- else
- undo(ele.command)
- end;
- end;
- end;
- //redo the change
- redo(change.command);
- //redo all other changes
- for (i from redo-start to 0 by -1)
- let ele = *changes*[i];
- redo(ele.command);
- end;
- //on success, make a new <change> object, add it to *changes*
- let change = make(<change>,
- command: change.command);
- *changes* := add!(*changes*, change);
-end;
-*/
-
define method print-xml (date :: <date>)
let $month-names
= #["Jan", "Feb", "Mar", "Apr", "May", "Jun",
Copied: trunk/libraries/web-framework/class-browser.dylan (from r10535,
trunk/libraries/koala/sources/examples/buddha/class-browser.dylan)
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/class-browser.dylan
(original)
+++ trunk/libraries/web-framework/class-browser.dylan Tue Feb 21 01:09:58 2006
@@ -1,4 +1,4 @@
-module: class-browser
+module: web-framework
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
define method browse (object-type :: subclass(<object>),
@@ -143,31 +143,4 @@
as(<string>, object)
end;
-define method remove-form (object :: <object>, parent :: <object>,
- #key url :: <string> = "edit",
- xml)
- with-xml()
- form(action => "/edit", \method => "post")
- { div(class => "edit")
- {
- input(type => "hidden",
- name => "refer-to",
- value => url),
- input(type => "hidden",
- name => "parent-object",
- value => get-reference(parent)),
- input(type => "hidden",
- name => "remove-this",
- value => get-reference(object)),
- input(type => "hidden",
- name => "action",
- value => "remove-object"),
- do(if(xml) xml end),
- input(type => "submit",
- name => "remove-button",
- value => "Remove")
- }
- }
- end;
-end;
Copied: trunk/libraries/web-framework/class-editor.dylan (from r10535,
trunk/libraries/koala/sources/examples/buddha/class-editor.dylan)
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/class-editor.dylan
(original)
+++ trunk/libraries/web-framework/class-editor.dylan Tue Feb 21 01:09:58 2006
@@ -1,7 +1,29 @@
-module: buddha
+module: web-framework
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
-define method check (object :: <object>, #key test-result = 0) => (res ::
<boolean>)
+define class <web-form-warning> (<condition>)
+ constant slot error-string :: <string>, required-init-keyword: warning:;
+end;
+
+define class <web-success> (<web-form-warning>)
+end;
+
+define class <web-error> (<error>)
+ constant slot error-string :: <string>, required-init-keyword: error:;
+end;
+
+define open generic respond-to-get
+ (page, request :: <request>, response :: <response>, #key errors);
+
+define open generic respond-to-post
+ (page, request :: <request>, response :: <response>);
+
+define open generic check (object :: <object>, #key test-result)
+ => (res :: <boolean>);
+
+
+define method check (object :: <object>, #key test-result = 0)
+ => (res :: <boolean>)
#t;
end;
@@ -50,7 +72,11 @@
value => "save-object"),
input(type => "hidden",
name => "refer-to",
- value => if (refer) refer else
get-url-from-type(object.object-class) end),
+ value => if (refer)
+ refer
+ else
+ get-url-from-type(object.object-class)
+ end),
do(if(xml) xml end),
input(type => "submit",
name => "save-button",
@@ -183,6 +209,33 @@
end;
end;
+define method remove-form (object :: <object>, parent :: <object>,
+ #key url :: <string> = "edit",
+ xml)
+ with-xml()
+ form(action => "/edit", \method => "post")
+ { div(class => "edit")
+ {
+ input(type => "hidden",
+ name => "refer-to",
+ value => url),
+ input(type => "hidden",
+ name => "parent-object",
+ value => get-reference(parent)),
+ input(type => "hidden",
+ name => "remove-this",
+ value => get-reference(object)),
+ input(type => "hidden",
+ name => "action",
+ value => "remove-object"),
+ do(if(xml) xml end),
+ input(type => "submit",
+ name => "remove-button",
+ value => "Remove")
+ }
+ }
+ end;
+end;
define method list-forms (obj :: <object>) => (res)
let res = make(<stretchy-vector>);
@@ -258,29 +311,29 @@
let action = as(<symbol>, get-query-value("action"));
let object-string = get-query-value("parent-object");
let object = get-object(object-string);
- let handler <buddha-form-warning>
- = method(e :: <buddha-form-warning>, next-handler :: <function>)
+ let handler <web-form-warning>
+ = method(e :: <web-form-warning>, next-handler :: <function>)
errors := add!(errors, e)
end;
block(return)
//add, save, remove... we may not need this here...
unless (object)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: concatenate("Unknown object: ", object-string)));
end;
select (action)
#"add-object" => add-object(object, request);
#"remove-object" => remove-object(object, request);
#"save-object" => save-object(object, request);
- otherwise => signal(make(<buddha-form-error>,
+ otherwise => signal(make(<web-error>,
error: concatenate("Unknown action: ",
as(<string>, action))));
end select;
- exception (e :: <buddha-form-error>)
+ exception (e :: <web-error>)
errors := add!(errors, e);
return();
exception (e :: <error>)
- errors := add!(errors, make(<buddha-form-error>,
+ errors := add!(errors, make(<web-error>,
error: format-to-string("%=", e)));
return();
end;
@@ -289,7 +342,7 @@
block(return)
unless ((elements.size = 2) & elements[1] = "detail")
if ((action = #"add-object")
- & (any?(rcurry(instance?, <buddha-form-error>), errors)))
+ & (any?(rcurry(instance?, <web-error>), errors)))
respond-to-get(#"add", request, response, errors: errors);
return();
end;
@@ -321,7 +374,7 @@
unless ((slot.slot-type = <boolean>) | value)
value := slot.default-function(object);
unless (value)
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: concatenate("Please specify ",
slot.slot-name,
" correctly!")));
@@ -340,7 +393,7 @@
let change = make(<change>,
command: command);
*changes* := add!(*changes*, change);
- signal(make(<buddha-success>,
+ signal(make(<web-success>,
warning: concatenate("Added ",
get-url-from-type(object-type),
": ", show(object))));
@@ -357,7 +410,7 @@
command: command);
*changes* := add!(*changes*, change);
redo(command);
- signal(make(<buddha-success>,
+ signal(make(<web-success>,
warning: concatenate("Removed ",
get-url-from-type(object.object-class),
": ", show(object))));
@@ -429,11 +482,12 @@
let change = make(<change>,
command: command);
*changes* := add!(*changes*, change);
- let slot-names = apply(concatenate, map(method(x)
- concatenate(x.slot-name, " to
",
- show(x.new-value),
" ")
- end, slots));
- signal(make(<buddha-success>,
+ let slot-names = apply(concatenate,
+ map(method(x)
+ concatenate(x.slot-name, " to ",
+ show(x.new-value), " ")
+ end, slots));
+ signal(make(<web-success>,
warning: concatenate("Saved \"",
get-url-from-type(object.object-class),
"\", ",
@@ -442,3 +496,10 @@
slot-names)));
end;
end;
+
+define method get-url-from-type (type) => (string :: <string>)
+ copy-sequence(type.debug-name,
+ start: 1,
+ end: type.debug-name.size - 1)
+end;
+
Copied: trunk/libraries/web-framework/command.dylan (from r10535,
trunk/libraries/koala/sources/examples/buddha/command.dylan)
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/command.dylan (original)
+++ trunk/libraries/web-framework/command.dylan Tue Feb 21 01:09:58 2006
@@ -1,4 +1,4 @@
-module: buddha
+module: web-framework
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
define abstract class <command> (<object>)
@@ -133,8 +133,8 @@
map(method(x)
set-slot(x.slot-name, object, x.new-value)
end, slots);
- let handler <buddha-form-error>
- = method(e :: <buddha-form-error>, next-handler :: <function>)
+ let handler <web-error>
+ = method(e :: <web-error>, next-handler :: <function>)
unset-slots(object, slots);
next-handler();
end;
@@ -146,8 +146,8 @@
map(method(x)
set-slot(x.slot-name, object, x.old-value)
end, slots);
- let handler <buddha-form-error>
- = method(e :: <buddha-form-error>, next-handler :: <function>)
+ let handler <web-error>
+ = method(e :: <web-error>, next-handler :: <function>)
set-slots(object, slots);
next-handler();
end;
Copied: trunk/libraries/web-framework/users.dylan (from r10535,
trunk/libraries/koala/sources/examples/buddha/users.dylan)
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/users.dylan (original)
+++ trunk/libraries/web-framework/users.dylan Tue Feb 21 01:09:58 2006
@@ -1,4 +1,4 @@
-module: buddha
+module: web-framework
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
define variable *users* = make(<string-table>);
@@ -16,13 +16,20 @@
concatenate(user.username, " ", user.email);
end;
-define method key (user :: <user>)
+define thread variable *user* = #f;
+
+define method current-user () => (user :: false-or(<user>))
+ *user*
+end;
+
+define inline-only method key (user :: <user>)
user.username;
end;
define method check (user :: <user>, #key test-result = 0)
+ => (res :: <boolean>)
if (element(*users*, key(user), default: #f))
- signal(make(<buddha-form-error>,
+ signal(make(<web-error>,
error: "User with same name already exists!"))
else
#t;
@@ -44,6 +51,7 @@
if (username & password)
if (valid-user?(username, password))
let session = ensure-session(request);
+ *user* := *users*[username];
set-attribute(session, #"username", username);
end;
end;
@@ -52,6 +60,10 @@
define method logged-in (request :: <request>)
=> (username :: false-or(<string>))
let session = get-session(request);
- session & get-attribute(session, #"username");
+ if (session)
+ let username = get-attribute(session, #"username");
+ *user* := *users*[username];
+ username;
+ end;
end;
Copied: trunk/libraries/web-framework/web-macro.dylan (from r10535,
trunk/libraries/koala/sources/examples/buddha/web-macro.dylan)
==============================================================================
--- trunk/libraries/koala/sources/examples/buddha/web-macro.dylan
(original)
+++ trunk/libraries/web-framework/web-macro.dylan Tue Feb 21 01:09:58 2006
@@ -1,6 +1,10 @@
-module: web-macro
+module: web-framework
author: Hannes Mehnert <hannes@xxxxxxxxxxx>
+define open class <reference-object> (<object>)
+ slot visible? :: <boolean> = #t, init-keyword: visible?:;
+end;
+
define class <slot> (<object>)
constant slot slot-name :: <string>, init-keyword: name:;
constant slot slot-type :: <object>, init-keyword: type:;
@@ -14,15 +18,15 @@
init-keyword: default-help-text:;
end;
-define generic list-reference-slots
+define open generic list-reference-slots
(object :: subclass(<object>), #next next-method)
=> (res :: <list>);
-define generic reference-slots
+define open generic reference-slots
(object :: subclass(<object>), #next next-method)
=> (res :: <list>);
-define generic data-slots
+define open generic data-slots
(object :: subclass(<object>), #next next-method)
=> (res :: <list>);
--
Gd-chatter mailing list
Gd-chatter@xxxxxxxxxxxxxxxx
https://www.gwydiondylan.org/mailman/listinfo/gd-chatter
|
