! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs db.sqlite furnace furnace.actions furnace.alloy furnace.auth furnace.auth.features.deactivate-user furnace.auth.features.edit-profile furnace.auth.features.recover-password furnace.auth.features.registration furnace.auth.login furnace.boilerplate furnace.redirection html.forms http.server http.server.dispatchers kernel namespaces site-watcher site-watcher.db site-watcher.private urls validators io.sockets.secure.unix.debug io.servers.connection db db.tuples sequences ; QUALIFIED: assocs IN: webapps.site-watcher TUPLE: site-watcher-app < dispatcher ; CONSTANT: site-list-url URL" $site-watcher-app/" : ( -- action ) [ logged-in? [ URL" $site-watcher-app/list" ] [ { site-watcher-app "main" } ] if ] >>display ; : ( -- action ) { site-watcher-app "site-list" } >>template [ ! Silly query username watching-sites "sites" set-value ] >>init "list watched sites" >>description ; : ( -- action ) [ { { "url" [ v-url ] } } validate-params ] >>validate [ username "url" value watch-site site-list-url ] >>submit "add a watched site" >>description ; : ( -- action ) [ { { "url" [ v-url ] } } validate-params ] >>validate [ username "url" value unwatch-site site-list-url ] >>submit "remove a watched site" >>description ; : ( -- action ) [ watch-sites site-list-url ] >>submit "check watched sites" >>description ; : ( -- action ) [ username f select-tuple from-object ] >>init { site-watcher-app "update-notify" } >>template [ { { "email" [ [ v-email ] v-optional ] } { "twitter" [ [ v-one-word ] v-optional ] } { "sms" [ [ v-one-line ] v-optional ] } } validate-params ] >>validate [ username f select-tuple "email" value >>email "twitter" value >>twitter "sms" value >>sms update-tuple site-list-url ] >>submit "update notification details" >>description ; : ( -- dispatcher ) site-watcher-app new-dispatcher "" add-responder "list" add-responder "add" add-responder "remove" add-responder "check" add-responder "update-notify" add-responder ; : ( responder -- responder' ) "SiteWatcher" "SiteWatcher" >>name allow-registration allow-password-recovery allow-edit-profile allow-deactivation ; : ( -- threaded-server ) >>secure-config 8081 >>insecure 8431 >>secure ; : site-watcher-db ( -- db ) "resource:test.db" ; { site-watcher-app "site-watcher" } >>template site-watcher-db main-responder set-global M: site-watcher-app init-user-profile drop "username" value "email" value insert-tuple ; : init-db ( -- ) site-watcher-db [ { site account watching-site } [ ensure-table ] each ] with-db ; : start-site-watcher ( -- ) init-db site-watcher-db run-site-watcher start-server ;