! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel hashtables calendar namespaces splitting sequences sorting math.order html.components http.server http.server.dispatchers furnace furnace.actions furnace.auth furnace.auth.login furnace.boilerplate validators db.types db.tuples lcs farkup urls ; IN: webapps.wiki TUPLE: wiki < dispatcher ; TUPLE: article title revision ; article "ARTICLES" { { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ } ! { "AUTHOR" INTEGER +not-null+ } ! uid ! { "PROTECTED" BOOLEAN +not-null+ } { "revision" "REVISION" INTEGER +not-null+ } ! revision id } define-persistent :
( title -- article ) article new swap >>title ; : init-articles-table article ensure-table ; TUPLE: revision id title author date content ; revision "REVISIONS" { { "id" "ID" INTEGER +db-assigned-id+ } { "title" "TITLE" { VARCHAR 256 } +not-null+ } ! article id { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid { "date" "DATE" TIMESTAMP +not-null+ } { "content" "CONTENT" TEXT +not-null+ } } define-persistent : ( id -- revision ) revision new swap >>id ; : init-revisions-table revision ensure-table ; : validate-title ( -- ) { { "title" [ v-one-line ] } } validate-params ; : ( -- action ) [ "$wiki/view" >>path "Front Page" "title" set-query-param ] >>display ; : ( -- action ) "title" >>rest-param [ validate-title "view?title=" relative-link-prefix set ] >>init [ "title" value dup
select-tuple [ revision>> select-tuple from-object { wiki "view" } ] [ "$wiki/edit" >>path swap "title" set-query-param ] ?if ] >>display ; : ( -- action ) [ { { "id" [ v-integer ] } } validate-params "id" value select-tuple from-object ] >>init { wiki "view" } >>template ; : add-revision ( revision -- ) [ insert-tuple ] [ dup title>>
select-tuple [ swap id>> >>revision update-tuple ] [ [ title>> ] [ id>> ] bi article boa insert-tuple ] if* ] bi ; : ( -- action ) [ validate-title "title" value
select-tuple [ revision>> select-tuple from-object ] when* ] >>init { wiki "edit" } >>template [ validate-title { { "content" [ v-required ] } } validate-params f "title" value >>title now >>date logged-in-user get username>> >>author "content" value >>content [ add-revision ] [ "$wiki/view" >>path swap title>> "title" set-query-param ] bi ] >>submit ; : ( -- action ) [ validate-title f "title" value >>title select-tuples [ [ date>> ] compare invert-comparison ] sort "revisions" set-value ] >>init { wiki "revisions" } >>template ; : ( -- action ) [ { { "id" [ v-integer ] } } validate-params ] >>validate [ "id" value select-tuple clone f >>id [ add-revision ] [ "$wiki/view" >>path swap title>> "title" set-query-param ] bi ] >>submit ; : ( -- action ) [ f select-tuples [ [ date>> ] compare invert-comparison ] sort "changes" set-value ] >>init { wiki "changes" } >>template ; : ( -- action ) [ validate-title ] >>validate [ "title" value
delete-tuples f "title" value >>title delete-tuples URL" $wiki" ] >>submit ; : ( -- action ) [ { { "old-id" [ v-integer ] } { "new-id" [ v-integer ] } } validate-params "old-id" "new-id" [ value select-tuple ] bi@ [ [ "old" set-value ] [ "new" set-value ] bi* ] [ [ content>> string-lines ] bi@ diff "diff" set-value ] 2bi ] >>init { wiki "diff" } >>template ; : ( -- action ) [ f
select-tuples [ [ title>> ] compare ] sort "articles" set-value ] >>init { wiki "articles" } >>template ; : ( -- action ) [ { { "author" [ v-username ] } } validate-params f "author" value >>author select-tuples "user-edits" set-value ] >>init { wiki "user-edits" } >>template ; : ( -- dispatcher ) wiki new-dispatcher "" add-responder "view" add-responder "revision" add-responder "revisions" add-responder "rollback" add-responder "user-edits" add-responder "diff" add-responder "articles" add-responder "changes" add-responder { } "edit" add-responder { } "delete" add-responder { wiki "wiki-common" } >>template ;