Move furnace.actions:{param,params} and furnace.utilities:request-params to http.server

db4
Slava Pestov 2009-08-03 14:58:18 -05:00
parent e5114aa510
commit 3857006b71
6 changed files with 48 additions and 40 deletions

View File

@ -33,18 +33,6 @@ HELP: new-action
HELP: page-action HELP: page-action
{ $class-description "The class of Chloe page actions. These are actions whose " { $slot "display" } " slot is pre-set to serve the Chloe template stored in the " { $slot "page" } " slot." } ; { $class-description "The class of Chloe page actions. These are actions whose " { $slot "display" } " slot is pre-set to serve the Chloe template stored in the " { $slot "page" } " slot." } ;
HELP: param
{ $values
{ "name" string }
{ "value" string }
}
{ $description "Outputs the value of a query parameter (if the current request is a GET or HEAD request) or a POST parameter (if the current request is a POST request)." }
{ $notes "Instead of using this word, it is better to use " { $link validate-params } " and then access parameters via " { $link "html.forms.values" } " words." } ;
HELP: params
{ $var-description "A variable holding an assoc of query parameters (if the current request is a GET or HEAD request) or POST parameters (if the current request is a POST request)." }
{ $notes "Instead of using this word, it is better to use " { $link validate-params } " and then access parameters via " { $link "html.forms.values" } " words." } ;
HELP: validate-integer-id HELP: validate-integer-id
{ $description "A utility word which validates an integer parameter named " { $snippet "id" } "." } { $description "A utility word which validates an integer parameter named " { $snippet "id" } "." }
{ $examples { $examples
@ -144,10 +132,8 @@ ARTICLE: "furnace.actions.lifecycle" "Furnace action lifecycle"
"Any one of the above steps can perform validation; if " { $link validation-failed } " is called during a POST request, the client is sent back to the page containing the form submission, with current form values and validation errors passed in a " { $link "furnace.conversations" } "." ; "Any one of the above steps can perform validation; if " { $link validation-failed } " is called during a POST request, the client is sent back to the page containing the form submission, with current form values and validation errors passed in a " { $link "furnace.conversations" } "." ;
ARTICLE: "furnace.actions.impl" "Furnace actions implementation" ARTICLE: "furnace.actions.impl" "Furnace actions implementation"
"The following words are used by the action implementation and there is rarely any reason to call them directly:" "The following parametrized constructor should be called from constructors for subclasses of " { $link action } ":"
{ $subsection new-action } { $subsection new-action } ;
{ $subsection param }
{ $subsection params } ;
ARTICLE: "furnace.actions" "Furnace actions" ARTICLE: "furnace.actions" "Furnace actions"
"The " { $vocab-link "furnace.actions" } " vocabulary implements a type of responder, called an " { $emphasis "action" } ", which handles the form validation lifecycle." "The " { $vocab-link "furnace.actions" } " vocabulary implements a type of responder, called an " { $emphasis "action" } ", which handles the form validation lifecycle."

View File

@ -17,8 +17,6 @@ html.templates.chloe.syntax
html.templates.chloe.compiler ; html.templates.chloe.compiler ;
IN: furnace.actions IN: furnace.actions
SYMBOL: params
SYMBOL: rest SYMBOL: rest
TUPLE: action rest init authorize display validate submit ; TUPLE: action rest init authorize display validate submit ;
@ -60,9 +58,6 @@ TUPLE: action rest init authorize display validate submit ;
] [ drop <400> ] if ] [ drop <400> ] if
] with-exit-continuation ; ] with-exit-continuation ;
: param ( name -- value )
params get at ;
CONSTANT: revalidate-url-key "__u" CONSTANT: revalidate-url-key "__u"
: revalidate-url ( -- url/f ) : revalidate-url ( -- url/f )
@ -88,13 +83,12 @@ CONSTANT: revalidate-url-key "__u"
] [ drop <400> ] if ] [ drop <400> ] if
] with-exit-continuation ; ] with-exit-continuation ;
: handle-rest ( path action -- assoc ) : handle-rest ( path action -- )
rest>> dup [ [ "/" join ] dip associate ] [ 2drop f ] if ; rest>> dup [ [ "/" join ] dip set-param ] [ 2drop ] if ;
: init-action ( path action -- ) : init-action ( path action -- )
begin-form begin-form
handle-rest handle-rest ;
request get request-params assoc-union params set ;
M: action call-responder* ( path action -- response ) M: action call-responder* ( path action -- response )
[ init-action ] keep [ init-action ] keep

View File

@ -63,10 +63,6 @@ HELP: referrer
{ $values { "referrer/f" { $maybe string } } } { $values { "referrer/f" { $maybe string } } }
{ $description "Outputs the current request's referrer URL." } ; { $description "Outputs the current request's referrer URL." } ;
HELP: request-params
{ $values { "request" request } { "assoc" assoc } }
{ $description "Outputs the query parameters (if the current request is a GET or HEAD request) or the POST parameters (if the current request is a POST request)." } ;
HELP: resolve-base-path HELP: resolve-base-path
{ $values { "string" string } { "string'" string } } { $values { "string" string } { "string'" string } }
{ $description "Resolves a responder-relative URL." } ; { $description "Resolves a responder-relative URL." } ;
@ -121,6 +117,5 @@ ARTICLE: "furnace.misc" "Miscellaneous Furnace features"
{ $subsection exit-with } { $subsection exit-with }
"Other useful words:" "Other useful words:"
{ $subsection hidden-form-field } { $subsection hidden-form-field }
{ $subsection request-params }
{ $subsection client-state } { $subsection client-state }
{ $subsection user-agent } ; { $subsection user-agent } ;

View File

@ -91,13 +91,6 @@ M: object modify-form drop f ;
CONSTANT: nested-forms-key "__n" CONSTANT: nested-forms-key "__n"
: request-params ( request -- assoc )
dup method>> {
{ "GET" [ url>> query>> ] }
{ "HEAD" [ url>> query>> ] }
{ "POST" [ post-data>> params>> ] }
} case ;
: referrer ( -- referrer/f ) : referrer ( -- referrer/f )
#! Typo is intentional, it's in the HTTP spec! #! Typo is intentional, it's in the HTTP spec!
"referer" request get header>> at "referer" request get header>> at

View File

@ -1,4 +1,5 @@
USING: help.markup help.syntax io.streams.string quotations strings urls http vocabs.refresh math io.servers.connection ; USING: help.markup help.syntax io.streams.string quotations strings urls
http vocabs.refresh math io.servers.connection assocs ;
IN: http.server IN: http.server
HELP: trivial-responder HELP: trivial-responder
@ -52,12 +53,33 @@ HELP: httpd
HELP: http-insomniac HELP: http-insomniac
{ $description "Starts a thread which rotates the logs and e-mails a summary of HTTP requests every 24 hours. See " { $link "logging.insomniac" } "." } ; { $description "Starts a thread which rotates the logs and e-mails a summary of HTTP requests every 24 hours. See " { $link "logging.insomniac" } "." } ;
HELP: request-params
{ $values { "request" request } { "assoc" assoc } }
{ $description "Outputs the query parameters (if the current request is a GET or HEAD request) or the POST parameters (if the current request is a POST request)." } ;
HELP: param
{ $values
{ "name" string }
{ "value" string }
}
{ $description "Outputs the value of a query parameter (if the current request is a GET or HEAD request) or a POST parameter (if the current request is a POST request)." }
{ $notes "Instead of using this word, it is better to use " { $vocab-link "furnace.actions" } " and the associated validation machinery, which allows you to access values using " { $link "html.forms.values" } " words." } ;
HELP: params
{ $var-description "A variable holding an assoc of query parameters (if the current request is a GET or HEAD request) or POST parameters (if the current request is a POST request)." }
{ $notes "Instead of using this word, it is better to use " { $vocab-link "furnace.actions" } " and the associated validation machinery, which allows you to access values using " { $link "html.forms.values" } " words." } ;
ARTICLE: "http.server.requests" "HTTP request variables" ARTICLE: "http.server.requests" "HTTP request variables"
"The following variables are set by the HTTP server at the beginning of a request." "The following variables are set by the HTTP server at the beginning of a request."
{ $subsection request } { $subsection request }
{ $subsection url } { $subsection url }
{ $subsection post-request? } { $subsection post-request? }
{ $subsection responder-nesting } { $subsection responder-nesting }
{ $subsection params }
"Utility words:"
{ $subsection param }
{ $subsection set-param }
{ $subsection request-params }
"Additional vocabularies may be set by vocabularies such as " { $vocab-link "html.forms" } " and " { $vocab-link "furnace.sessions" } "." ; "Additional vocabularies may be set by vocabularies such as " { $vocab-link "html.forms" } " and " { $vocab-link "furnace.sessions" } "." ;
ARTICLE: "http.server.responders" "HTTP server responders" ARTICLE: "http.server.responders" "HTTP server responders"

View File

@ -3,7 +3,8 @@
USING: kernel accessors sequences arrays namespaces splitting USING: kernel accessors sequences arrays namespaces splitting
vocabs.loader destructors assocs debugger continuations vocabs.loader destructors assocs debugger continuations
combinators vocabs.refresh tools.time math math.parser present combinators vocabs.refresh tools.time math math.parser present
io vectors vectors hashtables
io
io.sockets io.sockets
io.sockets.secure io.sockets.secure
io.encodings io.encodings
@ -212,8 +213,25 @@ LOG: httpd-header NOTICE
: split-path ( string -- path ) : split-path ( string -- path )
"/" split harvest ; "/" split harvest ;
: request-params ( request -- assoc )
dup method>> {
{ "GET" [ url>> query>> ] }
{ "HEAD" [ url>> query>> ] }
{ "POST" [ post-data>> params>> ] }
} case ;
SYMBOL: params
: param ( name -- value )
params get at ;
: set-param ( value name -- )
params get set-at ;
: init-request ( request -- ) : init-request ( request -- )
[ request set ] [ url>> url set ] bi [ request set ]
[ url>> url set ]
[ request-params >hashtable params set ] tri
V{ } clone responder-nesting set ; V{ } clone responder-nesting set ;
: dispatch-request ( request -- response ) : dispatch-request ( request -- response )