factor/unmaintained/furnace-onigiri/onigiri.factor

167 lines
5.0 KiB
Factor

! Copyright (C) 2006 Matthew Willis. All Rights Reserved.
! See http://factorcode.org/license.txt for BSD license.
!
USING: httpd threads kernel namespaces furnace sequences
html strings math assocs crypto io file-responder calendar
prettyprint parser errors sha2 basic-authentication arrays
serialize ;
IN: furnace:onigiri
TUPLE: entry title stub body created ;
TUPLE: user name password ;
TUPLE: meta key value ;
: title>stub ( title -- stub )
! creates a url friendly name based on the title
" " split [ [ alpha? ] subset ] map "" swap remove "-" join ;
C: entry ( title body stub -- entry )
tuck set-entry-stub
tuck set-entry-body
dup entry-stub [ over title>stub over set-entry-stub ] unless
now over set-entry-created tuck set-entry-title ;
C: user ( name password -- user )
swap string>sha-256-string over set-user-password
tuck set-user-name ;
: base-url ( -- url )
"http://" "Host" "header" get at append ;
: action>url ( action -- url )
"responder-url" get swap append ;
: stub>url ( stub -- url )
"entry-show?stub=" swap append action>url ;
: stub>entry ( stub -- entry )
entry get-global [ entry-stub = ] subset-with
dup empty? [ drop f ] [ first ] if ;
: atom ( -- )
"text/xml" serving-content
[ f "atom" render-template ] with-html-stream ;
: sitemap ( -- )
"text/xml" serving-content
[ f "sitemap" render-template ] with-html-stream ;
: css-path ( -- path )
! "text/css" serving-content
"css" meta crud-lookup* meta-value
[ "onigirihouse.css" ] unless* ;
DEFER: key>meta*
: entry-list ( -- )
"title" key>meta* meta-value
serving-html [
<furnace-model> "header" render-template
entry get-global
[ [ entry-created ] 2apply swap compare-timestamps ] sort
[ "entry-show" render-template ] each
f "footer" render-template
] with-html-stream ;
DEFER: key>meta
: entry-show ( stub -- )
stub>entry
[
"title" key>meta* meta-value
" - " pick entry-title 3append
serving-html [
<furnace-model> "header" render-template
"entry-show" render-template
f "footer" render-template
] with-html-stream
] [
"title" key>meta* meta-value " - Entry not found" append
serving-html [
[
<p> "The entry you are searching for could not be found" write </p>
<p> [ entry-list ] "Back to " "title" key>meta
[ meta-value ] [ "the main page" ] if* append render-link
</p>
] html-document
] with-html-stream
] if* ;
: entry-edit ( stub wiky -- )
swap stub>entry dup [ entry-title ] [ f ] if*
"title" key>meta* meta-value " - editing " rot 3append
serving-html [
<furnace-model> "header" render-template
swap "entry-edit" "entry-edit-plain" ? render-template
f "footer" render-template
] with-html-stream ;
: entry-update ( title body stub -- )
"onigiri-realm" [
dup stub>entry [
nip tuck set-entry-body tuck set-entry-title
] [
<entry> dup entry get-global swap add entry set-global
] if* entry-stub entry-show
] with-basic-authentication ;
: entry-delete ( stub -- )
"onigiri-realm" [
stub>entry entry get-global remove entry set-global entry-list
] with-basic-authentication ;
DEFER: name>user
: onigiri-realm ( name password -- bool )
swap name>user [ user-password = ] [ drop f ] if*
user get-global empty? or ;
: register-actions ( -- )
\ entry-list { } define-action
\ entry-show { { "stub" } } define-action
\ entry-edit { { "stub" } { "wiky" f v-default } } define-action
\ entry-update { { "title" } { "body" } { "stub" } } define-action
\ entry-delete { { "stub" } } define-action
\ atom { } define-action
\ sitemap { } define-action
"onigiri" "entry-list" "apps/furnace-onigiri/templates/" web-app
"onigiri-resources" [
[
"apps/furnace-onigiri/resources/" resource-path "doc-root" set
file-responder
] with-scope
] add-simple-responder
[ onigiri-realm ] "onigiri-realm" add-realm
! and finally, use scaffolding for metadata and user data
[
"furnace:onigiri" set-in
meta "key" "onigiri-realm" scaffold
user "name" "onigiri-realm" scaffold
] with-scope ;
: onigiri ( -- )
register-actions
"default-responder" key>meta* meta-value
[ "onigiri" set-default-responder ] when
"port" key>meta* meta-value string>number [ 8888 ] unless*
[ httpd ] in-thread drop ;
: onigiri-dump ( path -- )
<file-writer> [
[
entry get-global serialize
meta get-global serialize
user get-global serialize
] with-serialized
] with-stream ;
: onigiri-boot ( path -- )
<file-reader> [
[
deserialize entry set-global
deserialize meta set-global
deserialize user set-global
] with-serialized
] with-stream ;