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

native factor httpd

cvs
Slava Pestov 2004-08-11 03:48:08 +00:00
parent cda61358bf
commit ac1855bc15
21 changed files with 107 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
TODO.FACTOR.txt
View File

@ -26,7 +26,6 @@
+ tests:
- finish split
- java factor: equal numbers have non-equal hashcodes!
- sbuf=
- vector-hashcode
@ -89,6 +88,9 @@ ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable
+ httpd:
- multitasking
- don't die if one client errors
- inspect: always use inspect/ URL prefix, not responder name var
- httpd: don't flush so much
- log with date
- log user agent

2
library/errors.factor
View File

@ -58,7 +58,7 @@ USE: vectors
namestack "error-namestack" set
catchstack "error-catchstack" set
] bind
] when* ;
] when ;
: catch ( try catch -- )
#! Call the try quotation. If an error occurs restore the

26
library/httpd/default-responders.factor
View File

@ -53,17 +53,17 @@ USE: wiki-responder
"quit" "responder" set
[ quit-responder ] "get" set
] extend "quit" set
<responder> [
"file" "responder" set
[ file-responder ] "get" set
] extend "file" set
<responder> [
"wiki" "responder" set
[ wiki-get-responder ] "get" set
[ wiki-post-responder ] "post" set
<namespace> "wiki" set
"WikiHome" "default-argument" set
] extend "wiki" set
!
! <responder> [
! "file" "responder" set
! [ file-responder ] "get" set
! ] extend "file" set
!
! <responder> [
! "wiki" "responder" set
! [ wiki-get-responder ] "get" set
! [ wiki-post-responder ] "post" set
! <namespace> "wiki" set
! "WikiHome" "default-argument" set
! ] extend "wiki" set
] extend "httpd-responders" set ;

4
library/httpd/html.factor
View File

@ -122,7 +122,9 @@ USE: url-encoding
] extend ;
: with-html-stream ( quot -- )
"stdio" get <html-stream> swap with-stream ;
[
"stdio" get <html-stream> "stdio" set call
] with-scope ;
: html-head ( title -- )
"<html><head><title>" write

1
library/httpd/quit-responder.factor
View File

@ -26,7 +26,6 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: quit-responder
USE: combinators
USE: namespaces
USE: stdio
USE: stack

12
library/httpd/test-responder.factor
View File

@ -26,13 +26,13 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: test-responder
USE: stdio
USE: prettyprint
USE: html
USE: httpd
USE: httpd-responder
USE: stack
USE: test
: test-responder ( argument -- )
serving-text
"This is the test responder." print
"Argument is " write . ;
drop
serving-html
"Factor Test Suite" [ all-tests ] simple-html-document ;

6
library/init.factor
View File

@ -133,7 +133,11 @@ USE: vocabularies
[ "top-level-continuation" set ] callcc0 ;
: (word-of-the-day) ( -- word )
vocabs random-element words random-element ;
vocabs random-element words dup [
random-element
] [
drop (word-of-the-day) ( empty vocab )
] ifte ;
: word-of-the-day ( -- )
#! Something to entertain the poor hacker.

2
library/inspector.factor
View File

@ -100,5 +100,5 @@ USE: vocabularies
: describe-object-path ( string -- )
[
dup "object-path" set
global-object-path describe
"'" split global [ object-path ] bind describe
] with-scope ;

4
library/namespaces.factor
View File

@ -121,10 +121,6 @@ USE: vectors
#! Returns f if any of the objects are not set.
this swap object-path-iter ;
: global-object-path ( string -- object )
#! An object path based from the global namespace.
"'" split global [ object-path ] bind ;
: on ( var -- ) t put ;
: off ( var -- ) f put ;
: toggle ( var -- ) dup get not put ;

2
library/platform/jvm/boot-sumo.factor
View File

@ -52,8 +52,8 @@ USE: parser
"/library/platform/jvm/errors.factor" run-resource ! errors
"/library/platform/jvm/namespaces.factor" run-resource ! namespaces
"/library/namespaces.factor" run-resource ! namespaces
"/library/sbuf.factor" run-resource ! strings
"/library/list-namespaces.factor" run-resource ! namespaces
"/library/sbuf.factor" run-resource ! strings
"/library/math/namespace-math.factor" run-resource ! arithmetic
"/library/continuations.factor" run-resource ! continuations
"/library/errors.factor" run-resource ! errors

4
library/platform/jvm/stack2.factor
View File

@ -69,3 +69,7 @@ USE: vectors
#! this from a word definition will clobber any values left
#! on the data stack by the caller.
datastack* vector-clear ;
: depth ( -- n )
#! Push the number of elements on the datastack.
datastack vector-length ;

24
library/platform/jvm/stream.factor
View File

@ -139,19 +139,6 @@ USE: strings
[ <char-stream>/fclose ] "fclose" set
] extend ;
: <string-output-stream> ( size -- stream )
#! Creates a new stream for writing to a string buffer.
<stream> [
<sbuf> "buf" set
( string -- )
[ "buf" get sbuf-append ] "fwrite" set
] extend ;
: stream>str ( stream -- string )
#! Returns the string written to the given string output
#! stream.
[ "buf" get ] bind >str ;
: <bwriter> ( writer -- bwriter )
[ "java.io.Writer" ] "java.io.BufferedWriter" jnew ;
@ -233,6 +220,15 @@ USE: strings
] "fclose" set
] extend ;
: socket-closed? ( socket -- ? )
[ ] "java.net.Socket" "isClosed" jinvoke ;
: close-socket ( socket -- )
[ ] "java.net.Socket" "close" jinvoke ;
: ?close-socket ( socket -- )
dup socket-closed? [ drop ] [ close-socket ] ifte ;
: <socket-stream> ( socket -- stream )
#! Wraps a socket inside a byte-stream.
dup
@ -245,7 +241,7 @@ USE: strings
! We "extend" byte-stream's fclose.
( -- )
"fclose" get [
"socket" get [ ] "java.net.Socket" "close" jinvoke
"socket" get ?close-socket
] append "fclose" set
] extend ;

4
library/platform/native/boot.factor
View File

@ -83,6 +83,10 @@ primitives,
"/library/httpd/http-common.factor"
"/library/httpd/responder.factor"
"/library/httpd/httpd.factor"
"/library/httpd/inspect-responder.factor"
"/library/httpd/test-responder.factor"
"/library/httpd/quit-responder.factor"
"/library/httpd/default-responders.factor"
"/library/math/arc-trig-hyp.factor"
"/library/math/arithmetic.factor"
"/library/math/list-math.factor"

2
library/platform/native/init.factor
View File

@ -75,7 +75,7 @@ USE: unparser
init-scratchpad
init-styles
init-vocab-styles
! default-responders
default-responders
run-user-init

3
library/platform/native/namespaces.factor
View File

@ -44,7 +44,8 @@ DEFER: >n
: set-global ( g -- ) 4 setenv ;
: init-namespaces ( -- )
64 <vector> set-namestack* global >n ;
64 <vector> set-namestack* global >n
global "global" set ;
: namespace-buckets 23 ;

6
library/platform/native/stack.factor
View File

@ -42,4 +42,8 @@ USE: vectors
#! Clear the datastack. For interactive use only; invoking
#! this from a word definition will clobber any values left
#! on the data stack by the caller.
0 <vector> set-datastack ;
{ } set-datastack ;
: depth ( -- n )
#! Push the number of elements on the datastack.
datastack vector-length ;

20
library/sbuf.factor
View File

@ -29,6 +29,7 @@ IN: strings
USE: arithmetic
USE: combinators
USE: kernel
USE: lists
USE: namespaces
USE: strings
USE: stack
@ -59,3 +60,22 @@ USE: stack
#! push a new string constructed from return values.
#! The quotation must have stack effect ( X -- X ).
<% swap [ swap dup >r call % r> ] str-each drop %> ;
: split-next ( index string split -- next )
3dup index-of* dup -1 = [
>r drop swap str-tail , r> ( end of string )
] [
swap str-length dupd + >r swap substring , r>
] ifte ;
: (split) ( index string split -- )
2dup >r >r split-next dup -1 = [
drop r> drop r> drop
] [
r> r> (split)
] ifte ;
: split ( string split -- list )
#! Split the string at each occurrence of split, and push a
#! list of the pieces.
[, 0 -rot (split) ,] ;

14
library/stream.factor
View File

@ -29,6 +29,7 @@ IN: streams
USE: errors
USE: kernel
USE: namespaces
USE: strings
! Generic functions, of sorts...
@ -102,3 +103,16 @@ USE: namespaces
( string -- )
[ "stream" get fprint ] "fprint" set
] extend ;
: <string-output-stream> ( size -- stream )
#! Creates a new stream for writing to a string buffer.
<stream> [
<sbuf> "buf" set
( string -- )
[ "buf" get sbuf-append ] "fwrite" set
] extend ;
: stream>str ( stream -- string )
#! Returns the string written to the given string output
#! stream.
[ "buf" get ] bind sbuf>str ;

13
library/strings.factor
View File

@ -114,19 +114,6 @@ USE: stack
[ = ] dip f ?
] ifte ;
: split ( string split -- list )
#! Split the string at each occurrence of split, and push a
#! list of the pieces.
2dup index-of dup -1 = [
2drop dup str-length 0 = [
drop f
] [
unit
] ifte
] [
swap [ str// ] dip split cons
] ifte ;
: split1 ( string split -- before after )
#! The car of the pair is the string up to the first
#! occurrence of split; the cdr is the remainder of

2
library/test/httpd/httpd.factor
View File

@ -65,8 +65,6 @@ USE: url-encoding
[ ] [ "/" "get" ] [ serve-responder ] test-word
[ ] [ "" "get" ] [ serve-responder ] test-word
[ ] [ "test" "get" ] [ serve-responder ] test-word
[ ] [ "test/" "get" ] [ serve-responder ] test-word
[ ] [ "does-not-exist!" "get" ] [ serve-responder ] test-word
[ ] [ "does-not-exist!/" "get" ] [ serve-responder ] test-word

15
library/test/test.factor
View File

@ -25,9 +25,15 @@ USE: vocabularies
: print-test ( input output -- )
"TESTING: " write 2list . ;
: keep-datastack ( quot -- )
datastack >r call r> set-datastack drop ;
: unit-test ( output input -- )
[
2dup print-test
swap >r >r clear r> call datastack vector>list r> = assert ;
swap >r >r clear r> call datastack vector>list r>
= assert
] keep-datastack 2drop ;
: test-word ( output input word -- )
#! Old-style test.
@ -44,8 +50,12 @@ USE: vocabularies
: test ( name -- )
! Run the given test.
depth pred >r
"Testing " write dup write "..." print
"/library/test/" swap ".factor" cat3 run-resource ;
"/library/test/" swap ".factor" cat3 run-resource
"Checking before/after depth..." print
depth r> = assert
;
: all-tests ( -- )
"Running Factor test suite..." print
@ -59,6 +69,7 @@ USE: vocabularies
"lists/namespaces"
"combinators"
"continuations"
"errors"
"hashtables"
"strings"
"namespaces/namespaces"