! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel hashtables calendar random assocs namespaces make splitting sequences sorting math.order present io.files io.directories io.encodings.ascii syndication farkup html.components html.forms http.server http.server.dispatchers furnace.actions furnace.utilities furnace.redirection furnace.auth furnace.auth.login furnace.auth.features.registration furnace.boilerplate furnace.syndication validators webapps.user-admin db.types db.tuples lcs urls db.sqlite db furnace.alloy ; IN: webapps.wiki : wiki-url ( rest path -- url ) [ "$wiki/" % % "/" % present % ] "" make swap >>path ; : view-url ( title -- url ) "view" wiki-url ; : edit-url ( title -- url ) "edit" wiki-url ; : revisions-url ( title -- url ) "revisions" wiki-url ; : revision-url ( id -- url ) "revision" wiki-url ; : user-edits-url ( author -- url ) "user-edits" wiki-url ; TUPLE: wiki < dispatcher ; SYMBOL: can-delete-wiki-articles? can-delete-wiki-articles? define-capability TUPLE: article title revision ; article "ARTICLES" { { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ } { "revision" "REVISION" INTEGER +not-null+ } ! revision id } define-persistent :
( title -- article ) article new swap >>title ; TUPLE: revision id title author date content description ; 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+ } { "description" "DESCRIPTION" TEXT } } define-persistent M: revision feed-entry-title [ title>> ] [ drop " by " ] [ author>> ] tri 3append ; M: revision feed-entry-date date>> ; M: revision feed-entry-url id>> revision-url ; : reverse-chronological-order ( seq -- sorted ) [ date>> ] inv-sort-with ; : ( id -- revision ) revision new swap >>id ; : validate-title ( -- ) { { "title" [ v-one-line ] } } validate-params ; : validate-author ( -- ) { { "author" [ v-username ] } } validate-params ; : ( responder -- responder' ) { wiki "page-common" } >>template ; : ( -- action ) [ "Front Page" view-url ] >>display ; : latest-revision ( title -- revision/f )
select-tuple dup [ revision>> select-tuple ] when ; : ( -- action ) "title" >>rest [ validate-title ] >>init [ "title" value dup latest-revision [ from-object { wiki "view" } ] [ edit-url ] ?if ] >>display ; : ( -- action ) "id" >>rest [ validate-integer-id "id" value select-tuple from-object ] >>init { wiki "view" } >>template ; : ( -- action ) [ article new select-tuples random [ title>> ] [ "Front Page" ] if* view-url ] >>display ; : amend-article ( revision article -- ) swap id>> >>revision update-tuple ; : add-article ( revision -- ) [ title>> ] [ id>> ] bi article boa insert-tuple ; : add-revision ( revision -- ) [ insert-tuple ] [ dup title>>
select-tuple [ amend-article ] [ add-article ] if* ] bi ; : ( -- action ) "title" >>rest [ validate-title "title" value
select-tuple [ revision>> select-tuple ] [ f "title" value >>title ] if* [ title>> "title" set-value ] [ content>> "content" set-value ] bi ] >>init { wiki "edit" } >>template ; : ( -- action ) [ validate-title { { "content" [ v-required ] } { "description" [ [ v-one-line ] v-optional ] } } validate-params f "title" value >>title now >>date username >>author "content" value >>content "description" value >>description [ add-revision ] [ title>> view-url ] bi ] >>submit "edit wiki articles" >>description ; : ( responder -- responder ) { wiki "revisions-common" } >>template ; : list-revisions ( -- seq ) f "title" value >>title select-tuples reverse-chronological-order ; : ( -- action ) "title" >>rest [ validate-title list-revisions "revisions" set-value ] >>init { wiki "revisions" } >>template ; : ( -- action ) "title" >>rest [ validate-title ] >>init [ "Revisions of " "title" value append ] >>title [ "title" value revisions-url ] >>url [ list-revisions ] >>entries ; : rollback-description ( description -- description' ) [ "Rollback to '" "'" surround ] [ "Rollback" ] if* ; : ( -- action ) [ validate-integer-id ] >>validate [ "id" value select-tuple f >>id now >>date username >>author [ rollback-description ] change-description [ add-revision ] [ title>> revisions-url ] bi ] >>submit "rollback wiki articles" >>description ; : list-changes ( -- seq ) f select-tuples reverse-chronological-order ; : ( -- action ) [ list-changes "revisions" set-value ] >>init { wiki "changes" } >>template ; : ( -- action ) [ URL" $wiki/changes" ] >>url [ "All changes" ] >>title [ list-changes ] >>entries ; : ( -- action ) [ validate-title ] >>validate [ "title" value
delete-tuples f "title" value >>title delete-tuples URL" $wiki" ] >>submit "delete wiki articles" >>description { can-delete-wiki-articles? } >>capabilities ; : ( -- action ) [ { { "old-id" [ v-integer ] } { "new-id" [ v-integer ] } } validate-params "old-id" "new-id" [ value select-tuple ] 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 ; : ( -- action ) [ f
select-tuples [ title>> ] sort-with "articles" set-value ] >>init { wiki "articles" } >>template ; : list-user-edits ( -- seq ) f "author" value >>author select-tuples reverse-chronological-order ; : ( -- action ) "author" >>rest [ validate-author list-user-edits "revisions" set-value ] >>init { wiki "user-edits" } >>template ; : ( -- action ) "author" >>rest [ validate-author ] >>init [ "Edits by " "author" value append ] >>title [ "author" value user-edits-url ] >>url [ list-user-edits ] >>entries ; : init-sidebars ( -- ) "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when* "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ; : init-relative-link-prefix ( -- ) URL" $wiki/view/" adjust-url present relative-link-prefix set ; : ( -- dispatcher ) wiki new-dispatcher "" add-responder "view" add-responder "revision" add-responder "random" add-responder "revisions" add-responder "revisions.atom" add-responder "diff" add-responder "edit" add-responder "submit" add-responder "rollback" add-responder "user-edits" add-responder "articles" add-responder "changes" add-responder "user-edits.atom" add-responder "changes.atom" add-responder "user.admin" add-responder "delete" add-responder [ init-sidebars init-relative-link-prefix ] >>init { wiki "wiki-common" } >>template "Wikii" f >>secure allow-registration ; : init-wiki ( -- ) "resource:extra/webapps/wiki/initial-content" [ [ dup ".txt" ?tail [ swap ascii file-contents f swap >>content swap >>title "slava" >>author now >>date add-revision ] [ 2drop ] if ] each ] with-directory-files ; : wiki-db ( -- db ) "resource:wiki.db" ; : run-wiki ( -- ) wiki-db [ article revision [ ensure-table ] bi@ ] with-db wiki-db [ init-wiki ] with-db wiki-db [ "xiackok" make-admin ] with-db wiki-db main-responder set-global 8080 httpd ;