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

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs db db.sqlite db.tuples 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 sequences validators
  11 webapps.site-watcher.common webapps.site-watcher.watching
  12 webapps.site-watcher.spidering webapps.utils ;
  13 IN: webapps.site-watcher
  14
  15 : <main-action> ( -- action )
  16     <page-action>
  17         { site-watcher-app "main" } >>template ;
  18
  19 : <update-notify-action> ( -- action )
  20     <page-action>
  21         [
  22             username f <account> select-tuple from-object
  23         ] >>init
  24         { site-watcher-app "update-notify" } >>template
  25         [
  26             {
  27                 { "email" [ [ v-email ] v-optional ] }
  28                 { "twitter" [ [ v-one-word ] v-optional ] }
  29                 { "sms" [ [ v-one-line ] v-optional ] }
  30             } validate-params
  31         ] >>validate
  32         [
  33             username f <account> select-tuple
  34             "email" value >>email
  35             "twitter" value >>twitter
  36             "sms" value >>sms
  37             update-tuple
  38             f <redirect>
  39         ] >>submit
  40     <protected>
  41         "update notification details" >>description ;
  42
  43 : <site-watcher> ( -- dispatcher )
  44     site-watcher-app new-dispatcher
  45         <main-action> "" add-responder
  46         <watch-list-action> "watch-list" add-responder
  47         <add-watched-site-action> "add-watch" add-responder
  48         <remove-watched-site-action> "remove-watch" add-responder
  49         <check-sites-action> "check" add-responder
  50         <spider-list-action> "spider-list" add-responder
  51         <add-spidered-site-action> "add-spider" add-responder
  52         <remove-spidered-site-action> "remove-spider" add-responder
  53         <spider-sites-action> "spider" add-responder
  54         <update-notify-action> "update-notify" add-responder ;
  55
  56 : <login-config> ( responder -- responder' )
  57     "SiteWatcher" <login-realm>
  58         allow-registration
  59         allow-password-recovery
  60         allow-edit-profile
  61         allow-deactivation ;
  62
  63 : site-watcher-db ( -- db )
  64     "test.db" <temp-sqlite-db> ;
  65
  66 : <site-watcher-app> ( -- dispatcher )
  67     <site-watcher>
  68     <login-config>
  69     <boilerplate>
  70         { site-watcher-app "site-watcher" } >>template
  71     site-watcher-db <alloy> ;
  72
  73 M: site-watcher-app init-user-profile
  74     drop "username" value "email" value <account> insert-tuple ;
  75
  76 : init-db ( -- )
  77     site-watcher-db [
  78         { site account watching-site spidering-site }
  79         [ ensure-table ] each
  80     ] with-db ;
  81
  82 : start-site-watcher ( -- )
  83     init-db
  84     site-watcher-db run-site-watcher
  85     <site-watcher-app> main-responder set-global
  86     run-test-httpd ;