unmaintained/furnace-onigiri/onigiri.factor

   1 ! Copyright (C) 2006 Matthew Willis. All Rights Reserved.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 !
   4
   5 USING: httpd threads kernel namespaces furnace sequences
   6 html strings math assocs crypto io file-responder calendar
   7 prettyprint parser errors sha2 basic-authentication arrays
   8 serialize ;
   9
  10 IN: furnace:onigiri
  11
  12 TUPLE: entry title stub body created ;
  13
  14 TUPLE: user name password ;
  15
  16 TUPLE: meta key value ;
  17
  18 : title>stub ( title -- stub )
  19     ! creates a url friendly name based on the title
  20     " " split [ [ alpha? ] subset ] map "" swap remove "-" join ;
  21
  22 C: entry ( title body stub -- entry )
  23     tuck set-entry-stub
  24     tuck set-entry-body
  25     dup entry-stub [ over title>stub over set-entry-stub ] unless
  26     now over set-entry-created tuck set-entry-title ;
  27
  28 C: user ( name password -- user )
  29     swap string>sha-256-string over set-user-password
  30     tuck set-user-name ;
  31
  32 : base-url ( -- url )
  33     "http://" "Host" "header" get at append ;
  34
  35 : action>url ( action -- url )
  36     "responder-url" get swap append ;
  37
  38 : stub>url ( stub -- url )
  39     "entry-show?stub=" swap append action>url ;
  40
  41 : stub>entry ( stub -- entry )
  42     entry get-global [ entry-stub = ] subset-with
  43     dup empty? [ drop f ] [ first ] if ;
  44
  45 : atom ( -- )
  46     "text/xml" serving-content
  47     [ f "atom" render-template ] with-html-stream ;
  48
  49 : sitemap ( -- )
  50     "text/xml" serving-content
  51     [ f "sitemap" render-template ] with-html-stream ;
  52
  53 : css-path ( -- path )
  54     ! "text/css" serving-content
  55     "css" meta crud-lookup* meta-value
  56     [ "onigirihouse.css" ] unless* ;
  57
  58 DEFER: key>meta*
  59 : entry-list ( -- )
  60         "title" key>meta* meta-value
  61         serving-html [
  62             <furnace-model> "header" render-template
  63         entry get-global
  64                 [ [ entry-created ] 2apply swap compare-timestamps ] sort
  65                 [ "entry-show" render-template ] each
  66         f "footer" render-template
  67         ] with-html-stream ;
  68
  69 DEFER: key>meta
  70 : entry-show ( stub -- )
  71     stub>entry
  72     [
  73         "title" key>meta* meta-value
  74         " - " pick entry-title 3append
  75         serving-html [
  76             <furnace-model> "header" render-template
  77             "entry-show" render-template
  78             f "footer" render-template
  79         ] with-html-stream
  80     ] [
  81         "title" key>meta* meta-value " - Entry not found" append
  82         serving-html [
  83             [
  84                 <p> "The entry you are searching for could not be found" write </p>
  85                 <p> [ entry-list ] "Back to " "title" key>meta
  86                 [ meta-value ] [ "the main page" ] if* append render-link
  87                 </p>
  88             ] html-document
  89         ] with-html-stream
  90     ] if* ;
  91
  92 : entry-edit ( stub wiky -- )
  93     swap stub>entry dup [ entry-title ] [ f ] if*
  94     "title" key>meta* meta-value " - editing " rot 3append
  95     serving-html [
  96         <furnace-model> "header" render-template
  97         swap "entry-edit" "entry-edit-plain" ? render-template
  98         f "footer" render-template
  99     ] with-html-stream ;
 100
 101 : entry-update ( title body stub -- )
 102     "onigiri-realm" [
 103         dup stub>entry [
 104             nip tuck set-entry-body tuck set-entry-title
 105         ] [
 106             <entry> dup entry get-global swap add entry set-global
 107         ] if* entry-stub entry-show
 108     ] with-basic-authentication ;
 109
 110 : entry-delete ( stub -- )
 111     "onigiri-realm" [
 112         stub>entry entry get-global remove entry set-global entry-list
 113     ] with-basic-authentication ;
 114
 115 DEFER: name>user
 116 : onigiri-realm ( name password -- bool )
 117     swap name>user [ user-password = ] [ drop f ] if*
 118     user get-global empty? or ;
 119
 120 : register-actions ( -- )
 121     \ entry-list { } define-action
 122     \ entry-show { { "stub" } } define-action
 123     \ entry-edit { { "stub" } { "wiky" f v-default } } define-action
 124     \ entry-update { { "title" } { "body" } { "stub" } } define-action
 125     \ entry-delete { { "stub" } } define-action
 126     \ atom { } define-action
 127     \ sitemap { } define-action
 128     "onigiri" "entry-list" "apps/furnace-onigiri/templates/" web-app
 129     "onigiri-resources" [
 130         [
 131             "apps/furnace-onigiri/resources/" resource-path "doc-root" set
 132             file-responder
 133         ] with-scope
 134     ] add-simple-responder
 135     [ onigiri-realm ] "onigiri-realm" add-realm
 136     ! and finally, use scaffolding for metadata and user data
 137     [
 138         "furnace:onigiri" set-in
 139         meta "key" "onigiri-realm" scaffold
 140         user "name" "onigiri-realm" scaffold
 141     ] with-scope ;
 142
 143 : onigiri ( -- )
 144     register-actions
 145     "default-responder" key>meta* meta-value
 146     [ "onigiri" set-default-responder ] when
 147     "port" key>meta* meta-value string>number [ 8888 ] unless*
 148     [ httpd ] in-thread drop ;
 149
 150 : onigiri-dump ( path -- )
 151     [
 152         [
 153             entry get-global serialize
 154             meta get-global serialize
 155             user get-global serialize
 156         ] with-serialized
 157     ] with-file-writer ;
 158
 159 : onigiri-boot ( path -- )
 160     <file-reader> [
 161         [
 162             deserialize entry set-global
 163             deserialize meta set-global
 164             deserialize user set-global
 165         ] with-serialized
 166     ] with-stream ;