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