extra/webapps/site-watcher/site-watcher.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs db.sqlite furnace furnace.actions
   4 furnace.alloy furnace.auth furnace.auth.features.deactivate-user
   5 furnace.auth.features.edit-profile
   6 furnace.auth.features.recover-password
   7 furnace.auth.features.registration furnace.auth.login
   8 furnace.boilerplate furnace.redirection html.forms http.server
   9 http.server.dispatchers kernel namespaces site-watcher site-watcher.db
  10 site-watcher.private urls validators io.sockets.secure.unix.debug
  11 io.servers io.files.temp db db.tuples sequences
  12 webapps.site-watcher.common webapps.site-watcher.watching
  13 webapps.site-watcher.spidering ;
  14 QUALIFIED: assocs
  15 IN: webapps.site-watcher
  16
  17 : <main-action> ( -- action )
  18     <page-action>
  19         { site-watcher-app "main" } >>template ;
  20
  21 : <update-notify-action> ( -- action )
  22     <page-action>
  23         [
  24             username f <account> select-tuple from-object
  25         ] >>init
  26         { site-watcher-app "update-notify" } >>template
  27         [
  28             {
  29                 { "email" [ [ v-email ] v-optional ] }
  30                 { "twitter" [ [ v-one-word ] v-optional ] }
  31                 { "sms" [ [ v-one-line ] v-optional ] }
  32             } validate-params
  33         ] >>validate
  34         [
  35             username f <account> select-tuple
  36             "email" value >>email
  37             "twitter" value >>twitter
  38             "sms" value >>sms
  39             update-tuple
  40             f <redirect>
  41         ] >>submit
  42     <protected>
  43         "update notification details" >>description ;
  44
  45 : <site-watcher-app> ( -- dispatcher )
  46     site-watcher-app new-dispatcher
  47         <main-action> "" add-responder
  48         <watch-list-action> "watch-list" add-responder
  49         <add-watched-site-action> "add-watch" add-responder
  50         <remove-watched-site-action> "remove-watch" add-responder
  51         <check-sites-action> "check" add-responder
  52         <spider-list-action> "spider-list" add-responder
  53         <add-spidered-site-action> "add-spider" add-responder
  54         <remove-spidered-site-action> "remove-spider" add-responder
  55         <spider-sites-action> "spider" add-responder
  56         <update-notify-action> "update-notify" add-responder ;
  57
  58 : <login-config> ( responder -- responder' )
  59     "SiteWatcher" <login-realm>
  60         "SiteWatcher" >>name
  61         allow-registration
  62         allow-password-recovery
  63         allow-edit-profile
  64         allow-deactivation ;
  65
  66 : <site-watcher-server> ( -- threaded-server )
  67     <http-server>
  68         <test-secure-config> >>secure-config
  69         8081 >>insecure
  70         8431 >>secure ;
  71
  72 : site-watcher-db ( -- db )
  73     "test.db" temp-file <sqlite-db> ;
  74
  75 <site-watcher-app>
  76 <login-config>
  77 <boilerplate> { site-watcher-app "site-watcher" } >>template
  78 site-watcher-db <alloy>
  79 main-responder set-global
  80
  81 M: site-watcher-app init-user-profile
  82     drop "username" value "email" value <account> insert-tuple ;
  83
  84 : init-db ( -- )
  85     site-watcher-db [
  86         { site account watching-site spidering-site }
  87         [ ensure-table ] each
  88     ] with-db ;
  89
  90 : start-site-watcher ( -- )
  91     init-db
  92     site-watcher-db run-site-watcher
  93     <site-watcher-server> start-server drop ;