2008-09-22 18:15:59 -04:00
|
|
|
USING: http http.server.dispatchers http.server.responses
|
2008-11-24 21:26:11 -05:00
|
|
|
http.server furnace furnace.utilities tools.test kernel
|
2009-02-09 17:46:02 -05:00
|
|
|
namespaces accessors io.streams.string urls xml.writer ;
|
2009-08-13 20:21:44 -04:00
|
|
|
IN: furnace.tests
|
|
|
|
|
2008-06-02 16:00:03 -04:00
|
|
|
TUPLE: funny-dispatcher < dispatcher ;
|
|
|
|
|
2009-03-23 01:34:02 -04:00
|
|
|
: <funny-dispatcher> ( -- dispatcher ) funny-dispatcher new-dispatcher ;
|
2008-06-02 16:00:03 -04:00
|
|
|
|
|
|
|
TUPLE: base-path-check-responder ;
|
|
|
|
|
|
|
|
C: <base-path-check-responder> base-path-check-responder
|
|
|
|
|
|
|
|
M: base-path-check-responder call-responder*
|
|
|
|
2drop
|
|
|
|
"$funny-dispatcher" resolve-base-path
|
2014-04-22 16:47:25 -04:00
|
|
|
<text-content> ;
|
2008-06-02 16:00:03 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ } [
|
2008-06-02 16:00:03 -04:00
|
|
|
<dispatcher>
|
|
|
|
<dispatcher>
|
|
|
|
<funny-dispatcher>
|
|
|
|
<base-path-check-responder> "c" add-responder
|
|
|
|
"b" add-responder
|
|
|
|
"a" add-responder
|
|
|
|
main-responder set
|
|
|
|
] unit-test
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ "/a/b/" } [
|
2008-06-02 16:00:03 -04:00
|
|
|
V{ } responder-nesting set
|
|
|
|
"a/b/c" split-path main-responder get call-responder body>>
|
|
|
|
] unit-test
|
2008-06-04 20:54:05 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ "<input type=\"hidden\" value=\"&&&\" name=\"foo\"/>" }
|
2009-02-09 17:46:02 -05:00
|
|
|
[ "&&&" "foo" hidden-form-field xml>string ]
|
2008-06-04 20:54:05 -04:00
|
|
|
unit-test
|
2008-09-22 18:15:59 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ f } [ <request> request [ referrer ] with-variable ] unit-test
|
2008-09-22 18:15:59 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ t } [ URL" http://foo" dup url [ same-host? ] with-variable ] unit-test
|
2008-09-22 18:15:59 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ f } [ f URL" http://foo" url [ same-host? ] with-variable ] unit-test
|