[Gd-chatter] r11708 - in trunk/libraries: network/koala/sources/koala uri
cgay at gwydiondylan.org
cgay at gwydiondylan.org
Mon Feb 25 13:06:55 CET 2008
Author: cgay
Date: Mon Feb 25 13:06:53 2008
New Revision: 11708
Modified:
trunk/libraries/network/koala/sources/koala/config.dylan
trunk/libraries/network/koala/sources/koala/dsp.dylan
trunk/libraries/network/koala/sources/koala/responders.dylan
trunk/libraries/network/koala/sources/koala/server.dylan
trunk/libraries/network/koala/sources/koala/xml-rpc-server.dylan
trunk/libraries/uri/library.dylan
trunk/libraries/uri/uri.dylan
Log:
job: koala
Fixed callers of register-url and other compiler warnings.
Modified: trunk/libraries/network/koala/sources/koala/config.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/config.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/config.dylan Mon Feb 25 13:06:53 2008
@@ -299,7 +299,7 @@
vhost.dsp-root := merge-locators(as(<directory-locator>, loc),
*server-root*);
log-info("VHost '%s': DSP root = %s.",
- vhost-name(vhost), document-root(vhost));
+ vhost-name(vhost), dsp-root(vhost));
else
warn("Invalid <DSP-ROOT> spec. "
"The 'location' attribute must be specified.");
Modified: trunk/libraries/network/koala/sources/koala/dsp.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/dsp.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/dsp.dylan Mon Feb 25 13:06:53 2008
@@ -87,10 +87,10 @@
end process-page;
define open generic respond-to
- (request-method :: <symbol>, page :: <page>);
+ (request-method :: <symbol>, page :: <page>);
define method respond-to
- (request-method :: <symbol>, page :: <page>)
+ (request-method :: <symbol>, page :: <page>)
if (member?(request-method, #(#"get", #"post")))
process-template(page);
else
@@ -100,10 +100,10 @@
// Applications should call this to register a page for a particular URL.
define function register-page
- (url :: <string>, page :: <page>, #key replace?, prefix?)
+ (url :: <string>, page :: <page>, #key replace?)
=> (responder :: <function>)
bind (responder = curry(process-page, page))
- register-url(url, responder, replace?: replace?, prefix?: prefix?);
+ add-responder(url, responder, replace?: replace?);
*page-to-url-map*[page] := url;
responder
end
@@ -693,14 +693,14 @@
end;
define function register-page-urls
- (page :: <page>, #key url :: <string>, alias, prefix?, #all-keys)
+ (page :: <page>, #key url :: <string>, alias, #all-keys)
=> (responder :: <function>)
- let responder = register-page(url, page, prefix?: prefix?);
+ let responder = register-page(url, page);
when (alias)
for (alias in iff(instance?(alias, <string>),
list(alias),
alias))
- register-url(alias, responder);
+ add-responder(alias, responder);
end;
end;
responder
Modified: trunk/libraries/network/koala/sources/koala/responders.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/responders.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/responders.dylan Mon Feb 25 13:06:53 2008
@@ -8,24 +8,28 @@
define class <responder> (<object>)
- slot responder-map :: <table> = make(<table>),
+ // responder-map is a map from request method (e.g. #"POST") to another table
+ // mapping regex -> list of functions. When the regex matches the tail of the
+ // url (i.e., the part following the base url on which this responder was
+ // registered) the functions are called in order. They should raise an exception
+ // (of what type?) to abort the chain.
+ constant slot responder-map :: <table> = make(<table>),
init-keyword: map:;
end;
define open generic add-responder
- (url :: <object>, responder :: <responder>, #key replace?)
- => ();
+ (url :: <object>, responder :: <object>, #key replace?);
+// Convenience method to convert first arg to <url>.
+//
define method add-responder
- (url :: <string>, responder :: <responder>, #key replace?)
- => ()
+ (url :: <string>, responder :: <object>, #key replace?)
add-responder(parse-url(url), responder, replace?: replace?);
end;
define method add-responder
(url :: <url>, responder :: <responder>, #key replace?)
- => ()
- local method responder-registration ()
+ local method register-responder ()
if (empty?(url.uri-path))
error(make(<koala-api-error>,
format-string: "You can't add a responder with an empty URL: %s",
@@ -36,28 +40,63 @@
end if;
end;
if (*server-running?*)
- responder-registration();
+ register-responder();
else
- register-init-function(responder-registration);
+ register-init-function(register-responder);
+ end;
+end method add-responder;
+
+// The simple case where you just want an exact URL to map to a function.
+// This takes care of the messy details of building a <responder> object.
+//
+define method add-responder
+ (url :: <url>, response-function :: <function>,
+ #key replace?,
+ request-methods = #(#"get", #"put"))
+ let table = make(<table>, size: 1);
+ table[compile-regex("^$")] := response-function;
+ add-responder(url, table,
+ replace?: replace?,
+ request-methods: request-methods)
+end method add-responder;
+
+// Use this if you want a prefix URL and different behaviour depending on
+// which regex matches the URL tail.
+//
+define method add-responder
+ (url :: <url>, regex-map :: <table>,
+ #key replace?,
+ request-methods = #(#"get", #"put"))
+ for (response keyed-by regex in regex-map)
+ assert(instance?(response, <function>) & instance?(regex, <regex>),
+ "The regex-map argument to add-responder must be a table "
+ "mapping <regex> to <function>. Found %= -> %=.",
+ regex, response);
+ end;
+ let responder = make(<responder>);
+ for (request-method in request-methods)
+ //todo -- validate-request-method(request-method)
+ responder.responder-map[request-method] := regex-map;
end;
+ add-responder(url, responder, replace?: replace?)
end method add-responder;
define open generic find-responder
(url :: <object>)
=> (responder :: false-or(<responder>),
- rest-path :: false-or(<sequence>));
+ rest-path :: false-or(<sequence>));
define method find-responder
(url :: <string>)
=> (responder :: false-or(<responder>),
- rest-path :: false-or(<sequence>))
+ rest-path :: false-or(<sequence>))
find-responder(parse-url(url))
end method find-responder;
define method find-responder
(url :: <url>)
=> (responder :: false-or(<responder>),
- rest-path :: false-or(<sequence>))
+ rest-path :: false-or(<sequence>))
find-object(*server*.url-map, url.uri-path);
end method find-responder;
@@ -73,6 +112,13 @@
end;
+/* Example usage
+define url-map
+ url "/wiki",
+ action GET () => show-page,
+ action GET () => show-page;
+end;
+*/
define macro url-map-definer
{ define url-map
?urls
@@ -111,7 +157,7 @@
definition:
{ action ( ?request-methods ) ( ?regex ) => ?action:name }
=> { begin
- let regex = compile-regex(?regex);
+ let regex = compile-regex(?regex, use-cache: #t);
let actions = list(?action);
?request-methods
end }
@@ -140,16 +186,7 @@
request-method:
{ ?:name }
- => { begin
- let map = element(responder.responder-map,
- ?#"name",
- default: #f);
- unless (map)
- map := make(<table>);
- responder.responder-map[?#"name"] := map;
- end unless;
- map[regex] := actions
- end }
+ => { add-responder-map-entry(responder, ?#"name", regex, actions) }
regex:
{ } => { "^$" }
@@ -158,6 +195,29 @@
end macro url-map-definer;
+define inline function add-responder-map-entry
+ (responder :: <responder>,
+ request-method :: <symbol>,
+ regex :: <regex>,
+ actions :: <sequence>)
+ let table = element(responder.responder-map, request-method, default: #f);
+ if (~table)
+ table := make(<table>);
+ responder.responder-map[request-method] := table;
+ end;
+ // The following depends on regex caching working, so they're ==.
+ // todo -- Add the url to the error message. It's not accessible
+ // here at the moment.
+ if (element(table, regex, default: #f))
+ signal(make(<koala-api-error>,
+ format-string: "Duplicate regular expression (%s) "
+ "in url map for %s",
+ format-arguments: list(regex, request-method)));
+ end;
+ table[regex] := actions
+end function add-responder-map-entry;
+
+
// define responder test ("/test" /* , secure?: #t */ )
// format(output-stream(response), "<html><body>test</body></html>");
// end;
@@ -167,17 +227,9 @@
end
}
=> { define method ?name () ?body end;
- register-url(?url, ?name)
+ add-responder(?url, ?name)
}
-
- { define directory responder ?:name (?url:expression)
- ?:body
- end
- }
- => { define method ?name () ?body end;
- register-url(?url, ?name, prefix?: #t)
- }
-end;
+end macro responder-definer;
/*
define (get, post) responder foo-responder ("/foo", "/bar")
Modified: trunk/libraries/network/koala/sources/koala/server.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/server.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/server.dylan Mon Feb 25 13:06:53 2008
@@ -850,26 +850,6 @@
end;
end;
-/* REMOVE
-
-// Register a function that will attempt to register a responder for a URL
-// if the URL matches the file extension. The function should normally call
-// register-url (or register-page for DSPs) and should return a responder.
-//
-define function register-auto-responder
- (file-extension :: <string>, f :: <function>, #key replace? :: <boolean>)
- if (~replace? & element(*auto-register-map*, file-extension, default: #f))
- cerror("Replace the old auto-responder with the new one and continue.",
- "An auto-responder is already defined for file extension %=.",
- file-extension);
- end;
- *auto-register-map*[file-extension] := f;
-end;
-
-*/
-
-
-
// Invoke the appropriate handler for the given request URL and method.
// Have to buffer up the entire response since the web app needs a chance to
// set headers, etc. And if the web app signals an error we need to catch it
@@ -886,35 +866,28 @@
if (request.request-responder)
let url = request.request-url;
log-debug("Responder found for %s", url);
- let map = request.request-responder.responder-map;
- let responders = element(map, request.request-method, default: #f);
- // find the appropriate action sequence
- let (action-sequence, match) = if (responders)
- block (return)
- for (action-sequence keyed-by regex in responders)
- let tail = build-path(request.request-tail-url);
- log-debug("? %= <=> %=", regex.regex-pattern, tail);
- let match = regex-search(regex, tail);
- if (match)
- return(action-sequence, match)
- end if;
- end for;
- end block;
- end if;
- log-debug("Action sequence: %=", action-sequence);
+ let (actions, match) = find-actions(request);
+ log-debug("Action sequence: %=", actions);
log-debug("Responder match: %=", match);
- if (action-sequence)
- //
- let arguments = make(<stretchy-vector>);
- for (group keyed-by name in match.groups-by-name)
- if (group)
- add!(arguments, as(<symbol>, name));
- add!(arguments, group.group-text);
- end if;
- end for;
+ if (actions)
+ // Invoke each action function with keyword arguments matching the names
+ // of the named groups in the first regular expression that matches the
+ // tail of the url, if any.
+ let arguments = #[];
+ if (match)
+ arguments := make(<simple-object-vector>,
+ size: 2 * match.groups-by-name.size);
+ for (group keyed-by name in match.groups-by-name)
+ if (group)
+ add!(arguments, as(<symbol>, name));
+ add!(arguments, group.group-text);
+ end if;
+ end for;
+ end if;
do(method (action)
invoke-action(request, action, arguments);
- end, action-sequence);
+ end,
+ actions);
else
resource-not-found-error(url: url);
end if;
@@ -927,6 +900,24 @@
send-response(response);
end method invoke-handler;
+define inline function find-actions
+ (request :: <request>)
+ => (actions, match :: false-or(<regex-match>))
+ let rmap = request.request-responder.responder-map;
+ let responders = element(rmap, request.request-method, default: #f);
+ if (responders)
+ block (return)
+ let url-tail = build-path(request.request-tail-url);
+ for (actions keyed-by regex in responders)
+ log-debug("? %= <=> %=", regex.regex-pattern, url-tail);
+ let match = regex-search(regex, url-tail);
+ if (match)
+ return(actions, match)
+ end if;
+ end for;
+ end block;
+ end if;
+end function find-actions;
define generic invoke-action
(request :: <request>,
@@ -1005,11 +996,11 @@
end;
define class <http-file> (<object>)
- slot http-file-filename :: <string>,
+ constant slot http-file-filename :: <string>,
required-init-keyword: filename:;
- slot http-file-content :: <byte-string>,
+ constant slot http-file-content :: <byte-string>,
required-init-keyword: content:;
- slot http-file-mime-type :: <string>,
+ constant slot http-file-mime-type :: <string>,
required-init-keyword: mime-type:;
end;
Modified: trunk/libraries/network/koala/sources/koala/xml-rpc-server.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/xml-rpc-server.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/xml-rpc-server.dylan Mon Feb 25 13:06:53 2008
@@ -131,8 +131,7 @@
define function init-xml-rpc-server
() => ()
when (*xml-rpc-enabled?*)
- register-url(*xml-rpc-server-url*, respond-to-xml-rpc-request);
-
+ add-responder(*xml-rpc-server-url*, respond-to-xml-rpc-request);
// Provide a basic way to test the server.
register-xml-rpc-method("ping", method () #t end, replace?: #t);
register-xml-rpc-method("echo", method (#rest args) args end, replace?: #t);
Modified: trunk/libraries/uri/library.dylan
==============================================================================
--- trunk/libraries/uri/library.dylan (original)
+++ trunk/libraries/uri/library.dylan Mon Feb 25 13:06:53 2008
@@ -10,7 +10,8 @@
define module uri
use common-dylan;
- use common-extensions;
+ use common-extensions,
+ exclude: { format-to-string };
use vector-search;
use subseq;
use format;
@@ -25,7 +26,7 @@
uri-path, uri-path-setter,
uri-query, uri-query-setter,
uri-fragment, uri-fragment-setter,
- uri-authority, uri-authority-setter;
+ uri-authority /* not defined --cgay uri-authority-setter */;
export parse-uri, parse-url,
build-uri, transform-uris,
build-path, build-query;
Modified: trunk/libraries/uri/uri.dylan
==============================================================================
--- trunk/libraries/uri/uri.dylan (original)
+++ trunk/libraries/uri/uri.dylan Mon Feb 25 13:06:53 2008
@@ -11,9 +11,10 @@
init-keyword: host:;
slot uri-port :: false-or(<integer>) = #f,
init-keyword: port:;
- slot uri-path :: <deque> = make(<deque>),
+ // Do you really want this to be a mutable type?
+ slot uri-path :: <sequence> = make(<deque>),
init-keyword: path:;
- // keys without vaule are #t
+ // keys without values are #t
slot uri-query :: <string-table> = make(<string-table>),
init-keyword: query:;
slot uri-fragment :: <string> = "",
@@ -166,11 +167,17 @@
define open generic build-path (path :: <object>, #key) => (encoded-path :: <string>);
-define method build-path (uri :: <uri>, #key include :: <sequence> = #()) => (encoded-path :: <string>);
- if (empty?(uri.uri-path)) "" else
- apply(join, "/", map(method (segment)
- percent-encode(#"segment", segment, include: include)
- end, uri.uri-path));
+define method build-path
+ (uri :: <uri>, #key include :: <sequence> = #())
+ => (encoded-path :: <string>)
+ if (empty?(uri.uri-path))
+ ""
+ else
+ join(map(method (segment)
+ percent-encode(#"segment", segment, include: include)
+ end,
+ uri.uri-path),
+ "/")
end if;
end;
@@ -189,7 +196,7 @@
concatenate(key, "=", percent-encode(#"query", value, include: include));
end if);
end for;
- apply(join, "&", parts);
+ join(parts, "&")
end if;
end;
@@ -250,7 +257,7 @@
define method remove-dot-segments (path :: <string>) => (result :: <string>);
let path = split(path, "/", remove-empty-items: #f);
path := remove-dot-segments(path);
- apply(join, "/", path);
+ join(path, "/")
end;
define method remove-dot-segments (path :: <sequence>) => (result :: <sequence>);
More information about the chatter
mailing list