[Gd-chatter] r11190 - trunk/libraries/network/koala/sources/koala

[turbo24prg at gwydiondylan.org]

Author: turbo24prg
Date: Sun Feb 18 23:27:29 2007
New Revision: 11190

Modified:
   trunk/libraries/network/koala/sources/koala/dsp.dylan
   trunk/libraries/network/koala/sources/koala/server.dylan
Log:
Job: koala
 * convenience methods for new respond-to method, enables respondse to all methods


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	Sun Feb 18 23:27:29 2007
@@ -97,15 +97,26 @@
                             response :: <response>)
   let pc = make(<page-context>);
   dynamic-bind (*page-context* = pc)
-    select (request.request-method)
-      #"POST"   => respond-to-post(page, request, response);
-      #"GET"    => respond-to-get (page, request, response);
-      #"HEAD"   => respond-to-head(page, request, response);
-      otherwise => unsupported-request-method-error();
-    end;
+    respond-to(request.request-method, page, request, response);
   end;
 end process-page;
 
+define method respond-to (request :: <symbol>, page :: <page>, request :: <request>, response :: <response>)
+  unsupported-request-method-error()
+end;
+
+define method respond-to (request == #"GET", page :: <page>, request :: <request>, response :: <response>)
+  respond-to-get(page, request, response);
+end;
+
+define method respond-to (request == #"POST", page :: <page>, request :: <request>, response :: <response>)
+  respond-to-post(page, request, response);                                                          
+end;
+
+define method respond-to (request == #"HEAD", page :: <page>, request :: <request>, response :: <response>)
+  respond-to-head(page, request, response);                                                          
+end;
+
 // Applications should call this to register a page for a particular URL.
 define function register-page
     (url :: <string>, page :: <page>, #key replace?, prefix?)

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	Sun Feb 18 23:27:29 2007
@@ -49,7 +49,6 @@
   //---TODO: response for unsupported-request-method-error MUST include
   // Allow: field...  Need an API for making sure that happens.
   // RFC 2616, 5.1.1
-  constant slot allowed-methods :: <sequence> = #(#"GET", #"POST", #"HEAD");
 
   // Map from URL string to a response function.  The leading slash is removed
   // from URLs because it's easier to use merge-locators that way.
@@ -616,7 +615,7 @@
     pset (buffer, len) read-request-line(socket) end;
   end;
   log-info("%s", substring(buffer, 0, len));
-  read-request-first-line(request, buffer, len, server.allowed-methods);
+  read-request-first-line(request, buffer, len);
   unless (request.request-version == #"http/0.9")
     request.request-headers
       := read-message-headers(socket,
@@ -638,14 +637,14 @@
 // ---TODO: this code would be a lot clearer if it used regular expressions.
 //
 define function read-request-first-line
-    (request :: <request>, buffer :: <string>, eol :: <integer>, allowed-methods)
+    (request :: <request>, buffer :: <string>, eol :: <integer>)
  => ()
   let method-end = whitespace-position(buffer, 0, eol) | eol;
   if (zero?(method-end))
     invalid-request-line-error();
   else
     request.request-method
-      := extract-request-method(buffer, 0, method-end, allowed-methods);
+    := as(<symbol>, copy-sequence(buffer, start: 0, end: method-end));
     let bpos = skip-whitespace(buffer, method-end, eol);
     let epos = whitespace-position(buffer, bpos, eol) | eol;
     when (epos > bpos)
@@ -992,17 +991,6 @@
   len == 1 & buffer[0] == $cr
 end;
 
-define function extract-request-method (buffer :: <string>,
-                                        bpos :: <integer>,
-                                        epos :: <integer>,
-                                        allowed-methods :: <sequence>)
-  any?(method (key :: <symbol>)
-         key-match(key, buffer, bpos, epos) & key
-       end,
-       allowed-methods)
-  | unsupported-request-method-error();
-end;
-
 define function extract-request-version (buffer :: <string>,
                                          bpos :: <integer>,
                                          epos :: <integer>)