Fix scoping problem in cont-responder
parent
7f79de6d1f
commit
b64cb2cb75
|
|
@ -1,29 +1,10 @@
|
|||
! Copyright (C) 2004 Chris Double.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
IN: cont-responder
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: http httpd math namespaces io
|
||||
lists strings kernel html hashtables
|
||||
parser generic sequences ;
|
||||
lists strings kernel html hashtables
|
||||
parser generic sequences ;
|
||||
IN: cont-responder
|
||||
|
||||
#! Used inside the session state of responders to indicate whether the
|
||||
#! next request should use the post-refresh-get pattern. It is set to
|
||||
|
|
@ -46,13 +27,13 @@ SYMBOL: table
|
|||
|
||||
: continuation-table ( -- <hashtable> )
|
||||
#! Return the global table of continuations
|
||||
table global hash ;
|
||||
table get-global ;
|
||||
|
||||
: reset-continuation-table ( -- )
|
||||
#! Create the initial global table
|
||||
continuation-table clear-hash ;
|
||||
|
||||
H{ } clone table global set-hash
|
||||
H{ } clone table set-global
|
||||
|
||||
#! Tuple for holding data related to a continuation.
|
||||
TUPLE: item expire? quot id time-added ;
|
||||
|
|
@ -79,7 +60,7 @@ TUPLE: item expire? quot id time-added ;
|
|||
#! Expire all continuations in the continuation table
|
||||
#! if they are 'timeout-seconds' old (ie. were added
|
||||
#! more than 'timeout-seconds' ago.
|
||||
continuation-table clone [ ( timeout-seconds [[ id item ]] -- )
|
||||
continuation-table clone [
|
||||
swapd expired? [
|
||||
continuation-table remove-hash
|
||||
] [
|
||||
|
|
@ -193,7 +174,7 @@ SYMBOL: callback-cc
|
|||
[ ( 0 1 -- )
|
||||
callback-cc set ( 0 -- )
|
||||
stdio get swap continue-with
|
||||
] callcc1 ( 0 [ ] == )
|
||||
] callcc1
|
||||
nip
|
||||
dup resume-stdio stdio set resume-value
|
||||
call
|
||||
|
|
@ -284,6 +265,7 @@ SYMBOL: root-continuation
|
|||
#! If it does not exist the root continuation is called. If
|
||||
#! no root continuation exists the expired continuation handler
|
||||
#! should be called.
|
||||
[
|
||||
drop [
|
||||
"response" get stdio get <resume>
|
||||
id-or-root [
|
||||
|
|
@ -291,13 +273,17 @@ SYMBOL: root-continuation
|
|||
] [
|
||||
(expired-page-handler) "" call-exit-continuation
|
||||
] if*
|
||||
] with-exit-continuation drop ;
|
||||
] with-exit-continuation drop
|
||||
] with-scope ;
|
||||
|
||||
: callback-quot ( quot -- quot )
|
||||
#! Convert the given quotation so it works as a callback
|
||||
#! by returning a quotation that will pass the original
|
||||
#! quotation to the callback continuation.
|
||||
[ , \ stdio , \ get , \ <resume> , callback-cc get , \ continue-with , ] [ ] make ;
|
||||
[
|
||||
, \ stdio , \ get , \ <resume> , callback-cc get ,
|
||||
\ continue-with ,
|
||||
] [ ] make ;
|
||||
|
||||
: quot-url ( quot -- url )
|
||||
callback-quot expirable register-continuation id>url ;
|
||||
|
|
|
|||
|
|
@ -137,14 +137,16 @@ GENERIC: task-container ( task -- vector )
|
|||
[ drop t swap rot set-bit-nth ] hash-each-with ;
|
||||
|
||||
: init-fdsets ( -- read write except )
|
||||
read-fdset get [ read-tasks get init-fdset ] keep
|
||||
write-fdset get [ write-tasks get init-fdset ] keep
|
||||
read-fdset get-global
|
||||
[ read-tasks get-global init-fdset ] keep
|
||||
write-fdset get-global
|
||||
[ write-tasks get-global init-fdset ] keep
|
||||
f ;
|
||||
|
||||
: io-multiplex ( timeout -- )
|
||||
>r FD_SETSIZE init-fdsets r> make-timeval select io-error
|
||||
read-fdset get read-tasks get handle-fdset
|
||||
write-fdset get write-tasks get handle-fdset ;
|
||||
read-fdset get-global read-tasks get-global handle-fdset
|
||||
write-fdset get-global write-tasks get-global handle-fdset ;
|
||||
|
||||
! Readers
|
||||
|
||||
|
|
@ -203,7 +205,7 @@ M: read-task do-io-task ( task -- ? )
|
|||
2drop f
|
||||
] if ;
|
||||
|
||||
M: read-task task-container drop read-tasks get ;
|
||||
M: read-task task-container drop read-tasks get-global ;
|
||||
|
||||
: wait-to-read ( count port -- )
|
||||
2dup can-read-count? [
|
||||
|
|
@ -258,10 +260,10 @@ M: write-task do-io-task
|
|||
write-step f
|
||||
] if ;
|
||||
|
||||
M: write-task task-container drop write-tasks get ;
|
||||
M: write-task task-container drop write-tasks get-global ;
|
||||
|
||||
: add-write-io-task ( callback task -- )
|
||||
dup io-task-fd write-tasks get hash [
|
||||
dup io-task-fd write-tasks get-global hash [
|
||||
dup write-task? [
|
||||
nip io-task-callbacks enque
|
||||
] [
|
||||
|
|
|
|||
Loading…
Reference in New Issue