Debugging web framework and cleaning things up

diff --git a/extra/furnace/actions/actions.factor b/extra/furnace/actions/actions.factor
index 4b431c83bca65450c0bbdb83cffc5349d7839ba2..6448fcdf07c3ff0355cb6d04f1e451a029f2a2a6 100755 (executable)
--- a/extra/furnace/actions/actions.factor
+++ b/extra/furnace/actions/actions.factor
@@ -110,7 +110,7 @@ M: action call-responder* ( path action -- response )
     } case ;\r
 \r
 M: action modify-form\r
-    drop request get url>> revalidate-url-key hidden-form-field ;\r
+    drop url get revalidate-url-key hidden-form-field ;\r
 \r
 : check-validation ( -- )\r
     validation-failed? [ validation-failed ] when ;\r

diff --git a/extra/furnace/asides/asides.factor b/extra/furnace/asides/asides.factor
index 9f1411188c66f3f557195de015ae38ac818bf644..6d41c637c684123de24bc2805d86147958e54f8b 100644 (file)
--- a/extra/furnace/asides/asides.factor
+++ b/extra/furnace/asides/asides.factor
@@ -1,10 +1,17 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors namespaces sequences arrays kernel
-assocs assocs.lib hashtables math.parser urls combinators
-html.elements html.templates.chloe.syntax db.types db.tuples
-http http.server http.server.filters 
-furnace furnace.cache furnace.sessions furnace.redirection ;
+assocs hashtables math.parser urls combinators
+logging db.types db.tuples
+html.elements
+html.templates.chloe.syntax
+http
+http.server
+http.server.filters 
+furnace
+furnace.cache
+furnace.sessions
+furnace.redirection ;
 IN: furnace.asides
 
 TUPLE: aside < server-state session method url post-data ;
@@ -44,6 +51,8 @@ TUPLE: asides < server-state-manager ;
     url>> path>> split-path
     asides get responder>> call-responder ;
 
+\ end-aside-post DEBUG add-input-logging
+
 ERROR: end-aside-in-get-error ;
 
 : get-aside ( id -- aside )

diff --git a/extra/furnace/auth/auth.factor b/extra/furnace/auth/auth.factor
index ae042f05bd7892059c78de0b30092705852459fe..0c21c9f18d41f153bf83515e06daa7dcf4fe6efa 100755 (executable)
--- a/extra/furnace/auth/auth.factor
+++ b/extra/furnace/auth/auth.factor
@@ -1,7 +1,7 @@
 ! Copyright (c) 2008 Slava Pestov\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: accessors assocs namespaces kernel sequences sets\r
-destructors combinators fry\r
+destructors combinators fry logging\r
 io.encodings.utf8 io.encodings.string io.binary random\r
 checksums checksums.sha2\r
 html.forms\r
@@ -18,7 +18,11 @@ IN: furnace.auth
 \r
 SYMBOL: logged-in-user\r
 \r
-: logged-in? ( -- ? ) logged-in-user get >boolean ;\r
+: logged-in? ( -- ? )\r
+    logged-in-user get >boolean ;\r
+\r
+: username ( -- string/f )\r
+    logged-in-user get dup [ username>> ] when ;\r
 \r
 GENERIC: init-user-profile ( responder -- )\r
 \r
@@ -30,9 +34,6 @@ M: dispatcher init-user-profile
 M: filter-responder init-user-profile\r
     responder>> init-user-profile ;\r
 \r
-: have-capability? ( capability -- ? )\r
-    logged-in-user get capabilities>> member? ;\r
-\r
 : profile ( -- assoc ) logged-in-user get profile>> ;\r
 \r
 : user-changed ( -- )\r
@@ -59,6 +60,8 @@ TUPLE: realm < dispatcher name users checksum secure ;
 \r
 GENERIC: login-required* ( realm -- response )\r
 \r
+GENERIC: init-realm ( realm -- )\r
+\r
 GENERIC: logged-in-username ( realm -- username )\r
 \r
 : login-required ( -- * ) realm get login-required* exit-with ;\r
@@ -87,9 +90,16 @@ M: user-saver dispose
 : init-user ( user -- )\r
     [ [ logged-in-user set ] [ save-user-after ] bi ] when* ;\r
 \r
+\ init-user DEBUG add-input-logging\r
+\r
 M: realm call-responder* ( path responder -- response )\r
     dup realm set\r
-    dup logged-in-username dup [ users get-user ] when init-user\r
+    logged-in? [\r
+        dup init-realm\r
+        dup logged-in-username\r
+        dup [ users get-user ] when\r
+        init-user\r
+    ] unless\r
     call-next-method ;\r
 \r
 : encode-password ( string salt -- bytes )\r
@@ -122,18 +132,18 @@ TUPLE: protected < filter-responder description capabilities ;
     protected new\r
         swap >>responder ;\r
 \r
-: check-capabilities ( responder user/f -- ? )\r
-    {\r
+: have-capabilities? ( capabilities -- ? )\r
+    logged-in-user get {\r
         { [ dup not ] [ 2drop f ] }\r
         { [ dup deleted>> 1 = ] [ 2drop f ] }\r
-        [ [ capabilities>> ] bi@ subset? ]\r
+        [ capabilities>> subset? ]\r
     } cond ;\r
 \r
 M: protected call-responder* ( path responder -- response )\r
     '[\r
         , ,\r
         dup protected set\r
-        dup logged-in-user get check-capabilities\r
+        dup capabilities>> have-capabilities?\r
         [ call-next-method ] [ 2drop realm get login-required* ] if\r
     ] if-secure-realm ;\r
 \r

diff --git a/extra/furnace/auth/features/edit-profile/edit-profile.factor b/extra/furnace/auth/features/edit-profile/edit-profile.factor
index e03fca99a5f4dcb8812cf592bd3da11b87402403..da6acece61cd04e8644a594558770b759ed5ec8d 100644 (file)
--- a/extra/furnace/auth/features/edit-profile/edit-profile.factor
+++ b/extra/furnace/auth/features/edit-profile/edit-profile.factor
@@ -22,7 +22,7 @@ IN: furnace.auth.features.edit-profile
         { realm "features/edit-profile/edit-profile" } >>template
 
         [
-            logged-in-user get username>> "username" set-value
+            username "username" set-value
 
             {
                 { "realname" [ [ v-one-line ] v-optional ] }
@@ -34,7 +34,7 @@ IN: furnace.auth.features.edit-profile
 
             { "password" "new-password" "verify-password" }
             [ value empty? not ] contains? [
-                "password" value logged-in-user get username>> check-login
+                "password" value username check-login
                 [ "incorrect password" validation-error ] unless
 
                 same-password-twice

diff --git a/extra/furnace/auth/features/recover-password/recover-password.factor b/extra/furnace/auth/features/recover-password/recover-password.factor
index 93b3a7ad73a1cdc567b7856015f12fa8c3ee52e6..77915f10831c8d1cbee20a5b983dd46be5e994e6 100644 (file)
--- a/extra/furnace/auth/features/recover-password/recover-password.factor
+++ b/extra/furnace/auth/features/recover-password/recover-password.factor
@@ -11,7 +11,7 @@ IN: furnace.auth.features.recover-password
 SYMBOL: lost-password-from
 
 : current-host ( -- string )
-    request get url>> host>> host-name or ;
+    url get host>> host-name or ;
 
 : new-password-url ( user -- url )
     URL" recover-3" clone

diff --git a/extra/furnace/auth/login/login.factor b/extra/furnace/auth/login/login.factor
index ce533bce644036491a977c7f54b52f5e0b059fb8..9246780a94c447782946c1cdaef45f71d99a9ef7 100755 (executable)
--- a/extra/furnace/auth/login/login.factor
+++ b/extra/furnace/auth/login/login.factor
@@ -1,7 +1,7 @@
 ! Copyright (c) 2008 Slava Pestov\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: kernel accessors namespaces sequences math.parser\r
-calendar validators urls html.forms\r
+calendar validators urls logging html.forms\r
 http http.server http.server.dispatchers\r
 furnace\r
 furnace.auth\r
@@ -25,10 +25,8 @@ SYMBOL: permit-id
 \r
 TUPLE: login-realm < realm timeout domain ;\r
 \r
-M: login-realm call-responder*\r
-    [ name>> client-permit-id permit-id set ]\r
-    [ call-next-method ]\r
-    bi ;\r
+M: login-realm init-realm\r
+    name>> client-permit-id permit-id set ;\r
 \r
 M: login-realm logged-in-username\r
     drop permit-id get dup [ get-permit-uid ] when ;\r
@@ -47,11 +45,15 @@ M: login-realm modify-form ( responder -- )
 : put-permit-cookie ( response -- response' )\r
     <permit-cookie> put-cookie ;\r
 \r
+\ put-permit-cookie DEBUG add-input-logging\r
+\r
 : successful-login ( user -- response )\r
     [ username>> make-permit permit-id set ] [ init-user ] bi\r
     URL" $realm" end-aside\r
     put-permit-cookie ;\r
 \r
+\ successful-login DEBUG add-input-logging\r
+\r
 : logout ( -- )\r
     permit-id get [ delete-permit ] when*\r
     URL" $realm" end-aside ;\r

diff --git a/extra/furnace/auth/login/permits/permits.factor b/extra/furnace/auth/login/permits/permits.factor
index ae9458f4ace0e33d779e77454182a366172e505b..1a9784f1478d011b152d942c8b14f16ff3bb1044 100644 (file)
--- a/extra/furnace/auth/login/permits/permits.factor
+++ b/extra/furnace/auth/login/permits/permits.factor
@@ -1,7 +1,5 @@
-USING: accessors namespaces combinators.lib kernel
-db.tuples db.types
-furnace.auth furnace.sessions furnace.cache
-combinators.short-circuit ;
+USING: accessors namespaces kernel combinators.short-circuit
+db.tuples db.types furnace.auth furnace.sessions furnace.cache ;
 
 IN: furnace.auth.login.permits
 

diff --git a/extra/furnace/boilerplate/boilerplate.factor b/extra/furnace/boilerplate/boilerplate.factor
index 2bb97e7c14be76ea3965b5aaa8979c179154e524..59f71b15242d0308edd69d8d6bef291ced2c1c85 100644 (file)
--- a/extra/furnace/boilerplate/boilerplate.factor
+++ b/extra/furnace/boilerplate/boilerplate.factor
@@ -1,13 +1,12 @@
 ! Copyright (c) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math.order namespaces combinators.lib
+USING: accessors kernel math.order namespaces furnace combinators.short-circuit
 html.forms
 html.templates
 html.templates.chloe
 locals
 http.server
-http.server.filters
-furnace combinators.short-circuit ;
+http.server.filters ;
 IN: furnace.boilerplate
 
 TUPLE: boilerplate < filter-responder template init ;

diff --git a/extra/furnace/flash/flash.factor b/extra/furnace/flash/flash.factor
index 2149e4fcd773db3c0d4cd39058a028e49296254b..16d61487e3b581c09b32af1695e4f6e9b820dcdd 100644 (file)
--- a/extra/furnace/flash/flash.factor
+++ b/extra/furnace/flash/flash.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces assocs assocs.lib kernel sequences accessors
+USING: namespaces assocs kernel sequences accessors
 urls db.types db.tuples math.parser fry
 http http.server http.server.filters http.server.redirection
 furnace furnace.cache furnace.sessions furnace.redirection ;

diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor
index 242e193013365a1e8e5f29dc4658e8eb55c9d3f5..45aa55f0506efb9c004ce1fb352384b8354d7760 100644 (file)
--- a/extra/furnace/furnace.factor
+++ b/extra/furnace/furnace.factor
@@ -86,7 +86,7 @@ M: object modify-form drop ;
     "user-agent" request get header>> at "" or ;
 
 : same-host? ( url -- ? )
-    request get url>>
+    url get
     [ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ = ;
 
 : cookie-client-state ( key request -- value/f )

diff --git a/extra/furnace/redirection/redirection.factor b/extra/furnace/redirection/redirection.factor
index 88d621b57382ffe05b6a6dceb1fa3906266d60b5..83941cd08f32de060f40dd1a10d30e91fd71b87f 100644 (file)
--- a/extra/furnace/redirection/redirection.factor
+++ b/extra/furnace/redirection/redirection.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors combinators namespaces fry
-io.servers.connection
+io.servers.connection urls
 http http.server http.server.redirection http.server.filters
 furnace ;
 IN: furnace.redirection
@@ -33,8 +33,8 @@ TUPLE: secure-only < filter-responder ;
 C: <secure-only> secure-only
 
 : if-secure ( quot -- )
-    >r request get url>> protocol>> "http" =
-    [ request get url>> <secure-redirect> ]
+    >r url get protocol>> "http" =
+    [ url get <secure-redirect> ]
     r> if ; inline
 
 M: secure-only call-responder*

diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor
index 5590a9e55e874e30af4114896c57b514bb23381e..31711f54e9e2804d0b58f5c9eeeb7837c911655a 100755 (executable)
--- a/extra/furnace/sessions/sessions.factor
+++ b/extra/furnace/sessions/sessions.factor
@@ -2,12 +2,12 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs kernel math.intervals math.parser namespaces
 strings random accessors quotations hashtables sequences continuations
-fry calendar combinators combinators.lib destructors alarms
+fry calendar combinators combinators.short-circuit destructors alarms
 io.servers.connection
 db db.tuples db.types
 http http.server http.server.dispatchers http.server.filters
 html.elements
-furnace furnace.cache combinators.short-circuit ;
+furnace furnace.cache ;
 IN: furnace.sessions
 
 TUPLE: session < server-state namespace user-agent client changed? ;

diff --git a/extra/furnace/syndication/syndication.factor b/extra/furnace/syndication/syndication.factor
index 7f60bcc7469d4ac10dc8ab5aa5f89c9c1c73155c..31a978aef3d00c6fc524b439e7366cd5eb14cbb8 100644 (file)
--- a/extra/furnace/syndication/syndication.factor
+++ b/extra/furnace/syndication/syndication.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences fry sequences.lib
+USING: accessors kernel sequences fry
 combinators syndication
 http.server.responses http.server.redirection
 furnace furnace.actions ;

diff --git a/extra/http/http.factor b/extra/http/http.factor
index bf55cdebfa35d1d8f487e0e86a9c55dafcb60e46..90b8b8692133d55ca8b4c0cbfc2a622161a73a9c 100755 (executable)
--- a/extra/http/http.factor
+++ b/extra/http/http.factor
@@ -114,10 +114,13 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s
         ]
     } case ;
 
+: check-cookie-value ( string -- string )
+    [ "Cookie value must not be f" throw ] unless* ;
+
 : (unparse-cookie) ( cookie -- strings )
     [
         dup name>> check-cookie-string >lower
-        over value>> unparse-cookie-value
+        over value>> check-cookie-value unparse-cookie-value
         "$path" over path>> unparse-cookie-value
         "$domain" over domain>> unparse-cookie-value
         drop
@@ -129,7 +132,7 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s
 : unparse-set-cookie ( cookie -- string )
     [
         dup name>> check-cookie-string >lower
-        over value>> unparse-cookie-value
+        over value>> check-cookie-value unparse-cookie-value
         "path" over path>> unparse-cookie-value
         "domain" over domain>> unparse-cookie-value
         "expires" over expires>> unparse-cookie-value

diff --git a/extra/http/parsers/parsers.factor b/extra/http/parsers/parsers.factor
index bc6e1148c352a4f71815a3194c633bbab8c314a1..746741c8945f1f162d6a6a30b022550273318bf5 100644 (file)
--- a/extra/http/parsers/parsers.factor
+++ b/extra/http/parsers/parsers.factor
@@ -1,4 +1,4 @@
-USING: combinators.short-circuit math math.order math.parser kernel combinators.lib
+USING: combinators.short-circuit math math.order math.parser kernel
 sequences sequences.deep peg peg.parsers assocs arrays
 hashtables strings unicode.case namespaces ascii ;
 IN: http.parsers

diff --git a/extra/http/server/cgi/cgi.factor b/extra/http/server/cgi/cgi.factor
index 3a13b6de39131e502b69a520f897823b2e92d0cc..354ebd8f704513accc98e4b64670bf3e3e074a90 100755 (executable)
--- a/extra/http/server/cgi/cgi.factor
+++ b/extra/http/server/cgi/cgi.factor
@@ -14,10 +14,10 @@ IN: http.server.cgi
 \r
         [ "PATH_TRANSLATED" set ] [ "SCRIPT_FILENAME" set ] bi\r
 \r
-        request get url>> path>> "SCRIPT_NAME" set\r
+        url get path>> "SCRIPT_NAME" set\r
 \r
-        request get url>> host>> "SERVER_NAME" set\r
-        request get url>> port>> number>string "SERVER_PORT" set\r
+        url get host>> "SERVER_NAME" set\r
+        url get port>> number>string "SERVER_PORT" set\r
         "" "PATH_INFO" set\r
         "" "REMOTE_HOST" set\r
         "" "REMOTE_ADDR" set\r
@@ -26,7 +26,7 @@ IN: http.server.cgi
         "" "REMOTE_IDENT" set\r
 \r
         request get method>> "REQUEST_METHOD" set\r
-        request get url>> query>> assoc>query "QUERY_STRING" set\r
+        url get query>> assoc>query "QUERY_STRING" set\r
         request get "cookie" header "HTTP_COOKIE" set \r
 \r
         request get "user-agent" header "HTTP_USER_AGENT" set\r

diff --git a/extra/http/server/dispatchers/dispatchers.factor b/extra/http/server/dispatchers/dispatchers.factor
index 2da26959922b2087e6f0998026ce8e52962172a3..405d96d1f5070b50f663a455e0259f0c4048dd65 100644 (file)
--- a/extra/http/server/dispatchers/dispatchers.factor
+++ b/extra/http/server/dispatchers/dispatchers.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces sequences assocs accessors splitting
-unicode.case http http.server http.server.responses ;
+unicode.case urls http http.server http.server.responses ;
 IN: http.server.dispatchers
 
 TUPLE: dispatcher default responders ;
@@ -35,7 +35,7 @@ TUPLE: vhost-dispatcher default responders ;
     >lower "www." ?head drop "." ?tail drop ;
 
 : find-vhost ( dispatcher -- responder )
-    request get url>> host>> canonical-host over responders>> at*
+    url get host>> canonical-host over responders>> at*
     [ nip ] [ drop default>> ] if ;
 
 M: vhost-dispatcher call-responder* ( path dispatcher -- response )

diff --git a/extra/http/server/redirection/redirection.factor b/extra/http/server/redirection/redirection.factor
index c1d2eaa63ae59c26d4f8728d1899a829ff3fb1b1..314c09e33df344d85d255dabadbc9d65867478bc 100644 (file)
--- a/extra/http/server/redirection/redirection.factor
+++ b/extra/http/server/redirection/redirection.factor
@@ -9,7 +9,7 @@ GENERIC: relative-to-request ( url -- url' )
 M: string relative-to-request ;
 
 M: url relative-to-request
-    request get url>>
+    url get
         clone
         f >>query
     swap derive-url ensure-port ;

diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor
index 6733bb8a41f044e3a4cda234e3eacb9bec30bf63..436d626578ca2acf2793f48bdc310eae2706a146 100755 (executable)
--- a/extra/http/server/server.factor
+++ b/extra/http/server/server.factor
@@ -81,8 +81,7 @@ GENERIC: write-full-response ( request response -- )
 
 : ensure-domain ( cookie -- cookie )
     [
-        request get url>>
-        host>> dup "localhost" =
+        url get host>> dup "localhost" =
         [ drop ] [ or ] if
     ] change-domain ;
 
@@ -189,7 +188,7 @@ LOG: httpd-header NOTICE
     "/" split harvest ;
 
 : init-request ( request -- )
-    request set
+    [ request set ] [ url>> url set ] bi
     V{ } clone responder-nesting set ;
 
 : dispatch-request ( request -- response )
@@ -224,7 +223,7 @@ LOG: httpd-benchmark DEBUG
 
 : ?benchmark ( quot -- )
     benchmark? get [
-        [ benchmark ] [ first ] bi request get url>> rot 3array
+        [ benchmark ] [ first ] bi url get rot 3array
         httpd-benchmark
     ] [ call ] if ; inline
 
@@ -235,7 +234,7 @@ M: http-server handle-client*
     [
         64 1024 * limit-input
         ?refresh-all
-        read-request
+        [ read-request ] ?benchmark
         [ do-request ] ?benchmark
         [ do-response ] ?benchmark
     ] with-destructors ;

diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor
index 83fcf6f4a937a18b0f89a13d301201a68ed15878..98510e45fd5e455d24e85a85800d4d5f0b9dfc6c 100755 (executable)
--- a/extra/http/server/static/static.factor
+++ b/extra/http/server/static/static.factor
@@ -82,12 +82,12 @@ TUPLE: file-responder root hook special allow-listings ;
     "index.html" append-path dup exists? [ drop f ] unless ;\r
 \r
 : serve-directory ( filename -- response )\r
-    request get url>> path>> "/" tail? [\r
+    url get path>> "/" tail? [\r
         dup\r
         find-index [ serve-file ] [ list-directory ] ?if\r
     ] [\r
         drop\r
-        request get url>> clone [ "/" append ] change-path <permanent-redirect>\r
+        url get clone [ "/" append ] change-path <permanent-redirect>\r
     ] if ;\r
 \r
 : serve-object ( filename -- response )\r

diff --git a/extra/webapps/blogs/blogs.factor b/extra/webapps/blogs/blogs.factor
index 10e0ab54c01989f0fd4436119b5e14f119f33abc..972c09f9b8143f4299facc69829e7a2aad5ba896 100644 (file)
--- a/extra/webapps/blogs/blogs.factor
+++ b/extra/webapps/blogs/blogs.factor
@@ -160,13 +160,13 @@ M: comment entity-url
 
         [
             validate-post
-            logged-in-user get username>> "author" set-value
+            username "author" set-value
         ] >>validate
 
         [
             f <post>
                 dup { "title" "content" } to-object
-                logged-in-user get username>> >>author
+                username >>author
                 now >>date
             [ insert-tuple ] [ entity-url <redirect> ] bi
         ] >>submit
@@ -177,8 +177,8 @@ M: comment entity-url
         "make a new blog post" >>description ;
 
 : authorize-author ( author -- )
-    logged-in-user get username>> =
-    can-administer-blogs? have-capability? or
+    username =
+    { can-administer-blogs? } have-capabilities? or
     [ login-required ] unless ;
 
 : do-post-action ( -- )
@@ -254,13 +254,13 @@ M: comment entity-url
 
         [
             validate-comment
-            logged-in-user get username>> "author" set-value
+            username "author" set-value
         ] >>validate
 
         [
             "parent" value f <comment>
                 "content" value >>content
-                logged-in-user get username>> >>author
+                username >>author
                 now >>date
             [ insert-tuple ] [ entity-url <redirect> ] bi
         ] >>submit

diff --git a/extra/webapps/todo/todo.factor b/extra/webapps/todo/todo.factor
index 0fb7e7dc89212ecd0e77cba6eb8e270b73718bf1..e726c4ed3628cd9623d89462c6ce41a55cb955fd 100755 (executable)
--- a/extra/webapps/todo/todo.factor
+++ b/extra/webapps/todo/todo.factor
@@ -32,7 +32,7 @@ todo "TODO"
 : <todo> ( id -- todo )
     todo new
         swap >>id
-        logged-in-user get username>> >>uid ;
+        username >>uid ;
 
 : <view-action> ( -- action )
     <page-action>

diff --git a/extra/webapps/wiki/changes.xml b/extra/webapps/wiki/changes.xml
index 1515c4924a35c251dc1cb2b19a2795a59114de57..7004871df36ac4b774fa2c7f32b53ebaf017c5d1 100644 (file)
--- a/extra/webapps/wiki/changes.xml
+++ b/extra/webapps/wiki/changes.xml
@@ -4,26 +4,4 @@
 
        <t:title>Recent Changes</t:title>
 
-       <div class="revisions">
-
-               <table>
-
-                       <tr>
-                               <th>Article</th>
-                               <th>Date</th>
-                               <th>By</th>
-                       </tr>
-
-                       <t:bind-each t:name="changes">
-                               <tr>
-                                       <td><t:a t:href="$wiki/view" t:rest="title"><t:label t:name="title" /></t:a></td>
-                                       <td><t:a t:href="$wiki/revision" t:rest="id"><t:label t:name="date" /></t:a></td>
-                                       <td><t:a t:href="$wiki/user-edits" t:rest="author"><t:label t:name="author" /></t:a></td>
-                               </tr>
-                       </t:bind-each>
-
-               </table>
-
-       </div>
-
 </t:chloe>

diff --git a/extra/webapps/wiki/diff.xml b/extra/webapps/wiki/diff.xml
index 9d65531eb0ad4725f53b1a18feaf014a5ccbf990..75cb4a29fb35ced1d081a51b590c43c9002f7abc 100644 (file)
--- a/extra/webapps/wiki/diff.xml
+++ b/extra/webapps/wiki/diff.xml
@@ -13,7 +13,7 @@
                </tr>
                <tr>
                        <th class="field-label">New revision:</th>
-                       <t:bind t:name="old">
+                       <t:bind t:name="new">
                                <td>Created on <t:label t:name="date" /> by <t:a t:href="user-edits" t:rest="author"><t:label t:name="author" /></t:a>.</td>
                        </t:bind>
                </tr>

diff --git a/extra/webapps/wiki/edit.xml b/extra/webapps/wiki/edit.xml
index 057b7f8f7129d8e0886e075bea0ea58675c7e7e4..90843a7140984e57aa1ab67ee25b5e2ff5ebcfcd 100644 (file)
--- a/extra/webapps/wiki/edit.xml
+++ b/extra/webapps/wiki/edit.xml
@@ -4,12 +4,17 @@
 
        <t:title>Edit: <t:label t:name="title" /></t:title>
 
-       <t:form t:action="$wiki/edit" t:for="title">
+       <t:form t:action="$wiki/submit" t:for="title">
 
                <p>
                        <t:textarea t:name="content" t:rows="30" t:cols="80" />
                </p>
 
+               <p>
+                       Describe this revision:
+                       <t:field t:name="description" t:size="60" />
+               </p>
+
                <p>
                        <input type="submit" value="Save" />
                </p>

diff --git a/extra/webapps/wiki/revisions-common.xml b/extra/webapps/wiki/revisions-common.xml
new file mode 100644 (file)
index 0000000..6cf3315
--- /dev/null
+++ b/extra/webapps/wiki/revisions-common.xml
@@ -0,0 +1,33 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+       <div class="revisions">
+
+               <table>
+
+                       <tr>
+                               <th>Article</th>
+                               <th>Date</th>
+                               <th>By</th>
+                               <th>Description</th>
+                               <th>Rollback</th>
+                       </tr>
+
+                       <t:bind-each t:name="revisions">
+                               <tr>
+                                       <td> <t:a t:href="$wiki/view" t:rest="title"><t:label t:name="title" /></t:a> </td>
+                                       <td> <t:a t:href="$wiki/revision" t:rest="id"><t:label t:name="date" /></t:a> </td>
+                                       <td> <t:a t:href="$wiki/user-edits" t:rest="author"><t:label t:name="author" /> </t:a></td>
+                                       <td> <t:label t:name="description" /> </td>
+                                       <td> <t:button class="link link-button" t:action="$wiki/rollback" t:for="id">Rollback</t:button> </td>
+                               </tr>
+                       </t:bind-each>
+
+               </table>
+
+       </div>
+
+       <t:call-next-template />
+
+</t:chloe>

diff --git a/extra/webapps/wiki/revisions.xml b/extra/webapps/wiki/revisions.xml
index 0e1af75a8f036e8f448ebfecc83e169a02559643..68f377e70bc1dcb1a8b3fec843df33cd36184385 100644 (file)
--- a/extra/webapps/wiki/revisions.xml
+++ b/extra/webapps/wiki/revisions.xml
@@ -4,24 +4,6 @@
 
        <t:title>Revisions of <t:label t:name="title" /></t:title>
 
-       <div class="revisions">
-               <table>
-                       <tr>
-                               <th>Revision</th>
-                               <th>By</th>
-                               <th>Rollback</th>
-                       </tr>
-
-                       <t:bind-each t:name="revisions">
-                               <tr>
-                                       <td> <t:a t:href="$wiki/revision" t:rest="id"><t:label t:name="date" /></t:a> </td>
-                                       <td> <t:a t:href="$wiki/user-edits" t:rest="author"><t:label t:name="author" /></t:a> </td>
-                                       <td> <t:button t:action="$wiki/rollback" t:for="id" class="link link-button">Rollback</t:button> </td>
-                               </tr>
-                       </t:bind-each>
-               </table>
-       </div>
-
        <h2>View Differences</h2>
 
        <t:form t:action="$wiki/diff" t:method="get">

diff --git a/extra/webapps/wiki/user-edits.xml b/extra/webapps/wiki/user-edits.xml
index 6f6ada2dbdda91863f83d2cfae5e5f49066b605d..8035c24e24f8a9191fb8a59dc7fb2079fed51b0d 100644 (file)
--- a/extra/webapps/wiki/user-edits.xml
+++ b/extra/webapps/wiki/user-edits.xml
@@ -8,14 +8,4 @@
 
        <t:title>Edits by <t:label t:name="author" /></t:title>
 
-       <ul>
-               <t:bind-each t:name="user-edits">
-                       <li>
-                               <t:a t:href="$wiki/view" t:rest="title"><t:label t:name="title" /></t:a>
-                               on
-                               <t:a t:href="$wiki/revision" t:rest="id"><t:label t:name="date" /></t:a>
-                       </li>
-               </t:bind-each>
-       </ul>
-
 </t:chloe>

diff --git a/extra/webapps/wiki/view.xml b/extra/webapps/wiki/view.xml
index 7d2c7869b5a01f5e8a784c3e0e758b289f845b02..38d9d39d558777b8f1e7e7a23222feca7121f7a4 100644 (file)
--- a/extra/webapps/wiki/view.xml
+++ b/extra/webapps/wiki/view.xml
@@ -8,6 +8,12 @@
                <t:farkup t:name="content" />
        </div>
 
-       <p><em>This revision created on <t:label t:name="date" /> by <t:a t:href="$wiki/user-edits" t:rest="author"><t:label t:name="author" /></t:a>.</em></p>
+       <p>
+               <em>This revision created on <t:label t:name="date" /> by <t:a t:href="$wiki/user-edits" t:rest="author"><t:label t:name="author" /></t:a>
+                       <t:if t:value="description">
+                               (<t:label t:name="description" />)
+                       </t:if>
+               </em>
+       </p>
 
 </t:chloe>

diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml
index 5cddcee628294a9fe8bcd69a84e3f15111097041..dea79670a31a51b39641865d7c6352752a0d4065 100644 (file)
--- a/extra/webapps/wiki/wiki-common.xml
+++ b/extra/webapps/wiki/wiki-common.xml
@@ -47,15 +47,17 @@
                        </t:if>
                </tr>
 
-               <tr>
-                       <td>
-                               <t:bind t:name="footer">
-                                       <small>
-                                               <t:farkup t:name="content" />
-                                       </small>
-                               </t:bind>
-                       </td>
-               </tr>
+               <t:if t:value="footer">
+                       <tr>
+                               <td>
+                                       <t:bind t:name="footer">
+                                               <small>
+                                                       <t:farkup t:name="content" />
+                                               </small>
+                                       </t:bind>
+                               </td>
+                       </tr>
+               </t:if>
        </table>
 
 </t:chloe>

diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
index 3c87f3cd4926105c486cceee6183907e01420fc4..623c8aabe5cf9fd0b571aad87430a1273d9238f5 100644 (file)
--- a/extra/webapps/wiki/wiki.factor
+++ b/extra/webapps/wiki/wiki.factor
@@ -47,7 +47,7 @@ article "ARTICLES" {
 
 : <article> ( title -- article ) article new swap >>title ;
 
-TUPLE: revision id title author date content ;
+TUPLE: revision id title author date content description ;
 
 revision "REVISIONS" {
     { "id" "ID" INTEGER +db-assigned-id+ }
@@ -55,6 +55,7 @@ revision "REVISIONS" {
     { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
     { "date" "DATE" TIMESTAMP +not-null+ }
     { "content" "CONTENT" TEXT +not-null+ }
+    { "description" "DESCRIPTION" TEXT }
 } define-persistent
 
 M: revision feed-entry-title
@@ -76,6 +77,10 @@ M: revision feed-entry-url id>> revision-url ;
 : validate-author ( -- )
     { { "author" [ v-username ] } } validate-params ;
 
+: <article-boilerplate> ( responder -- responder' )
+    <boilerplate>
+        { wiki "page-common" } >>template ;
+
 : <main-article-action> ( -- action )
     <action>
         [ "Front Page" view-url <redirect> ] >>display ;
@@ -100,7 +105,9 @@ M: revision feed-entry-url id>> revision-url ;
             ] [
                 edit-url <redirect>
             ] ?if
-        ] >>display ;
+        ] >>display
+
+    <article-boilerplate> ;
 
 : <view-revision-action> ( -- action )
     <page-action>
@@ -114,7 +121,9 @@ M: revision feed-entry-url id>> revision-url ;
             URL" $wiki/view/" adjust-url present relative-link-prefix set
         ] >>init
 
-        { wiki "view" } >>template ;
+        { wiki "view" } >>template
+    
+    <article-boilerplate> ;
 
 : <random-article-action> ( -- action )
     <action>
@@ -144,28 +153,47 @@ M: revision feed-entry-url id>> revision-url ;
 
         [
             validate-title
-            "title" value <article> select-tuple [
-                revision>> <revision> select-tuple from-object
-            ] when*
+
+            "title" value <article> select-tuple
+            [ revision>> <revision> select-tuple ]
+            [ f <revision> "title" value >>title ]
+            if*
+
+            [ title>> "title" set-value ]
+            [ content>> "content" set-value ]
+            bi
         ] >>init
 
         { wiki "edit" } >>template
 
+    <article-boilerplate> ;
+
+: <submit-article-action> ( -- action )
+    <action>
         [
             validate-title
-            { { "content" [ v-required ] } } validate-params
+
+            {
+                { "content" [ v-required ] }
+                { "description" [ [ v-one-line ] v-optional ] }
+            } validate-params
 
             f <revision>
                 "title" value >>title
                 now >>date
-                logged-in-user get username>> >>author
+                username >>author
                 "content" value >>content
+                "description" value >>description
             [ add-revision ] [ title>> view-url <redirect> ] bi
         ] >>submit
 
     <protected>
         "edit wiki articles" >>description ;
 
+: <revisions-boilerplate> ( responder -- responder )
+    <boilerplate>
+        { wiki "revisions-common" } >>template ;
+
 : list-revisions ( -- seq )
     f <revision> "title" value >>title select-tuples
     reverse-chronological-order ;
@@ -180,7 +208,10 @@ M: revision feed-entry-url id>> revision-url ;
             list-revisions "revisions" set-value
         ] >>init
 
-        { wiki "revisions" } >>template ;
+        { wiki "revisions" } >>template
+
+    <revisions-boilerplate>
+    <article-boilerplate> ;
 
 : <list-revisions-feed-action> ( -- action )
     <feed-action>
@@ -195,15 +226,26 @@ M: revision feed-entry-url id>> revision-url ;
 
         [ list-revisions ] >>entries ;
 
+: rollback-description ( description -- description' )
+    [ "Rollback of '" swap "'" 3append ] [ "Rollback" ] if* ;
+
 : <rollback-action> ( -- action )
     <action>
 
         [ validate-integer-id ] >>validate
 
         [
-            "id" value <revision> select-tuple clone f >>id
-            [ add-revision ] [ title>> view-url <redirect> ] bi
-        ] >>submit ;
+            "id" value <revision> select-tuple
+                f >>id
+                now >>date
+                username >>author
+                [ rollback-description ] change-description
+            [ add-revision ]
+            [ title>> revisions-url <redirect> ] bi
+        ] >>submit
+    
+    <protected>
+        "rollback wiki articles" >>description ;
 
 : list-changes ( -- seq )
     f <revision> select-tuples
@@ -211,8 +253,10 @@ M: revision feed-entry-url id>> revision-url ;
 
 : <list-changes-action> ( -- action )
     <page-action>
-        [ list-changes "changes" set-value ] >>init
-        { wiki "changes" } >>template ;
+        [ list-changes "revisions" set-value ] >>init
+        { wiki "changes" } >>template
+
+    <revisions-boilerplate> ;
 
 : <list-changes-feed-action> ( -- action )
     <feed-action>
@@ -237,6 +281,7 @@ M: revision feed-entry-url id>> revision-url ;
 
 : <diff-action> ( -- action )
     <page-action>
+
         [
             {
                 { "old-id" [ v-integer ] }
@@ -246,14 +291,18 @@ M: revision feed-entry-url id>> revision-url ;
             "old-id" "new-id"
             [ value <revision> select-tuple ] bi@
             [
-                [ [ title>> "title" set-value ] [ "old" [ from-object ] nest-form ] bi ]
-                [ "new" [ from-object ] nest-form ] bi*
+                over title>> "title" set-value
+                [ "old" [ from-object ] nest-form ]
+                [ "new" [ from-object ] nest-form ]
+                bi*
             ]
             [ [ content>> string-lines ] bi@ diff "diff" set-value ]
             2bi
         ] >>init
 
-        { wiki "diff" } >>template ;
+        { wiki "diff" } >>template
+
+    <article-boilerplate> ;
 
 : <list-articles-action> ( -- action )
     <page-action>
@@ -277,10 +326,12 @@ M: revision feed-entry-url id>> revision-url ;
 
         [
             validate-author
-            list-user-edits "user-edits" set-value
+            list-user-edits "revisions" set-value
         ] >>init
 
-        { wiki "user-edits" } >>template ;
+        { wiki "user-edits" } >>template
+
+    <revisions-boilerplate> ;
 
 : <user-edits-feed-action> ( -- action )
     <feed-action>
@@ -290,24 +341,21 @@ M: revision feed-entry-url id>> revision-url ;
         [ "author" value user-edits-url ] >>url
         [ list-user-edits ] >>entries ;
 
-: <article-boilerplate> ( responder -- responder' )
-    <boilerplate>
-        { wiki "page-common" } >>template ;
-
 : init-sidebar ( -- )
     "Sidebar" latest-revision [ "sidebar" [ from-object ] nest-form ] when*
     "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
 
 : <wiki> ( -- dispatcher )
     wiki new-dispatcher
-        <main-article-action> <article-boilerplate> "" add-responder
-        <view-article-action> <article-boilerplate> "view" add-responder
-        <view-revision-action> <article-boilerplate> "revision" add-responder
+        <main-article-action> "" add-responder
+        <view-article-action> "view" add-responder
+        <view-revision-action> "revision" add-responder
         <random-article-action> "random" add-responder
-        <list-revisions-action> <article-boilerplate> "revisions" add-responder
+        <list-revisions-action> "revisions" add-responder
         <list-revisions-feed-action> "revisions.atom" add-responder
-        <diff-action> <article-boilerplate> "diff" add-responder
-        <edit-article-action> <article-boilerplate> "edit" add-responder
+        <diff-action> "diff" add-responder
+        <edit-article-action> "edit" add-responder
+        <submit-article-action> "submit" add-responder
         <rollback-action> "rollback" add-responder
         <user-edits-action> "user-edits" add-responder
         <list-articles-action> "articles" add-responder