2008-09-19 16:45:27 -04:00
|
|
|
! Copyright (C) 2008 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-06-02 16:38:44 -04:00
|
|
|
USING: math kernel accessors http.server http.server.dispatchers
|
2008-06-17 06:21:45 -04:00
|
|
|
furnace furnace.actions furnace.sessions furnace.redirection
|
2008-09-23 04:35:01 -04:00
|
|
|
html.components html.forms fry urls ;
|
2008-04-29 06:58:34 -04:00
|
|
|
IN: webapps.counter
|
|
|
|
|
|
|
|
SYMBOL: count
|
|
|
|
|
|
|
|
TUPLE: counter-app < dispatcher ;
|
|
|
|
|
2008-05-26 01:47:27 -04:00
|
|
|
M: counter-app init-session* drop 0 count sset ;
|
2008-04-29 06:58:34 -04:00
|
|
|
|
2008-05-26 01:47:27 -04:00
|
|
|
: <counter-action> ( quot -- action )
|
|
|
|
<action>
|
2008-06-01 18:22:39 -04:00
|
|
|
swap '[
|
2008-09-10 23:11:40 -04:00
|
|
|
count _ schange
|
2008-06-01 18:22:39 -04:00
|
|
|
URL" $counter-app" <redirect>
|
|
|
|
] >>submit ;
|
2008-04-30 17:12:14 -04:00
|
|
|
|
2008-04-29 06:58:34 -04:00
|
|
|
: <display-action> ( -- action )
|
2008-05-26 01:47:27 -04:00
|
|
|
<page-action>
|
|
|
|
[ count sget "counter" set-value ] >>init
|
2008-06-02 16:00:03 -04:00
|
|
|
{ counter-app "counter" } >>template ;
|
2008-04-29 06:58:34 -04:00
|
|
|
|
|
|
|
: <counter-app> ( -- responder )
|
|
|
|
counter-app new-dispatcher
|
|
|
|
[ 1+ ] <counter-action> "inc" add-responder
|
|
|
|
[ 1- ] <counter-action> "dec" add-responder
|
2008-09-29 18:15:03 -04:00
|
|
|
<display-action> "" add-responder ;
|
2008-09-19 16:45:27 -04:00
|
|
|
|
|
|
|
! Deployment example
|
2008-09-23 04:35:01 -04:00
|
|
|
USING: db.sqlite furnace.alloy namespaces ;
|
2008-09-19 16:45:27 -04:00
|
|
|
|
|
|
|
: counter-db ( -- params db ) "counter.db" sqlite-db ;
|
|
|
|
|
|
|
|
: run-counter ( -- )
|
|
|
|
<counter-app>
|
2008-09-23 04:35:01 -04:00
|
|
|
counter-db <alloy>
|
2008-09-19 16:45:27 -04:00
|
|
|
main-responder set-global
|
|
|
|
8080 httpd ;
|
|
|
|
|
|
|
|
MAIN: run-counter
|