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

tidy up browser title. 

put vocab and word name in browser titlebar.
update cont-responder documentation. Added information on 'show-final'
and updated examples that had suferred code rot (ie. Change use of
times*, succ, pred, [ | ], etc)..
remove setting of responder name in browser. The setting of the name
caused the browser-edit responder to jump to the browser responder when
a word was clicked..
added show-final to cont-responder.
add responder-items word for debugging in cont-responder.
changed expiry of cont-responder continuations. When the continuations
are expired they are now removed from the hash table. Previously each
request would rebuild the continuation table containing the non-expired
continuations..
convert from hashtables to typles in cont-responder.
move to using symbols for variable names in cont-responder.
convert USE: to USING: in cont-responder.
various minor cont-responder refactorings.
refactor init-cont-responder.
merge cont-get-responder and cont-put-responder into one.
refactor cont-get-responder.
fix cont-responder bug involving redirects. When a cont-responder
request for an expired page was made the  'redirect' flag was not
correctly reset. This resulted in initial  requests of a responder
redirecting when it wasn't supposed to.  Tidied up the area of redirects
and post-refresh-get pattern..
added use of show-final to todo-list.
cvs
Chris Double 2005-02-21 00:47:08 +00:00
parent ba492a60d8
commit a0c7e80835
4 changed files with 184 additions and 186 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
contrib/cont-responder/todo-example.factor
View File

@ -106,7 +106,7 @@ USE: kernel
: todo-stylesheet-url ( -- url )
#! Generate an URL for the stylesheet.
t [ [ drop todo-stylesheet write ] show ] register-continuation id>url ;
t [ [ todo-stylesheet write ] show-final ] register-continuation id>url ;
: include-todo-stylesheet ( -- )
#! Generate HTML to include the todo stylesheet
@ -476,14 +476,13 @@ USE: kernel
[ "todo" get todo-username , "'s To Do list" , ] make-string
[ include-todo-stylesheet ]
[
drop
"todo" get write-item-table
[
[ "Add Item" [ do-add-new-item ] quot-href ]
[ "Change Password" [ do-change-password ] quot-href ]
] horizontal-layout
] styled-page
] show drop ;
] show-final ;
: todo-example ( path -- )
#! Startup the todo list example using the given path as the

115
doc/cont-responder-tutorial.txt
View File

@ -37,14 +37,25 @@ gets run when the client accesses a particular URL. When run that word
has 'standard output' bound in such a way that all output goes to the
clients web browser.
In the 'cont-responder' system the word used to set output to go to the web
browser and display a page is 'show'. Think of it as 'show a page to
the client'. 'show' takes a single item on the stack and that is a
'page generation' quotation.
In the 'cont-responder' system there are two words used to set output
to go to the web browser and display a page. They are 'show' and
'show-final'. Think of them as 'show a page to the client'. 'show' and
'show-final' both take a single item on the stack and that is a 'page
generation' quotation.
A 'page generation' quotation is a quotation with stack effect
( string -- ). For now we'll ignore the string it receives on the
stack. Its purpose will be explained later.
A 'page generation' quotation is a quotation which when called will
output HTML to stdout. In the httpd system, stdout is bound to the
socket connection to the clients web browser.
The 'page generation' quotation passed to 'show' should have stack
effect ( string -- ) while that for 'show-final' has stack effect
( -- ). The two words have very similar uses.
The big difference is with 'show'. It provides an URL to the page
generation quotation that when requested will proceed with execution
immediately following the 'show', and any POST request data will be on
the stack. With 'show-final' no URL is passed so it is not possible to
'resume' computation. This is explained more fully later.
Hello World 1
=============
@ -52,16 +63,12 @@ A simple 'hello world' responder would be:
: hello-world1 ( -- )
[
drop
"<html><head><title>Hello World</title></head>" write
"<body>Hello World!</body></html>" write
] show drop ;
] show-final ;
When installed this will show a single page which is simple HTML to
display 'Hello World!'. The 'show' word returns a namespace, the
purpose of which will also be explained later. For now we ignore it
and drop it. Notice we also drop the 'URL' that the quotation passed
to 'show' receives on the stack.
display 'Hello World!'.
The responder is installed using:
@ -134,12 +141,11 @@ system:
: hello-world2 ( -- )
[
drop
<html>
<head> <title> "Hello World" write </title> </head>
<body> "Hello World!" write </body>
</html>
] show drop ;
] show-final ;
Install it using:
@ -149,14 +155,13 @@ Dynamic Data
============
Adding dynamic data to the page is relatively easy. This example pulls
information from the 'room' word which displays memory details about
information from the 'room' word which returns memory details about
the running Factor system. It also uses 'room.' which outputs these
details to standard output and this is wrapped in a <pre> tag so it is
formatted correctly.
: memory-stats1 ( -- )
[
drop
<html>
<head> <title> "Memory Statistics" write </title> </head>
<body>
@ -181,7 +186,7 @@ formatted correctly.
</body>
<pre> room. </pre>
</html>
] show drop ;
] show-final ;
"memorystats1" [ memory-stats1 ] install-cont-responder
@ -206,12 +211,11 @@ The HTML output can be refactored into different words. For example:
: memory-stats2 ( -- )
[
drop
<html>
<head> <title> "Memory Statistics 2" write </title> </head>
<body> room memory-stats-table 2drop </body>
</html>
] show drop ;
] show-final ;
"memorystats2" [ memory-stats2 ] install-cont-responder
@ -234,7 +238,7 @@ procedural flow is maintained.
This brings us to the 'URL' stack item that is available to the 'page
generation' quotation passed to 'show'. This URL is a string that
contains an URL that can be embedded in the page. When the user access
that URL computation is resumed from the point of the end of the
that URL, computation is resumed from the point of the end of the
'show' call as described above:
: flow-example1 ( -- )
@ -257,21 +261,23 @@ that URL computation is resumed from the point of the end of the
</html>
] show drop
[
drop
<html>
<head> <title> "Flow Example 1" write </title> </head>
<body>
<p> "Page 3" write </p>
</body>
</html>
] show drop ;
] show-final ;
"flowexample1" [ flow-example1 ] install-cont-responder
The 'flow-example1' word contains three 'show' calls in a row. The
first two display simple pages with an anchor link to the URL received
on the stack. This URL when accessed resumes the computation. The
final page just drops the URL.
The 'flow-example1' word contains two 'show' calls in a row, followed
by a 'show-final'. The 'show' calls display simple pages with an anchor
link to the URL received on the stack. This URL when accessed resumes
the computation. The final page doesn't require resumption of the
computation so 'show-final' is used. We could have used 'show' and
dropped the URL passed to the quotation and the result following the
'show' but using 'show-final' is more efficient.
When you display this example in the browser you'll be able to click
the URL to navigate. You can use the back button to retry the URL's,
@ -301,12 +307,12 @@ this into a seperate word:
: flow-example2 ( n -- )
#! Display the given number of pages in a row.
dup pred [ succ t show-flow-page ] times*
dup 1 - [ dup 1 + t show-flow-page ] repeat
f show-flow-page ;
"flowexample2" [ 5 flow-example2 ] install-cont-responder
In this example the 'show-flow-age' pulls the page number off the
In this example the 'show-flow-page' pulls the page number off the
stack. It also gets whether or not to display the link to the next
page.
@ -323,15 +329,16 @@ continuation which, when captured, had those items on the stack. The
general rule of thumb is you will need to account for items on the
stack before the show call.
This example also demonstrates using the 'times*' combinator to
This example also demonstrates using the 'repeat' combinator to
sequence the page shows. Any Factor code can be called and the
continuation based system will sequentially display each page. The
back button, browser window cloning, etc will all continue to work.
You'll notice the URL's in the browser have an 'id' query parameter with
a number as its value. This is the 'continuation identifier' which is
like a session id except that it identifies not just the data you have
stored but your location within the responder as well.
You'll notice the URL's in the browser have an 'id' query parameter
with a sequence of characters as its value. This is the 'continuation
identifier' which is like a session id except that it identifies not
just the data you have stored but your location within the responder
as well.
Forms and POST data
===================
@ -370,14 +377,13 @@ containing this data. Here is a simple example:
: post-example1 ( -- )
[
drop
<html>
<head> <title> "Hello!" write </title> </head>
<body>
<p> accept-users-name write ", Good to see you!" write </p>
</body>
</html>
] show drop ;
] show-final ;
"post-example1" [ post-example1 ] install-cont-responder
@ -398,23 +404,16 @@ the other way though:
: post-example2 ( -- )
accept-users-name
[ ( name url -- )
drop
<html>
<head> <title> "Hello!" write </title> </head>
<body>
<p> write ", Good to see you!" write </p>
</body>
</html>
] show 2drop ;
] show-final ;
"post-example2" [ post-example2 ] install-cont-responder
Either way works. Notice that in the 'post-example2' we had to do a
'2drop' instead of a 'drop' at the end of the show to remove the
additional 'name' that is on the stack. This wasn't needed in
'post-example1' because the 'name' was not on the stack at the time of
the 'show' call.
Associating URL's with words
============================
A web page can contain URL's that when clicked perform some
@ -439,23 +438,19 @@ decremented.
: counter-example1 ( - )
#! Display a global counter which can be incremented or decremented
#! using anchors.
#!
#! We don't need the 'url' argument
[
drop
<html>
<head>
<title> "Counter: " write "counter" get unparse dup write </title>
</head>
<body>
<h2> "Counter: " write write </h2>
<p> "++" [ "counter" get succ "counter" set ] quot-href
"--" [ "counter" get pred "counter" set ] quot-href
<p> "++" [ "counter" get 1 + "counter" set ] quot-href
"--" [ "counter" get 1 - "counter" set ] quot-href
</p>
</body>
</html>
] show
drop ;
] show-final ;
"counter-example1" [ counter-example1 ] install-cont-responder
@ -495,20 +490,18 @@ rather than a namespace:
: counter-example2 ( count - )
[ ( count URL -- )
drop
<html>
<head>
<title> "Counter: " write dup unparse write </title>
</head>
<body>
<h2> "Counter: " write dup unparse write </h2>
<p> "++" over [ succ counter-example2 ] cons quot-href
"--" swap [ pred counter-example2 ] cons quot-href
<p> "++" over [ 1 + counter-example2 ] cons quot-href
"--" swap [ 1 - counter-example2 ] cons quot-href
</p>
</body>
</html>
] show
drop ;
] show-final ;
"counter-example2" [ 0 counter-example2 ] install-cont-responder
@ -517,8 +510,8 @@ to a code quotation that will increment or decrement it then call the
responder again. So if the counter value is '5' the two 'quot-href'
calls become the equivalent of:
"++" [ 5 succ counter-example2 ] cons quot-href
"--" [ 5 pred counter-example2 ] cons quot-href
"++" [ 5 1 + counter-example2 ] cons quot-href
"--" [ 5 1 - counter-example2 ] cons quot-href
Because it calls itself with the new count value the state is
remembered for that page only. This means that each page has an
@ -547,7 +540,7 @@ very easy:
: show-some-pages ( n -- )
#! Display the given number of pages in a row.
[ succ show-page ] times* ;
[ dup 1 + show-page ] repeat ;
: subroutine-example1 ( -- )
[
@ -563,7 +556,7 @@ very easy:
</p>
</body>
</html>
] show drop ;
] show-final ;
"subroutine-example1" [ subroutine-example1 ] install-cont-responder
@ -666,7 +659,7 @@ Again we skip past the forward:
Now we submit the post data along to the 'action' url:
"5456539333180428" [ [ "username" | "Chris" ] ] alist>hash test-cont-click
"5456539333180428" [ [[ "username" "Chris" ]] ] alist>hash test-cont-click
=>
HTTP/1.0 200 Document follows
Content-Type: text/html

10
library/httpd/browser-responder.factor
View File

@ -78,7 +78,6 @@ errors unparser logging listener url-encoding hashtables memory ;
: write-word-source ( vocab word -- )
#! Write the source for the given word from the vocab as HTML.
<namespace> [
"responder" "browser" put
"allow-edit?" get [ "Edit" [ "edit-state" t put ] quot-href <br/> ] when
"edit-state" get [
write-editable-word-source
@ -187,7 +186,12 @@ errors unparser logging listener url-encoding hashtables memory ;
[
<html>
<head>
<title> "Factor Browser" write </title>
<title>
"Factor Browser - " write
"current-vocab" get write
" - " write
"current-word" get write
</title>
</head>
<body>
<form name= "main" action= method= "post" form>
@ -212,7 +216,7 @@ errors unparser logging listener url-encoding hashtables memory ;
[
"vocabs" get dup [ ] [ drop "unknown" ] ifte "words" get dup [ ] [ drop "unknown" ] ifte browser-url
forward-to-url
] show
] show-final
] bind <browser> ;
: browser-responder ( allow-edit? -- )

236
library/httpd/cont-responder.factor
View File

@ -21,25 +21,14 @@
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: cont-responder
USE: stdio
USE: httpd
USE: httpd-responder
USE: math
USE: random
USE: namespaces
USE: streams
USE: lists
USE: strings
USE: html
USE: kernel
USE: html
USE: logging
USE: url-encoding
USE: unparser
USE: hashtables
USE: parser
USE: prettyprint
USE: inspector
USING: stdio httpd httpd-responder math random namespaces streams
lists strings kernel html url-encoding unparser hashtables
parser generic ;
#! Used inside the session state of responders to indicate whether the
#! next request should use the post-refresh-get pattern. It is set to
#! true after each request.
SYMBOL: post-refresh-get?
: expiry-timeout ( -- timeout-seconds )
#! Number of seconds to timeout continuations in
@ -49,22 +38,23 @@ USE: inspector
#! testing.
900 ;
: redirect-enabled?
#! Set to true if you want the post-redirect-get pattern
#! implemented. See the redirect-to-here word for details.
t ;
: get-random-id ( -- id )
#! Generate a random id to use for continuation URL's
[ 32 [ random-digit unparse , ] times ] make-string str>number 36 >base ;
#! Name of variable holding the table of continuations.
SYMBOL: table
: continuation-table ( -- <namespace> )
#! Return the global table of continuations
"continuation-table" get ;
table get ;
: reset-continuation-table ( -- )
#! Create the initial global table
<namespace> "continuation-table" set ;
<namespace> table set ;
#! Tuple for holding data related to a continuation.
TUPLE: item expire? quot id time-added ;
: continuation-item ( expire? quot id -- <item> )
#! A continuation item is the actual item stored
@ -72,12 +62,7 @@ USE: inspector
#! quotation/continuation, time added, etc. If
#! expire? is true then the continuation will
#! be expired after a certain amount of time.
<namespace> [
"id" set
"quot" set
"expire?" set
millis "time-added" set
] extend ;
millis <item> ;
: seconds>millis ( seconds -- millis )
#! Convert a number of seconds to milliseconds
@ -87,9 +72,7 @@ USE: inspector
#! Return true if the continuation item is expirable
#! and has expired (ie. was added to the table more than
#! timeout milliseconds ago).
[ seconds>millis "time-added" get + millis - 0 <
"expire?" get and
] bind ;
[ item-time-added swap seconds>millis + millis - 0 < ] keep item-expire? and ;
: continuation-items ( -- alist )
#! Return an alist of all continuation items in the continuation
@ -100,16 +83,31 @@ USE: inspector
#! Expire all continuations in the continuation table
#! if they are 'timeout-seconds' old (ie. were added
#! more than 'timeout-seconds' ago.
continuation-items [ cdr dupd expired? not ] subset nip
alist>hash "continuation-table" set ;
continuation-items [
uncons pick swap expired? [
continuation-table remove-hash
] [
drop
] ifte
] each drop ;
: expirable ( quot -- t quot )
#! Set the stack up for a register-continuation call
#! so that the given quotation is registered that it can
#! be expired.
t swap ;
: permanent ( quot -- f quot )
#! Set the stack up for a register-continuation call
#! so that the given quotation is never expired after
#! registration.
f swap ;
: register-continuation ( expire? quot -- id )
#! Store a continuation in the table and associate it with
#! a random id. That continuation will be expired after
#! a certain period of time if 'expire?' is true.
continuation-table [
get-random-id -rot pick continuation-item over set
] bind ;
get-random-id -rot pick continuation-item over continuation-table set-hash ;
: append* ( lists -- list )
#! Given a list of lists, append the lists together
@ -123,13 +121,14 @@ USE: inspector
: get-continuation-item ( id -- <item> )
#! Get the continuation item associated with the id.
continuation-table [ get ] bind ;
continuation-table hash ;
: id>url ( id -- string )
#! Convert the continuation id to an URL suitable for
#! embedding in an HREF or other HTML.
url-encode "?id=" swap cat2 ;
DEFER: show-final
DEFER: show
: expired-page-handler ( alist -- )
@ -138,45 +137,52 @@ DEFER: show
#! returning back to root continuation.
drop
[
drop
<html>
<body>
<p> "This page has expired." write </p>
</body>
</html>
] show drop ;
] show-final ;
: get-registered-continuation ( id -- cont )
#! Return the continuation or quotation
#! associated with the given id.
#! TODO: handle expired pages better.
expiry-timeout expire-continuations
get-continuation-item dup [
[ "quot" get ] bind
get-continuation-item [
item-quot
] [
drop [ expired-page-handler ]
] ifte ;
[ expired-page-handler ]
] ifte* ;
: resume-continuation ( value id -- )
#! Call the continuation associated with the given id,
#! with 'value' on the top of the stack.
get-registered-continuation call ;
#! Name of the variable holding the continuation used to exit
#! back to the httpd responder, returning any generated HTML.
SYMBOL: exit-cc
: exit-continuation ( -- exit )
#! Get the current exit continuation
"exit" get ;
exit-cc get ;
: call-exit-continuation ( value -- )
#! Call the exit continuation, passing it the given value on the
#! top of the stack.
"exit" get call ;
exit-cc get call ;
: with-exit-continuation ( quot -- )
#! Call the quotation with the variable "exit" bound such that when
#! Call the quotation with the variable exit-cc bound such that when
#! the exit continuation is called, computation will resume from the
#! end of this 'with-exit-continuation' call, with the value passed
#! to the exit continuation on the top of the stack.
[ "exit" set call f call-exit-continuation ] callcc1 nip ;
[ exit-cc set call f call-exit-continuation ] callcc1 nip ;
#! Name of variable holding the 'callback' continuation, used for
#! returning back to previous 'show' calls.
SYMBOL: callback-cc
: store-callback-cc ( -- )
#! Store the current continuation in the variable 'callback-cc'
@ -185,7 +191,7 @@ DEFER: show
#! it resets its value back to the most recent show call.
[ ( 0 -- )
[ ( 0 1 -- )
"callback-cc" set ( 0 -- )
callback-cc set ( 0 -- )
call
] callcc1 ( 0 [ ] == )
nip
@ -215,15 +221,13 @@ DEFER: show
#! "this request will issue a POST" warning from the browser
#! and prevents re-running the previous POST logic. This is
#! known as the 'post-refresh-get' pattern.
"disable-initial-redirect?" get [
"disable-initial-redirect?" f put
] [
post-refresh-get? get [
[
t swap register-continuation
[ "HTTP/1.1 302 Document Moved\nLocation: " , id>url , "\n" ,
"Content-Length: 0\nContent-Type: text/plain\n\n" , ] make-string
call-exit-continuation
expirable register-continuation
id>url forward-to-url
] callcc1 drop
] [
t post-refresh-get? set
] ifte ;
: show ( quot -- namespace )
@ -235,51 +239,52 @@ DEFER: show
#! NOTE: On return from 'show' the stack is exactly the same as
#! initial entry with 'quot' popped off an <namespace> put on. Even
#! if the quotation consumes items on the stack.
store-callback-cc
redirect-enabled? [ redirect-to-here ] when
store-callback-cc redirect-to-here
[
t swap register-continuation id>url swap
[ serving-html ] car swons with-string-stream
call-exit-continuation
expirable register-continuation id>url swap
\ serving-html swons with-string-stream call-exit-continuation
] callcc1
nip ;
: show-final ( quot -- namespace )
#! Similar to 'show', except the quotation does not receive the URL
#! to resume computation following 'show-final'. No continuation is
#! stored for this resumption. As a result, 'show-final' is for use
#! when a page is to be displayed with no further action to occur. Its
#! use is an optimisation to save having to generate and save a continuation
#! in that special case.
store-callback-cc redirect-to-here
\ serving-html swons with-string-stream call-exit-continuation ;
: cont-get-responder ( id-or-f -- )
#! Name of variable for holding initial continuation id that starts
#! the responder.
SYMBOL: root-continuation
: id-or-root ( -- id )
#! Return the continuation id for the current requested continuation
#! or the root continuation if no id is supplied.
"id" "query" get assoc [ root-continuation get ] unless* ;
: cont-get/post-responder ( id-or-f -- )
#! httpd responder that retrieves a continuation and calls it.
drop
"id" "query" get assoc
dup f-or-"" [
#! No continuation id given
drop "root-continuation" get dup [
#! Use the root continuation
[ f swap resume-continuation ] with-exit-continuation
] [
#! No root continuation either
drop [ f expired-page-handler ] with-exit-continuation
] ifte
] [
#! Use the given continuation
[ f swap resume-continuation ] with-exit-continuation
] ifte
[ write flush ] when* drop ;
: cont-post-responder ( id -- )
#! httpd responder that retrieves a continuation for the given
#! id and calls it with the POST data as a hashtable on the top
#! of the stack.
[
drop
#! The continuation id must be in a query parameter called 'id'.
#! 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 alist>hash
"id" "query" get assoc resume-continuation
] with-exit-continuation
print drop ;
id-or-root [
resume-continuation
] [
expired-page-handler
] ifte*
] with-exit-continuation [ write flush ] when* ;
: 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.
unit "callback-cc" get [ call ] cons append ;
[ , callback-cc get , \ call , ] make-list ;
: quot-href ( text quot -- )
#! Write to standard output an HTML HREF where the href,
@ -287,20 +292,16 @@ DEFER: show
#! back to the most recent 'show' call (via the callback-cc).
#! The text of the link will be the 'text' argument on the
#! stack.
<a href= callback-quot t swap register-continuation id>url a> write </a> ;
: with-new-session ( quot -- )
#! Each cont-responder is bound inside their own
#! namespace for storing session state. Run the given
#! quotation inside a new namespace for this purpose.
<namespace> swap bind ;
<a href= callback-quot expirable register-continuation id>url a> write </a> ;
: init-session-namespace ( -- )
#! Setup the initial session namespace. Currently this only
#! copies the global value of whether the initial redirect
#! will be disabled. It assumes the session namespace is
#! topmost on the namespace stack.
"disable-initial-redirect?" get "disable-initial-redirect?" set ;
#! sets the redirect flag so that the initial request of the
#! responder will not do a post-refresh-get style redirect.
#! This prevents the initial request to a responder from redirecting
#! to an URL with a continuation id. This word must be run from
#! within the session namespace.
f post-refresh-get? set ;
: install-cont-responder ( name quot -- )
#! Install a cont-responder with the given name
@ -308,20 +309,21 @@ DEFER: show
#!
#! Convert the quotation so it is run within a session namespace
#! and that namespace is initialized first.
[ init-session-namespace ] swap append unit [ with-new-session ] append
"httpd-responders" get [
<responder> [
[ cont-get-responder ] "get" set
[ cont-post-responder ] "post" set
over "responder-name" set
over "responder" set
reset-continuation-table
"disable-initial-redirect?" t put
] extend dup >r rot set
r> [
f swap register-continuation "root-continuation" set
] bind
] bind ;
\ init-session-namespace swons [ , \ with-scope , ] make-list
<responder> [
[ cont-get/post-responder ] "get" set
[ cont-get/post-responder ] "post" set
over "responder-name" set
over "responder" set
reset-continuation-table
permanent register-continuation root-continuation set
] extend swap "httpd-responders" get set-hash ;
: responder-items ( name -- items )
#! Return the table of continuation items for a given responder.
#! Useful for debugging.
"httpd-responders" get hash [ continuation-table ] bind ;
: simple-page ( title quot -- )
#! Call the quotation, with all output going to the