Refactorings of the cont-responder and sqlite code. The browser
responder now accepts 'word' and 'vocab' as query parameters. The cont-responder takes the continuation id as a query parameter instead of part of the url.cvs
Chris Double
parent
a1d6e58851
commit
f88bfcf2a8
|
|
@ -45,6 +45,7 @@ USE: errors
|
|||
USE: unparser
|
||||
USE: logging
|
||||
USE: listener
|
||||
USE: url-encoding
|
||||
|
||||
: <browser> ( allow-edit? vocab word -- )
|
||||
#! An object for storing the current browser
|
||||
|
|
@ -187,6 +188,15 @@ USE: listener
|
|||
] when*
|
||||
] catch ;
|
||||
|
||||
: browser-url ( vocab word -- url )
|
||||
#! Given a vocabulary and word as strings, return a browser
|
||||
#! URL which, when requested, will display the source to that
|
||||
#! word.
|
||||
[
|
||||
".?word=" , url-encode ,
|
||||
"&vocab=" , url-encode ,
|
||||
] make-string ;
|
||||
|
||||
: browse ( <browser> -- )
|
||||
#! Display a Smalltalk like browser for exploring/modifying words.
|
||||
[
|
||||
|
|
@ -216,12 +226,19 @@ USE: listener
|
|||
"vocabs" get
|
||||
"words" get
|
||||
"eval" get dup [ "vocabs" get swap eval-string ] [ drop ] ifte
|
||||
[
|
||||
"vocabs" get "words" get browser-url forward-to-url
|
||||
] show
|
||||
] bind <browser>
|
||||
] forever ;
|
||||
|
||||
: browser-responder ( allow-edit? -- )
|
||||
#! Start the Smalltalk-like browser.
|
||||
"browser" f <browser> browse ;
|
||||
"query" get dup [
|
||||
dup >r "vocab" swap assoc r> "word" swap assoc
|
||||
] [
|
||||
drop "browser" f
|
||||
] ifte <browser> browse ;
|
||||
|
||||
"browser" [ f browser-responder ] install-cont-responder
|
||||
!"browser-edit" [ t browser-responder ] install-cont-responder
|
||||
! "browser-edit" [ t browser-responder ] install-cont-responder
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ USE: logging
|
|||
USE: url-encoding
|
||||
USE: unparser
|
||||
USE: hashtables
|
||||
|
||||
USE: parser
|
||||
USE: prettyprint
|
||||
USE: inspector
|
||||
|
||||
|
|
@ -58,7 +58,7 @@ USE: inspector
|
|||
|
||||
: get-random-id ( -- id )
|
||||
#! Generate a random id to use for continuation URL's
|
||||
[ 16 [ random-digit unparse , ] times ] make-string ;
|
||||
[ 32 [ random-digit unparse , ] times ] make-string str>number 36 >base ;
|
||||
|
||||
: continuation-table ( -- <namespace> )
|
||||
#! Return the global table of continuations
|
||||
|
|
@ -127,6 +127,11 @@ USE: inspector
|
|||
#! Get the continuation item associated with the id.
|
||||
continuation-table [ get ] bind ;
|
||||
|
||||
: 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
|
||||
|
||||
: expired-page-handler ( alist -- )
|
||||
|
|
@ -195,6 +200,15 @@ DEFER: show
|
|||
#! stream. Return the string on exit.
|
||||
1024 <string-output> dup >r swap with-stream r> stream>str ;
|
||||
|
||||
: forward-to-url ( url -- )
|
||||
#! When executed inside a 'show' call, this will force a
|
||||
#! HTTP 302 to occur to instruct the browser to forward to
|
||||
#! the request URL.
|
||||
[
|
||||
"HTTP/1.1 302 Document Moved\nLocation: " , ,
|
||||
"\nContent-Length: 0\nContent-Type: text/plan\n\n" ,
|
||||
] make-string call-exit-continuation ;
|
||||
|
||||
: redirect-to-here ( -- )
|
||||
#! Force a redirect to the client browser so that the browser
|
||||
#! goes to the current point in the code. This forces an URL
|
||||
|
|
@ -208,7 +222,7 @@ DEFER: show
|
|||
] [
|
||||
[
|
||||
t swap register-continuation
|
||||
[ "HTTP/1.1 302 Document Moved\nLocation: " , , "\n" ,
|
||||
[ "HTTP/1.1 302 Document Moved\nLocation: " , id>url , "\n" ,
|
||||
"Content-Length: 0\nContent-Type: text/plain\n\n" , ] make-string
|
||||
call-exit-continuation
|
||||
] callcc1 drop
|
||||
|
|
@ -226,7 +240,7 @@ DEFER: show
|
|||
store-callback-cc
|
||||
redirect-enabled? [ redirect-to-here ] when
|
||||
[
|
||||
t swap register-continuation swap
|
||||
t swap register-continuation id>url swap
|
||||
[ serving-html ] car swons with-string-stream
|
||||
call-exit-continuation
|
||||
] callcc1
|
||||
|
|
@ -235,6 +249,8 @@ DEFER: show
|
|||
|
||||
: cont-get-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 [
|
||||
|
|
@ -255,7 +271,9 @@ DEFER: show
|
|||
#! id and calls it with the POST data as a hashtable on the top
|
||||
#! of the stack.
|
||||
[
|
||||
"response" get alist>hash swap resume-continuation
|
||||
drop
|
||||
"response" get alist>hash
|
||||
"id" "query" get assoc resume-continuation
|
||||
] with-exit-continuation
|
||||
print drop ;
|
||||
|
||||
|
|
@ -271,7 +289,7 @@ 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 a> write </a> ;
|
||||
<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
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@
|
|||
! eg.
|
||||
! <cont-test-state> [ test-cont-responder ] test-cont-function
|
||||
! => HTTP/1.1 302 Document Moved
|
||||
! Location: 8506502852110820
|
||||
! Location: ?id=8506502852110820
|
||||
! Content-Length: 0
|
||||
! Content-Type: text/plain
|
||||
!
|
||||
|
|
@ -48,12 +48,12 @@
|
|||
! Content-Type: text/html
|
||||
!
|
||||
! <html><head><title>Page one</title></head><body>
|
||||
! <h1>Page one</h1><a href='5431597582800278'>Next</a>
|
||||
! <h1>Page one</h1><a href='?id=5431597582800278'>Next</a>
|
||||
! </body></html>
|
||||
!
|
||||
! "5431597582800278" f test-cont-click
|
||||
! => HTTP/1.1 302 Document Moved
|
||||
! Location: 7944183606904129
|
||||
! Location: ?id=7944183606904129
|
||||
! Content-Length: 0
|
||||
! Content-Type: text/plain
|
||||
!
|
||||
|
|
@ -63,14 +63,14 @@
|
|||
!
|
||||
! <html><head><title>Enter your name</title></head>
|
||||
! <body><h1>Enter your name</h1>
|
||||
! <form method='post'action='8503790719833723'>
|
||||
! Name: <input type='text'name='name'size='20'>
|
||||
! <input type='submit'value='Ok'>
|
||||
! <form method='post' action='?id=8503790719833723'>
|
||||
! Name: <input type='text' name='name'size='20'>
|
||||
! <input type='submit' value='Ok'>
|
||||
! </form></body></html>
|
||||
!
|
||||
! "8503790719833723" [ [ "name" | "Chris" ] ] alist>hash test-cont-click
|
||||
! "8503790719833723" [ [[ "name" "Chris" ]] ] alist>hash test-cont-click
|
||||
! => HTTP/1.1 302 Document Moved
|
||||
! Location: 8879727708050260
|
||||
! Location: ?id=8879727708050260
|
||||
! Content-Length: 0
|
||||
! Content-Type: text/plain
|
||||
!
|
||||
|
|
@ -80,7 +80,7 @@
|
|||
!
|
||||
! <html><head><title>Hello Chris</title></head>
|
||||
! <body><h1>Hello Chris</h1>
|
||||
! <a href='0937854264503953'>Next</a>
|
||||
! <a href='?id=0937854264503953'>Next</a>
|
||||
! </body></html>
|
||||
!
|
||||
! etc.
|
||||
|
|
|
|||
|
|
@ -47,7 +47,7 @@ USE: lists
|
|||
[
|
||||
"js/liveUpdater.js" get-live-updater-js write
|
||||
] show
|
||||
] register-continuation ;
|
||||
] register-continuation id>url ;
|
||||
|
||||
: include-live-updater-js ( -- )
|
||||
#! Write out the HTML script to include the live updater
|
||||
|
|
@ -96,7 +96,7 @@ USE: lists
|
|||
"document.getElementById('" write
|
||||
write
|
||||
"').onclick=liveUpdaterUri('" write
|
||||
register-live-anchor-quot write
|
||||
register-live-anchor-quot id>url write
|
||||
"');" write
|
||||
</script> ;
|
||||
|
||||
|
|
@ -153,7 +153,7 @@ USE: lists
|
|||
"liveSearch('" write
|
||||
write
|
||||
"', '" write
|
||||
register-live-search-quot write
|
||||
register-live-search-quot id>url write
|
||||
"');" write
|
||||
</script> ;
|
||||
|
||||
|
|
|
|||
|
|
@ -107,7 +107,7 @@ USE: kernel
|
|||
|
||||
: todo-stylesheet-url ( -- url )
|
||||
#! Generate an URL for the stylesheet.
|
||||
t [ [ drop todo-stylesheet write ] show ] register-continuation ;
|
||||
t [ [ drop todo-stylesheet write ] show ] register-continuation id>url ;
|
||||
|
||||
: include-todo-stylesheet ( -- )
|
||||
#! Generate HTML to include the todo stylesheet
|
||||
|
|
|
|||
|
|
@ -331,10 +331,10 @@ 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 a number at the end of
|
||||
them. 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 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.
|
||||
|
||||
Forms and POST data
|
||||
===================
|
||||
|
|
@ -603,7 +603,7 @@ calls the code we want to test and call the 'test-cont-function' word:
|
|||
<cont-test-state> [ subroutine-example1 ] test-cont-function
|
||||
=>
|
||||
HTTP/1.1 302 Document Moved
|
||||
Location: 8209741119458310
|
||||
Location: ?id=8209741119458310
|
||||
Content-Length: 0
|
||||
Content-Type: text/plain
|
||||
|
||||
|
|
@ -628,9 +628,9 @@ state on the stack:
|
|||
Content-Type: text/html
|
||||
<html><head><title>Subroutine Example 1</title></head>
|
||||
<body><p>Please select:
|
||||
<ol><li><a href='7687398605200513'>Flow1</a></li>
|
||||
<li><a href='7856272029924613'>Flow2</a></li>
|
||||
<li><a href='4909116160485714'>Flow3</a></li>
|
||||
<ol><li><a href='?id=7687398605200513'>Flow1</a></li>
|
||||
<li><a href='?id=7856272029924613'>Flow2</a></li>
|
||||
<li><a href='?id=4909116160485714'>Flow3</a></li>
|
||||
</ol>
|
||||
</p>
|
||||
</body>
|
||||
|
|
@ -645,7 +645,7 @@ written previously:
|
|||
<cont-test-state> [ post-example1 ] test-cont-function
|
||||
=>
|
||||
HTTP/1.1 302 Document Moved
|
||||
Location: 5829759941409535
|
||||
Location: ?id=5829759941409535
|
||||
Content-Length: 0
|
||||
Content-Type: text/plain
|
||||
|
||||
|
|
@ -658,7 +658,7 @@ Again we skip past the forward:
|
|||
|
||||
<html><head><title>Please enter your name</title></head>
|
||||
<body>
|
||||
<form action='5456539333180428' method='post'>
|
||||
<form action='?id=5456539333180428' method='post'>
|
||||
<p>Please enter your name:
|
||||
<input type='text'size='20'name='username'>
|
||||
<input type='submit'value='Ok'>
|
||||
|
|
|
|||
|
|
@ -28,10 +28,6 @@
|
|||
! Not all functions have been wrapped yet. Only those directly involving
|
||||
! executing SQL calls and obtaining results.
|
||||
!
|
||||
! TODO: Do I have to free stuctures like <sqlite3> and <char*>, etc
|
||||
! or do they get freed on garbage collection?
|
||||
! How do I do pointers to pointers? Use the 'indirect' trick?
|
||||
!
|
||||
IN: sqlite
|
||||
USE: kernel
|
||||
USE: alien
|
||||
|
|
@ -98,77 +94,58 @@ END-STRUCT
|
|||
: SQLITE_TRANSIENT -1 ;
|
||||
|
||||
: sqlite3_open ( filename sqlite3-indirect -- result )
|
||||
"int" "sqlite" "sqlite3_open" [ "char*" "sqlite3-indirect*" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_open" [ "char*" "sqlite3-indirect*" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_close ( db -- )
|
||||
"int" "sqlite" "sqlite3_close" [ "sqlite3*" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_close" [ "sqlite3*" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_prepare ( db sql sql-len sqlite3-stmt-indirect tail -- result )
|
||||
"int" "sqlite" "sqlite3_prepare" [ "sqlite3*" "char*" "int" "sqlite3-stmt-indirect*" "char*-indirect*" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_prepare" [ "sqlite3*" "char*" "int" "sqlite3-stmt-indirect*" "char*-indirect*" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_finalize ( stmt -- result )
|
||||
"int" "sqlite" "sqlite3_finalize" [ "sqlite3-stmt*" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_finalize" [ "sqlite3-stmt*" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_reset ( stmt -- result )
|
||||
"int" "sqlite" "sqlite3_reset" [ "sqlite3-stmt*" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_reset" [ "sqlite3-stmt*" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_step ( stmt -- result )
|
||||
"int" "sqlite" "sqlite3_step" [ "sqlite3-stmt*" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_step" [ "sqlite3-stmt*" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_bind_blob ( stmt index pointer len destructor -- result )
|
||||
"int" "sqlite" "sqlite3_bind_blob" [ "sqlite3-stmt*" "int" "void*" "int" "int" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_bind_blob" [ "sqlite3-stmt*" "int" "void*" "int" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_bind_int ( stmt index int -- result )
|
||||
"int" "sqlite" "sqlite3_bind_int" [ "sqlite3-stmt*" "int" "int" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_bind_int" [ "sqlite3-stmt*" "int" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_bind_null ( stmt index -- result )
|
||||
"int" "sqlite" "sqlite3_bind_null" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_bind_null" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_bind_text ( stmt index text len destructor -- result )
|
||||
"int" "sqlite" "sqlite3_bind_text" [ "sqlite3-stmt*" "int" "char*" "int" "int" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_bind_text" [ "sqlite3-stmt*" "int" "char*" "int" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_column_count ( stmt -- count )
|
||||
"int" "sqlite" "sqlite3_column_count" [ "sqlite3-stmt*" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_column_count" [ "sqlite3-stmt*" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_column_blob ( stmt col -- void* )
|
||||
"void*" "sqlite" "sqlite3_column_blob" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
||||
"void*" "sqlite" "sqlite3_column_blob" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_column_bytes ( stmt col -- int )
|
||||
"int" "sqlite" "sqlite3_column_bytes" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_column_bytes" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_column_decltype ( stmt col -- string )
|
||||
"char*" "sqlite" "sqlite3_column_decltype" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
||||
"char*" "sqlite" "sqlite3_column_decltype" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_column_int ( stmt col -- int )
|
||||
"int" "sqlite" "sqlite3_column_int" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
||||
"int" "sqlite" "sqlite3_column_int" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_column_name ( stmt col -- string )
|
||||
"char*" "sqlite" "sqlite3_column_name" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
||||
"char*" "sqlite" "sqlite3_column_name" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_column_text ( stmt col -- string )
|
||||
"char*" "sqlite" "sqlite3_column_text" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
||||
"char*" "sqlite" "sqlite3_column_text" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
|
||||
|
||||
: sqlite3_column_type ( stmt col -- int )
|
||||
"int" "sqlite" "sqlite3_column_type" [ "sqlite3-stmt*" "int" ] alien-invoke ;
|
||||
|
||||
\ sqlite3_open compile
|
||||
\ sqlite3_close compile
|
||||
\ sqlite3_prepare compile
|
||||
\ sqlite3_finalize compile
|
||||
\ sqlite3_reset compile
|
||||
\ sqlite3_bind_blob compile
|
||||
\ sqlite3_bind_int compile
|
||||
\ sqlite3_bind_null compile
|
||||
\ sqlite3_bind_text compile
|
||||
\ sqlite3_step compile
|
||||
\ sqlite3_column_count compile
|
||||
\ sqlite3_column_blob compile
|
||||
\ sqlite3_column_bytes compile
|
||||
\ sqlite3_column_decltype compile
|
||||
\ sqlite3_column_int compile
|
||||
\ sqlite3_column_name compile
|
||||
\ sqlite3_column_text compile
|
||||
\ sqlite3_column_type compile
|
||||
"int" "sqlite" "sqlite3_column_type" [ "sqlite3-stmt*" "int" ] alien-invoke ; compiled
|
||||
|
||||
! High level sqlite routines
|
||||
: sqlite-check-result ( result -- )
|
||||
|
|
@ -220,26 +197,32 @@ END-STRUCT
|
|||
#! from zero, as a string.
|
||||
sqlite3_column_text ;
|
||||
|
||||
: (sqlite-each)
|
||||
"statement" get sqlite3_step dup SQLITE_ROW = [
|
||||
drop
|
||||
"statement" get "quot" get call (sqlite-each)
|
||||
: step-complete? ( step-result -- bool )
|
||||
#! Return true if the result of a sqlite3_step is
|
||||
#! such that the iteration has completed (ie. it is
|
||||
#! SQLITE_DONE). Throw an error if an error occurs.
|
||||
dup SQLITE_ROW = [
|
||||
drop f
|
||||
] [
|
||||
dup SQLITE_DONE = [
|
||||
drop
|
||||
drop t
|
||||
] [
|
||||
sqlite-check-result
|
||||
] ifte
|
||||
] ifte ;
|
||||
|
||||
: sqlite-each ( statement quot -- )
|
||||
#! Excecute the SQL statement, and call the quotation for
|
||||
#! Execute the SQL statement, and call the quotation for
|
||||
#! each row returned from executing the statement with the
|
||||
#! statement on the top of the stack.
|
||||
#! TODO: Implement without named parameters
|
||||
<namespace> [
|
||||
"quot" set
|
||||
"statement" set
|
||||
(sqlite-each)
|
||||
] bind ;
|
||||
over sqlite3_step step-complete? [
|
||||
2drop
|
||||
] [
|
||||
2dup 2slip sqlite-each
|
||||
] ifte ;
|
||||
|
||||
! For comparison, here is the linrec implementation of sqlite-each
|
||||
! [ drop sqlite3_step step-complete? ]
|
||||
! [ 2drop ]
|
||||
! [ 2dup 2slip ]
|
||||
! [ ] linrec ;
|
||||
|
|
@ -47,4 +47,9 @@ USE: prettyprint
|
|||
sqlite-finalize
|
||||
sqlite-close ;
|
||||
|
||||
: run-test2 ( -- )
|
||||
"test.db" sqlite-open
|
||||
dup "select * from test" sqlite-prepare
|
||||
dup [ show-people ] ;
|
||||
|
||||
run-test
|
||||
Loading…
Reference in New Issue