t in-transaction [
begin-transaction
[ ] [ rollback-transaction ] cleanup commit-transaction
- ] with-variable ;
+ ] with-variable ; inline
-! Copyright (C) 2008 Slava Pestov.\r
+! Copyright (C) 2008, 2009 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: accessors sequences kernel assocs combinators\r
validators http hashtables namespaces fry continuations locals\r
-io arrays math boxes splitting urls\r
+io arrays math boxes splitting urls call\r
xml.entities\r
http.server\r
http.server.responses\r
'[\r
_ dup display>> [\r
{\r
- [ init>> call ]\r
- [ authorize>> call ]\r
+ [ init>> call( -- ) ]\r
+ [ authorize>> call( -- ) ]\r
[ drop restore-validation-errors ]\r
- [ display>> call ]\r
+ [ display>> call( -- response ) ]\r
} cleave\r
] [ drop <400> ] if\r
] with-exit-continuation ;\r
: handle-post ( action -- response )\r
'[\r
_ dup submit>> [\r
- [ validate>> call ]\r
- [ authorize>> call ]\r
- [ submit>> call ]\r
+ [ validate>> call( -- ) ]\r
+ [ authorize>> call( -- ) ]\r
+ [ submit>> call( -- response ) ]\r
tri\r
] [ drop <400> ] if\r
] with-exit-continuation ;\r
\r
\ successful-login DEBUG add-input-logging\r
\r
-: logout ( -- )\r
+: logout ( -- response )\r
permit-id get [ delete-permit ] when*\r
URL" $realm" end-aside ;\r
\r
-! Copyright (c) 2008 Slava Pestov
+! Copyright (c) 2008, 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math.order namespaces combinators.short-circuit
+USING: accessors kernel math.order namespaces combinators.short-circuit call
html.forms
html.templates
html.templates.chloe
M:: boilerplate call-responder* ( path responder -- )
begin-form
path responder call-next-method
- responder init>> call
+ responder init>> call( -- )
dup wrap-boilerplate? [
clone [| body |
[
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel http.server http.server.filters
-http.server.responses furnace.utilities ;
+http.server.responses furnace.utilities call ;
IN: furnace.referrer
TUPLE: referrer-check < filter-responder quot ;
C: <referrer-check> referrer-check
M: referrer-check call-responder*
- referrer over quot>> call
+ referrer over quot>> call( referrer -- ? )
[ call-next-method ]
[ 2drop 403 "Bad referrer" <trivial-response> ] if ;
exit-continuation get continue-with ;
: with-exit-continuation ( quot -- value )
- '[ exit-continuation set @ ] callcc1 exit-continuation off ;
+ '[ exit-continuation set @ ] callcc1 exit-continuation off ; inline
-! Copyright (C) 2008 Slava Pestov
+! Copyright (C) 2008, 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors strings namespaces assocs hashtables io
+USING: kernel accessors strings namespaces assocs hashtables io call
mirrors math fry sequences words continuations
xml.entities xml.writer xml.syntax ;
IN: html.forms
>hashtable "validators" set-word-prop ;
: validate ( value quot -- result )
- [ <validation-error> ] recover ; inline
+ '[ _ call( value -- validated ) ] [ <validation-error> ] recover ;
: validate-value ( name value quot -- )
validate
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel fry io io.encodings.utf8 io.files
debugger prettyprint continuations namespaces boxes sequences
-arrays strings html io.streams.string assocs
+arrays strings html io.streams.string assocs call
quotations xml.data xml.writer xml.syntax ;
IN: html.templates
M: string call-template* write ;
-M: callable call-template* call ;
+M: callable call-template* call( -- ) ;
M: xml call-template* write-xml ;
{ $side-effects "responder" } ;
ARTICLE: "http.server.static.extend" "Hooks for dynamic content"
-"The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- )" } "."
+"The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- response )" } "."
$nl
"A utility word uses the above feature to enable server-side " { $snippet ".fhtml" } " scripts, allowing a development style much like PHP:"
{ $subsection enable-fhtml }
-! Copyright (C) 2004, 2008 Slava Pestov.\r
+! Copyright (C) 2004, 2009 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: calendar kernel math math.order math.parser namespaces\r
parser sequences strings assocs hashtables debugger mime.types\r
io.files.info io.directories io.pathnames io.encodings.binary\r
fry xml.entities destructors urls html xml.syntax\r
html.templates.fhtml http http.server http.server.responses\r
-http.server.redirection xml.writer ;\r
+http.server.redirection xml.writer call ;\r
IN: http.server.static\r
\r
TUPLE: file-responder root hook special allow-listings ;\r
\r
: serve-static ( filename mime-type -- response )\r
over modified-since?\r
- [ file-responder get hook>> call ] [ 2drop <304> ] if ;\r
+ [ file-responder get hook>> call( filename mime-type -- response ) ]\r
+ [ 2drop <304> ]\r
+ if ;\r
\r
: serving-path ( filename -- filename )\r
[ file-responder get root>> trim-tail-separators "/" ] dip\r
: serve-file ( filename -- response )\r
dup mime-type\r
dup file-responder get special>> at\r
- [ call ] [ serve-static ] ?if ;\r
+ [ call( filename -- response ) ] [ serve-static ] ?if ;\r
\r
\ serve-file NOTICE add-input-logging\r
\r
continuations debugger classes.tuple namespaces make vectors
bit-arrays byte-arrays strings sbufs math.functions macros
sequences.private combinators mirrors splitting
-combinators.short-circuit fry words.symbol generalizations ;
+combinators.short-circuit fry words.symbol generalizations call ;
RENAME: _ fry => __
IN: inverse
M: pop-inverse inverse
[ "pop-length" word-prop cut-slice swap >quotation ]
- [ "pop-inverse" word-prop ] bi compose call ;
+ [ "pop-inverse" word-prop ] bi compose call( -- quot ) ;
: (undo) ( revquot -- )
[ unclip-slice inverse % (undo) ] unless-empty ;
-! Copyright (C) 2003, 2008 Slava Pestov.
+! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: continuations destructors kernel math math.parser
namespaces parser sequences strings prettyprint
io.sockets.secure io.files io.streams.duplex io.timeouts
io.encodings threads make concurrency.combinators
concurrency.semaphores concurrency.flags
-combinators.short-circuit ;
+combinators.short-circuit call ;
IN: io.servers.connection
TUPLE: threaded-server
[ [ remote-address set ] [ local-address set ] bi* ]
2bi ;
-M: threaded-server handle-client* handler>> call ;
+M: threaded-server handle-client* handler>> call( -- ) ;
: handle-client ( client remote local -- )
'[
[ >alist sort-values <reversed> ] dip [\r
[ swapd with-cell pprint-cell ] with-row\r
] curry assoc-each\r
- ] tabular-output ;\r
+ ] tabular-output ; inline\r
\r
: log-entry. ( entry -- )\r
"====== " write\r
PRIVATE>\r
\r
: (define-logging) ( word level quot -- )\r
- [ dup ] 2dip 2curry annotate ;\r
+ [ dup ] 2dip 2curry annotate ; inline\r
\r
: call-logging-quot ( quot word level -- quot' )\r
[ "called" ] 2dip [ log-message ] 3curry prepose ;\r