/extra/webapps/wiki/wiki.factor

http://github.com/abeaumont/factor · Factor · 387 lines · 290 code · 95 blank · 2 comment · 10 complexity · 53c91e7c61e80fddc6b2d02e3a8be9b8 MD5 · raw file

  1. ! Copyright (C) 2008 Slava Pestov
  2. ! See http://factorcode.org/license.txt for BSD license.
  3. USING: accessors kernel hashtables calendar random assocs
  4. namespaces make splitting sequences sorting math.order present
  5. io.files io.directories io.encodings.ascii
  6. syndication farkup
  7. html.components html.forms
  8. http.server
  9. http.server.dispatchers
  10. furnace.actions
  11. furnace.utilities
  12. furnace.recaptcha
  13. furnace.redirection
  14. furnace.auth
  15. furnace.auth.login
  16. furnace.boilerplate
  17. furnace.syndication
  18. validators
  19. db.types db.tuples lcs urls ;
  20. IN: webapps.wiki
  21. : wiki-url ( rest path -- url )
  22. [ "$wiki/" % % "/" % present % ] "" make
  23. <url> swap >>path ;
  24. : view-url ( title -- url ) "view" wiki-url ;
  25. : edit-url ( title -- url ) "edit" wiki-url ;
  26. : revisions-url ( title -- url ) "revisions" wiki-url ;
  27. : revision-url ( id -- url ) "revision" wiki-url ;
  28. : user-edits-url ( author -- url ) "user-edits" wiki-url ;
  29. TUPLE: wiki < dispatcher ;
  30. SYMBOL: can-delete-wiki-articles?
  31. can-delete-wiki-articles? define-capability
  32. TUPLE: article title revision ;
  33. article "ARTICLES" {
  34. { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
  35. { "revision" "REVISION" INTEGER +not-null+ } ! revision id
  36. } define-persistent
  37. : <article> ( title -- article ) article new swap >>title ;
  38. TUPLE: revision id title author date content description ;
  39. revision "REVISIONS" {
  40. { "id" "ID" INTEGER +db-assigned-id+ }
  41. { "title" "TITLE" { VARCHAR 256 } +not-null+ } ! article id
  42. { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
  43. { "date" "DATE" TIMESTAMP +not-null+ }
  44. { "content" "CONTENT" TEXT +not-null+ }
  45. { "description" "DESCRIPTION" TEXT }
  46. } define-persistent
  47. M: revision feed-entry-title
  48. [ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
  49. M: revision feed-entry-date date>> ;
  50. M: revision feed-entry-url id>> revision-url ;
  51. : reverse-chronological-order ( seq -- sorted )
  52. [ date>> ] inv-sort-with ;
  53. : <revision> ( id -- revision )
  54. revision new swap >>id ;
  55. : validate-title ( -- )
  56. { { "title" [ v-one-line ] } } validate-params ;
  57. : validate-author ( -- )
  58. { { "author" [ v-username ] } } validate-params ;
  59. : <article-boilerplate> ( responder -- responder' )
  60. <boilerplate>
  61. { wiki "page-common" } >>template ;
  62. : <main-article-action> ( -- action )
  63. <action>
  64. [ "Front Page" view-url <redirect> ] >>display ;
  65. : latest-revision ( title -- revision/f )
  66. <article> select-tuple
  67. dup [ revision>> <revision> select-tuple ] when ;
  68. : <view-article-action> ( -- action )
  69. <action>
  70. "title" >>rest
  71. [ validate-title ] >>init
  72. [
  73. "title" value dup latest-revision [
  74. from-object
  75. { wiki "view" } <chloe-content>
  76. ] [
  77. edit-url <redirect>
  78. ] ?if
  79. ] >>display
  80. <article-boilerplate> ;
  81. : <view-revision-action> ( -- action )
  82. <page-action>
  83. "id" >>rest
  84. [
  85. validate-integer-id
  86. "id" value <revision>
  87. select-tuple from-object
  88. ] >>init
  89. { wiki "view" } >>template
  90. <article-boilerplate> ;
  91. : <random-article-action> ( -- action )
  92. <action>
  93. [
  94. article new select-tuples random
  95. [ title>> ] [ "Front Page" ] if*
  96. view-url <redirect>
  97. ] >>display ;
  98. : amend-article ( revision article -- )
  99. swap id>> >>revision update-tuple ;
  100. : add-article ( revision -- )
  101. [ title>> ] [ id>> ] bi article boa insert-tuple ;
  102. : add-revision ( revision -- )
  103. [ insert-tuple ]
  104. [
  105. dup title>> <article> select-tuple
  106. [ amend-article ] [ add-article ] if*
  107. ]
  108. bi ;
  109. : <edit-article-action> ( -- action )
  110. <page-action>
  111. "title" >>rest
  112. [
  113. validate-title
  114. "title" value <article> select-tuple
  115. [ revision>> <revision> select-tuple ]
  116. [ f <revision> "title" value >>title ]
  117. if*
  118. [ title>> "title" set-value ]
  119. [ content>> "content" set-value ]
  120. bi
  121. ] >>init
  122. { wiki "edit" } >>template
  123. <article-boilerplate> ;
  124. : <submit-article-action> ( -- action )
  125. <action>
  126. [
  127. validate-recaptcha
  128. validate-title
  129. {
  130. { "content" [ v-required ] }
  131. { "description" [ [ v-one-line ] v-optional ] }
  132. } validate-params
  133. f <revision>
  134. "title" value >>title
  135. now >>date
  136. username >>author
  137. "content" value >>content
  138. "description" value >>description
  139. [ add-revision ] [ title>> view-url <redirect> ] bi
  140. ] >>submit
  141. <protected>
  142. "edit wiki articles" >>description ;
  143. : <revisions-boilerplate> ( responder -- responder )
  144. <boilerplate>
  145. { wiki "revisions-common" } >>template ;
  146. : list-revisions ( -- seq )
  147. f <revision> "title" value >>title select-tuples
  148. reverse-chronological-order ;
  149. : <list-revisions-action> ( -- action )
  150. <page-action>
  151. "title" >>rest
  152. [
  153. validate-title
  154. list-revisions "revisions" set-value
  155. ] >>init
  156. { wiki "revisions" } >>template
  157. <revisions-boilerplate>
  158. <article-boilerplate> ;
  159. : <list-revisions-feed-action> ( -- action )
  160. <feed-action>
  161. "title" >>rest
  162. [ validate-title ] >>init
  163. [ "Revisions of " "title" value append ] >>title
  164. [ "title" value revisions-url ] >>url
  165. [ list-revisions ] >>entries ;
  166. : rollback-description ( description -- description' )
  167. [ "Rollback to '" "'" surround ] [ "Rollback" ] if* ;
  168. : <rollback-action> ( -- action )
  169. <action>
  170. [ validate-integer-id ] >>validate
  171. [
  172. "id" value <revision> select-tuple
  173. f >>id
  174. now >>date
  175. username >>author
  176. [ rollback-description ] change-description
  177. [ add-revision ]
  178. [ title>> revisions-url <redirect> ] bi
  179. ] >>submit
  180. <protected>
  181. "rollback wiki articles" >>description ;
  182. : list-changes ( -- seq )
  183. f <revision> select-tuples
  184. reverse-chronological-order ;
  185. : <list-changes-action> ( -- action )
  186. <page-action>
  187. [ list-changes "revisions" set-value ] >>init
  188. { wiki "changes" } >>template
  189. <revisions-boilerplate> ;
  190. : <list-changes-feed-action> ( -- action )
  191. <feed-action>
  192. [ URL" $wiki/changes" ] >>url
  193. [ "All changes" ] >>title
  194. [ list-changes ] >>entries ;
  195. : <delete-action> ( -- action )
  196. <action>
  197. [ validate-title ] >>validate
  198. [
  199. "title" value <article> delete-tuples
  200. f <revision> "title" value >>title delete-tuples
  201. URL" $wiki" <redirect>
  202. ] >>submit
  203. <protected>
  204. "delete wiki articles" >>description
  205. { can-delete-wiki-articles? } >>capabilities ;
  206. : <diff-action> ( -- action )
  207. <page-action>
  208. [
  209. {
  210. { "old-id" [ v-integer ] }
  211. { "new-id" [ v-integer ] }
  212. } validate-params
  213. "old-id" "new-id"
  214. [ value <revision> select-tuple ] bi@
  215. [
  216. over title>> "title" set-value
  217. [ "old" [ from-object ] nest-form ]
  218. [ "new" [ from-object ] nest-form ]
  219. bi*
  220. ]
  221. [ [ content>> string-lines ] bi@ diff "diff" set-value ]
  222. 2bi
  223. ] >>init
  224. { wiki "diff" } >>template
  225. <article-boilerplate> ;
  226. : <list-articles-action> ( -- action )
  227. <page-action>
  228. [
  229. f <article> select-tuples
  230. [ title>> ] sort-with
  231. "articles" set-value
  232. ] >>init
  233. { wiki "articles" } >>template ;
  234. : list-user-edits ( -- seq )
  235. f <revision> "author" value >>author select-tuples
  236. reverse-chronological-order ;
  237. : <user-edits-action> ( -- action )
  238. <page-action>
  239. "author" >>rest
  240. [
  241. validate-author
  242. list-user-edits "revisions" set-value
  243. ] >>init
  244. { wiki "user-edits" } >>template
  245. <revisions-boilerplate> ;
  246. : <user-edits-feed-action> ( -- action )
  247. <feed-action>
  248. "author" >>rest
  249. [ validate-author ] >>init
  250. [ "Edits by " "author" value append ] >>title
  251. [ "author" value user-edits-url ] >>url
  252. [ list-user-edits ] >>entries ;
  253. : init-sidebars ( -- )
  254. "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
  255. "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
  256. : init-relative-link-prefix ( -- )
  257. URL" $wiki/view/" adjust-url present relative-link-prefix set ;
  258. : <wiki> ( -- dispatcher )
  259. wiki new-dispatcher
  260. <main-article-action> "" add-responder
  261. <view-article-action> "view" add-responder
  262. <view-revision-action> "revision" add-responder
  263. <random-article-action> "random" add-responder
  264. <list-revisions-action> "revisions" add-responder
  265. <list-revisions-feed-action> "revisions.atom" add-responder
  266. <diff-action> "diff" add-responder
  267. <edit-article-action> "edit" add-responder
  268. <submit-article-action> "submit" add-responder
  269. <rollback-action> "rollback" add-responder
  270. <user-edits-action> "user-edits" add-responder
  271. <list-articles-action> "articles" add-responder
  272. <list-changes-action> "changes" add-responder
  273. <user-edits-feed-action> "user-edits.atom" add-responder
  274. <list-changes-feed-action> "changes.atom" add-responder
  275. <delete-action> "delete" add-responder
  276. <boilerplate>
  277. [ init-sidebars init-relative-link-prefix ] >>init
  278. { wiki "wiki-common" } >>template ;
  279. : init-wiki ( -- )
  280. "resource:extra/webapps/wiki/initial-content" [
  281. [
  282. dup ".txt" ?tail [
  283. swap ascii file-contents
  284. f <revision>
  285. swap >>content
  286. swap >>title
  287. "slava" >>author
  288. now >>date
  289. add-revision
  290. ] [ 2drop ] if
  291. ] each
  292. ] with-directory-files ;