steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add support for rest urls

db4
Slava Pestov 2008-05-27 00:01:57 -05:00
parent 91d7adcbf1
commit e7438f4ab6
1 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
extra/http/server/actions/actions.factor
View File

@ -2,11 +2,13 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors sequences kernel assocs combinators http.server USING: accessors sequences kernel assocs combinators http.server
validators http hashtables namespaces fry continuations locals validators http hashtables namespaces fry continuations locals
boxes xml.entities html.elements html.components io arrays ; boxes xml.entities html.elements html.components io arrays math ;
IN: http.server.actions IN: http.server.actions
SYMBOL: params SYMBOL: params
SYMBOL: rest-param
: render-validation-messages ( -- ) : render-validation-messages ( -- )
validation-messages get validation-messages get
dup empty? [ drop ] [ dup empty? [ drop ] [
@ -15,7 +17,7 @@ SYMBOL: params
</ul> </ul>
] if ; ] if ;
TUPLE: action init display validate submit ; TUPLE: action rest-param init display validate submit ;
: new-action ( class -- action ) : new-action ( class -- action )
new new
@ -43,19 +45,27 @@ TUPLE: action init display validate submit ;
[ validate>> call ] [ validate>> call ]
[ submit>> call ] bi ; [ submit>> call ] bi ;
: handle-rest-param ( arg -- )
dup length 1 > action get rest-param>> not or
[ <404> exit-with ] [
action get rest-param>> associate rest-param set
] if ;
M: action call-responder* ( path action -- response ) M: action call-responder* ( path action -- response )
dup action set dup action set
'[ '[
, empty? [ , dup empty? [ drop ] [ handle-rest-param ] if
init-validation
, init-validation
request get [ request-params params set ] [ method>> ] bi ,
{ request get
{ "GET" [ handle-get ] } [ request-params rest-param get assoc-union params set ]
{ "HEAD" [ handle-get ] } [ method>> ] bi
{ "POST" [ handle-post ] } {
} case { "GET" [ handle-get ] }
] [ <404> ] if { "HEAD" [ handle-get ] }
{ "POST" [ handle-post ] }
} case
] with-exit-continuation ; ] with-exit-continuation ;
: param ( name -- value ) : param ( name -- value )