1 ! Copyright (C) 2007, 2010 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: namespaces assocs sorting sequences kernel accessors
4 hashtables db.types db.tuples db combinators
5 calendar calendar.format math.parser math.order syndication urls
6 xml.writer xmode.catalog validators
11 http.server.dispatchers
12 http.server.redirection
22 furnace.conversations ;
25 TUPLE: pastebin < dispatcher ;
27 SYMBOL: can-delete-pastes?
29 can-delete-pastes? define-capability
35 TUPLE: entity id summary author mode date contents ;
39 { "id" "ID" INTEGER +db-assigned-id+ }
40 { "summary" "SUMMARY" { VARCHAR 256 } +not-null+ }
41 { "author" "AUTHOR" { VARCHAR 256 } +not-null+ }
42 { "mode" "MODE" { VARCHAR 256 } +not-null+ }
43 { "date" "DATE" DATETIME +not-null+ }
44 { "contents" "CONTENTS" TEXT +not-null+ }
47 GENERIC: entity-url ( entity -- url )
49 M: entity feed-entry-title summary>> ;
51 M: entity feed-entry-date date>> ;
53 M: entity feed-entry-url entity-url ;
55 TUPLE: paste-state < entity annotations ;
57 \ paste-state "PASTES" { } define-persistent
59 : <paste-state> ( id -- paste )
63 : pastes ( -- pastes )
64 f <paste-state> select-tuples
68 TUPLE: annotation < entity parent ;
70 \ annotation "ANNOTATIONS"
72 { "parent" "PARENT" INTEGER +not-null+ }
75 : <annotation> ( parent id -- annotation )
80 : lookup-annotation ( id -- annotation )
81 [ f ] dip <annotation> select-tuple ;
83 : paste ( id -- paste )
84 [ <paste-state> select-tuple ]
85 [ f <annotation> select-tuples ]
92 CONSTANT: pastebin-url URL" $pastebin/"
94 : paste-url ( id -- url )
95 "$pastebin/paste" >url swap "id" set-query-param ;
97 M: paste-state entity-url
100 : annotation-url ( parent id -- url )
101 "$pastebin/paste" >url
102 swap number>string >>anchor
103 swap "id" set-query-param ;
105 M: annotation entity-url
106 [ parent>> ] [ id>> ] bi annotation-url ;
112 : <pastebin-action> ( -- action )
114 [ pastes "pastes" set-value ] >>init
115 { pastebin "pastebin" } >>template ;
117 : <pastebin-feed-action> ( -- action )
119 [ pastebin-url ] >>url
120 [ "Factor Pastebin" ] >>title
121 [ pastes ] >>entries ;
127 : <paste-action> ( -- action )
131 "id" value paste from-object
136 mode-names "modes" set-value
137 "factor" "mode" set-value
141 { pastebin "paste" } >>template ;
143 : <raw-paste-action> ( -- action )
145 [ validate-integer-id "id" value paste from-object ] >>init
146 [ "contents" value "text/plain" <content> ] >>display ;
148 : <paste-feed-action> ( -- action )
150 [ validate-integer-id ] >>init
151 [ "id" value paste-url ] >>url
152 [ "Paste " "id" value number>string append ] >>title
153 [ "id" value f <annotation> select-tuples ] >>entries ;
155 : validate-entity ( -- )
157 { "summary" [ v-one-line ] }
158 { "author" [ v-one-line ] }
159 { "mode" [ v-mode ] }
160 { "contents" [ v-required ] }
164 : deposit-entity-slots ( tuple -- )
166 { "summary" "author" "mode" "contents" } to-object ;
168 : <new-paste-action> ( -- action )
171 "factor" "mode" set-value
172 mode-names "modes" set-value
175 { pastebin "new-paste" } >>template
178 mode-names "modes" set-value
184 [ deposit-entity-slots ]
186 [ id>> paste-url <redirect> ]
190 : <delete-paste-action> ( -- action )
193 [ validate-integer-id ] >>validate
197 "id" value <paste-state> delete-tuples
198 "id" value f <annotation> delete-tuples
200 pastebin-url <redirect>
204 "delete pastes" >>description
205 { can-delete-pastes? } >>capabilities ;
211 : <new-annotation-action> ( -- action )
214 mode-names "modes" set-value
215 { { "parent" [ v-integer ] } } validate-params
220 "parent" value f <annotation>
221 [ deposit-entity-slots ]
223 [ entity-url <redirect> ]
227 : <raw-annotation-action> ( -- action )
229 [ validate-integer-id "id" value lookup-annotation from-object ] >>init
230 [ "contents" value "text/plain" <content> ] >>display ;
232 : <delete-annotation-action> ( -- action )
235 [ { { "id" [ v-number ] } } validate-params ] >>validate
238 f "id" value lookup-annotation
240 [ parent>> paste-url <redirect> ]
245 "delete annotations" >>description
246 { can-delete-pastes? } >>capabilities ;
248 : <pastebin> ( -- responder )
249 pastebin new-dispatcher
250 <pastebin-action> "" add-responder
251 <pastebin-feed-action> "list.atom" add-responder
252 <paste-action> "paste" add-responder
253 <raw-paste-action> "paste.txt" add-responder
254 <paste-feed-action> "paste.atom" add-responder
255 <new-paste-action> "new-paste" add-responder
256 <delete-paste-action> "delete-paste" add-responder
257 <new-annotation-action> "new-annotation" add-responder
258 <raw-annotation-action> "annotation.txt" add-responder
259 <delete-annotation-action> "delete-annotation" add-responder
261 { pastebin "pastebin-common" } >>template ;