[Gd-chatter] r11058 - in trunk/libraries: network/koala/sources/koala network/web-framework xml-parser
turbo24prg at gwydiondylan.org
turbo24prg at gwydiondylan.org
Mon Dec 11 22:58:43 CET 2006
Author: turbo24prg
Date: Mon Dec 11 22:58:41 2006
New Revision: 11058
Modified:
trunk/libraries/network/koala/sources/koala/library-unix.dylan
trunk/libraries/network/koala/sources/koala/library.dylan
trunk/libraries/network/koala/sources/koala/server.dylan
trunk/libraries/network/web-framework/changes.dylan
trunk/libraries/network/web-framework/users.dylan
trunk/libraries/network/web-framework/web-macro.dylan
trunk/libraries/xml-parser/simple-xml.dylan
Log:
Job: minor
* some improvements for feeds
* tried to fix with-xml()
* some more exports in koala
Modified: trunk/libraries/network/koala/sources/koala/library-unix.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library-unix.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/library-unix.dylan Mon Dec 11 22:58:41 2006
@@ -154,8 +154,12 @@
register-url,
<request>,
*request*, // Holds the active request, per thread.
+ current-request, // Returns the active request of the thread.
+ current-response, // Returns the active response of the thread.
+ request-query-string,
request-query-values, // get the keys/vals from the current GET or POST request
request-method, // Returns #"get", #"post", etc
+ request-host,
responder-definer,
// Form/query values. (Is there a good name that covers both of these?)
@@ -166,12 +170,14 @@
count-query-values,
count-form-values,
application-error,
- decode-url;
+ decode-url,
+ encode-url;
// Virtual hosts
create
<virtual-host>, *virtual-host*,
- document-root, locator-below-document-root?;
+ document-root, vhost-name,
+ locator-below-document-root?;
// Responses
create
@@ -260,6 +266,10 @@
create
print-object;
+ // files
+ create
+ static-file-responder;
+
end module koala;
// Additional interface for extending the server
@@ -356,6 +366,9 @@
respond-to-post, // Implement this for your page to handle POST requests
respond-to-head, // Implement this for your page to handle HEAD requests
+ page-source,
+ page-source-setter,
+
<dylan-server-page>, // Subclass this using the "define page" macro
page-definer, // Defines a new page class
process-template, // Call this (or next-method()) from respond-to-get/post if
Modified: trunk/libraries/network/koala/sources/koala/library.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/library.dylan Mon Dec 11 22:58:41 2006
@@ -154,8 +154,12 @@
register-url,
<request>,
*request*, // Holds the active request, per thread.
+ current-request, // Returns the active request of the thread.
+ current-response, // Returns the active response of the thread.
+ request-query-string,
request-query-values, // get the keys/vals from the current GET or POST request
request-method, // Returns #"get", #"post", etc
+ request-host,
responder-definer,
// Form/query values. (Is there a good name that covers both of these?)
@@ -166,12 +170,14 @@
count-query-values,
count-form-values,
application-error,
- decode-url;
+ decode-url,
+ encode-url;
// Virtual hosts
create
<virtual-host>, *virtual-host*,
- document-root, locator-below-document-root?;
+ document-root, vhost-name,
+ locator-below-document-root?;
// Responses
create
@@ -260,6 +266,10 @@
create
print-object;
+ // files
+ create
+ static-file-responder;
+
end module koala;
// Additional interface for extending the server
@@ -356,6 +366,9 @@
respond-to-post, // Implement this for your page to handle POST requests
respond-to-head, // Implement this for your page to handle HEAD requests
+ page-source,
+ page-source-setter,
+
<dylan-server-page>, // Subclass this using the "define page" macro
page-definer, // Defines a new page class
process-template, // Call this (or next-method()) from respond-to-get/post if
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 Dec 11 22:58:41 2006
@@ -500,6 +500,8 @@
// Cache, mapping keyword (requested by user) -> parsed data
constant slot request-header-values :: <object-table> = make(<object-table>);
+ slot request-query-string :: <string> = "";
+
// Query values from either the URL or the body of the POST, if Content-Type
// is application/x-www-form-urlencoded.
slot request-query-values :: false-or(<string-table>) = #f;
@@ -532,10 +534,8 @@
define thread variable *request-query-values* :: <string-table>
= make(<string-table>);
-// Is there ever any need for clients to use these?
-//define inline function current-request () => (request :: <request>) *request* end;
-//define inline function current-response () => (response :: <response>) *response* end;
-
+define inline function current-request () => (request :: <request>) *request* end;
+define inline function current-response () => (response :: <response>) *response* end;
// Called (in a new thread) each time an HTTP request is received.
define function handler-top-level
@@ -671,7 +671,8 @@
log-debug("Setting request-url-tail to %=", request.request-url-tail);
end;
if (qpos)
- log-debug("Request query string = %s", copy-sequence(buffer, start: qpos + 1, end: epos));
+ request.request-query-string := copy-sequence(buffer, start: qpos + 1, end: epos);
+ log-debug("Request query string = %s", request.request-query-string);
extract-query-values(buffer, qpos + 1, epos,
request.request-query-values)
end;
@@ -881,6 +882,7 @@
end
end
end;
+ let url = decode-url(url, 0, size(url));
let path = split(url, separator: "/");
let trie = url-map(*server*);
let (responder, rest) = find-object(trie, path);
Modified: trunk/libraries/network/web-framework/changes.dylan
==============================================================================
--- trunk/libraries/network/web-framework/changes.dylan (original)
+++ trunk/libraries/network/web-framework/changes.dylan Mon Dec 11 22:58:41 2006
@@ -5,7 +5,7 @@
/* slot CommonAttributes */
slot authors :: <list> = #(),
init-keyword: authors:;
- slot categories :: <list> = #(),
+ slot categories :: <vector> = #[],
init-keyword: categories:;
slot contributors :: <list> = #(),
init-keyword: contributors:;
@@ -30,8 +30,8 @@
/* repeated slot extensionElement */
slot entries :: <string-table> = make(<string-table>),
init-keyword: entries:;
- slot language :: <text>,
- init-keyword: language:;
+ slot languages :: <list> = #(),
+ init-keyword: languages:;
slot description :: <text>,
init-keyword: description:;
slot published :: <date> = current-date(),
@@ -40,16 +40,13 @@
define open class <entry> (<object>)
/* slot CommonAttributes */
- slot authors :: <stretchy-vector> =
- make(<stretchy-vector>, size: 0),
+ slot authors :: <list> = #(),
init-keyword: authors:;
- slot categories :: <stretchy-vector> =
- make(<stretchy-vector>, size: 0),
+ slot categories :: <vector> = #[],
init-keyword: categories:;
slot content :: false-or(<content>) = #f,
init-keyword: content:;
- slot contributors :: <stretchy-vector> =
- make(<stretchy-vector>, size: 0),
+ slot contributors :: <list> = #(),
init-keyword: contributors:;
slot identifier :: <uri>,
init-keyword: identifier:;
@@ -79,7 +76,7 @@
entry.%comments-count;
end;
-define class <comment> (<object>)
+define open class <comment> (<object>)
slot name :: <string>,
required-init-keyword: name:;
slot website :: false-or(<uri>) = #f,
@@ -159,16 +156,29 @@
end;
define class <link> (<object>)
- slot href :: <uri>, init-keyword: uri:;
- slot rel :: <uri>, init-keyword: rel:;
- slot type :: <string>, init-keyword: type:;
- slot hreflang :: <string>, init-keyword: hreflang:;
- slot title :: false-or(<text>) = #f, init-keyword: title:;
- slot length :: false-or(<text>) = #f, init-keyword: length:;
+ slot href :: <uri>,
+ required-init-keyword: href:;
+ slot rel :: false-or(<uri>) = #f,
+ init-keyword: rel:;
+ slot type :: false-or(<string>) = #f,
+ init-keyword: type:;
+ slot hreflang :: false-or(<string>) = #f,
+ init-keyword: hreflang:;
+ slot title :: false-or(<text>) = #f,
+ init-keyword: title:;
+ slot length :: false-or(<text>) = #f,
+ init-keyword: length:;
end;
define constant <source> = <feed>;
+define open generic permanent-link (object :: <object>, #key #all-keys) => (uri :: <uri>);
+
+define method permanent-link (entry :: <entry>, #key)
+ => (uri :: <uri>);
+ entry.identifier
+end;
+
// RSS
define generic generate-rss (object :: <object>);
define method generate-rss (feed :: <feed>)
@@ -235,39 +245,53 @@
define method generate-xhtml (date :: <date>)
end;
-define method generate-atom (feed :: <feed>)
+define open generic generate-atom (object :: <object>, #key #all-keys);
+
+define method generate-atom (feed :: <feed>, #key entries: feed-entries :: false-or(<sequence>))
with-xml-builder()
- feed (xmlns => "http://www.w3.org/2005/Atom")
- {
- title(feed.title),
- subtitle(feed.subtitle),
- updated { do(collect(generate-atom(feed.updated))) },
+ feed (xmlns => "http://www.w3.org/2005/Atom") {
id(feed.identifier),
+ updated(generate-atom(feed.updated)),
+ title(feed.title),
+ do(if (feed.subtitle & feed.subtitle ~= "")
+ with-xml()
+ subtitle(feed.subtitle)
+ end;
+ end if),
do(do(method(x) collect(generate-atom(x)) end, feed.links)),
- rights(feed.rights),
+ do(if (feed.rights & feed.rights ~= "")
+ with-xml()
+ rights(feed.rights)
+ end;
+ end if),
do(collect(generate-atom(feed.generator))),
- do(do(method(x) collect(generate-atom(x)) end, feed.entries))
+ do(do(method(x) collect(generate-atom(x)) end, feed-entries | feed.entries))
} //missing: category, contributor, icon, logo
end;
end;
-define method generate-atom (link :: <link>)
- with-xml()
- link (rel => link.rel,
- type => link.type,
- href => link.href)
- end //missing: title, hreflang, length
+define method generate-atom (link :: <link>, #key)
+ let element = with-xml()
+ link(href => link.href)
+ end;
+ link.rel & add-attribute(element, with-xml()
+ !attribute(rel => link.rel)
+ end);
+ link.type & add-attribute(element, with-xml()
+ !attribute(type => link.type)
+ end);
+ //missing: title, hreflang, length
+ element;
end;
-define method generate-atom (person :: <person>)
+define method generate-atom (person :: <person>, #key)
end;
-define method generate-atom (date :: <date>)
-// with-xml()
-// end;
+define method generate-atom (date :: <date>, #key)
+ format-date("%Y-%m-%dT%H:%M:%S%:z", date);
end;
-define method generate-atom (generator :: <generator>)
+define method generate-atom (generator :: <generator>, #key)
with-xml()
generator (uri => generator.uri, version => generator.system-version)
{
@@ -276,15 +300,15 @@
end;
end;
-define method generate-atom (entry :: <entry>)
+define method generate-atom (entry :: <entry>, #key)
with-xml()
entry
{
title(entry.title),
- do(do(method(x) collect(generate-atom(x)) end, entry.links)),
- id(entry.identifier),
- updated { do(collect(generate-atom(entry.updated))) },
- published { do(collect(generate-atom(entry.published))) },
+// do(do(method(x) collect(generate-atom(x)) end, entry.links)),
+ id(permanent-link(entry)),
+ published(generate-atom(entry.published)),
+// updated { do(collect(generate-atom(entry.updated))) },
// do(do(method(x) collect(generate-atom(x)) end, entry.authors)),
// do(do(method(x) collect(generate-atom(x)) end, entry.contributors)),
do(collect(generate-atom(entry.content))),
@@ -292,8 +316,10 @@
end;
end;
-define method generate-atom (con :: <content>)
+define method generate-atom (con :: <content>, #key)
with-xml()
- text(con.content)
+ content {
+ text(con.content)
+ }
end;
end;
Modified: trunk/libraries/network/web-framework/users.dylan
==============================================================================
--- trunk/libraries/network/web-framework/users.dylan (original)
+++ trunk/libraries/network/web-framework/users.dylan Mon Dec 11 22:58:41 2006
@@ -1,7 +1,7 @@
module: users
author: Hannes Mehnert <hannes at mehnert.org>
-define web-class <user> (<object>)
+define open web-class <user> (<object>)
data username :: <string>;
data password :: <string>;
data email :: <string>;
Modified: trunk/libraries/network/web-framework/web-macro.dylan
==============================================================================
--- trunk/libraries/network/web-framework/web-macro.dylan (original)
+++ trunk/libraries/network/web-framework/web-macro.dylan Mon Dec 11 22:58:41 2006
@@ -162,8 +162,8 @@
end;
define macro define-class
- { define-class(?:name; ?superclass:*; ?slots:*) }
- => { define class ?name (?superclass) ?slots end }
+ { define-class(?args:*; ?:name; ?superclass:*; ?slots:*) }
+ => { define ?args class ?name (?superclass) ?slots end }
slots:
{ } => { }
@@ -184,10 +184,10 @@
end;
define macro web-class-definer
- { define web-class ?:name (?superclass:*)
+ { define ?args:* web-class ?:name (?superclass:*)
?class-slots:*
end }
- => { define-class(?name; ?superclass; ?class-slots);
+ => { define-class(?args; ?name; ?superclass; ?class-slots);
define inline method list-reference-slots
(object :: subclass(?name), #next next-method)
=> (res :: <list>)
Modified: trunk/libraries/xml-parser/simple-xml.dylan
==============================================================================
--- trunk/libraries/xml-parser/simple-xml.dylan (original)
+++ trunk/libraries/xml-parser/simple-xml.dylan Mon Dec 11 22:58:41 2006
@@ -123,6 +123,8 @@
{ ?:name } => { list(make(<element>, name: ?"name")) }
{ text ( ?value:expression ) } => { list(make(<char-string>,
text: escape-xml(?value))) }
+ { !attribute(?attribute) }
+ => { list(?attribute) }
{ do(?:body) }
=> { begin
let res = make(<stretchy-vector>);
@@ -159,7 +161,7 @@
{ ?:name ( ?value:expression, ?attribute-list ) }
=> { list(make(<element>,
children: list(make(<char-string>,
- text: escape-xml(?value))),
+ text: escape-xml(?value))),
name: ?"name",
attributes: vector(?attribute-list))) }
{ ?:name ( ?attribute-list ) }
@@ -173,14 +175,18 @@
{ ?element, ... } => { ?element, ... }
attribute-list:
+ { } => { }
+ { ?attribute, ... } => { ?attribute, ... }
+
+ attribute:
{ ?key:name => ?value:expression }
- => { make(<attribute>, name: ?"key", value: ?value) }
- { ?key:name => ?value:expression, ... }
- => { make(<attribute>, name: ?"key", value: ?value), ... }
+ => { make(<attribute>,
+ name: ?"key",
+ value: ?value) }
{ ?ns:name :: ?key:name => ?value:expression }
- => { make(<attribute>, name: concatenate(?"ns" ## ":", ?"key"), value: ?value) }
- { ?ns:name :: ?key:name => ?value:expression, ... }
- => { make(<attribute>, name: concatenate(?"ns" ## ":", ?"key"), value: ?value), ... }
+ => { make(<attribute>,
+ name: concatenate(?"ns" ## ":", ?"key"),
+ value: ?value) }
end;
define method add-attribute (element :: <element>, attribute :: <attribute>)
More information about the chatter
mailing list