94 lines
		
	
	
		
			3.1 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			94 lines
		
	
	
		
			3.1 KiB
		
	
	
	
		
			Factor
		
	
	
| ! 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 io.files.temp db db.tuples sequences
 | |
| webapps.site-watcher.common webapps.site-watcher.watching
 | |
| webapps.site-watcher.spidering ;
 | |
| QUALIFIED: assocs
 | |
| IN: webapps.site-watcher
 | |
| 
 | |
| : <main-action> ( -- action )
 | |
|     <page-action>
 | |
|         { site-watcher-app "main" } >>template ;
 | |
| 
 | |
| : <update-notify-action> ( -- action )
 | |
|     <page-action>
 | |
|         [
 | |
|             username f <account> 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 <account> select-tuple
 | |
|             "email" value >>email
 | |
|             "twitter" value >>twitter
 | |
|             "sms" value >>sms
 | |
|             update-tuple
 | |
|             f <redirect>
 | |
|         ] >>submit
 | |
|     <protected>
 | |
|         "update notification details" >>description ;
 | |
| 
 | |
| : <site-watcher-app> ( -- dispatcher )
 | |
|     site-watcher-app new-dispatcher
 | |
|         <main-action> "" add-responder
 | |
|         <watch-list-action> "watch-list" add-responder
 | |
|         <add-watched-site-action> "add-watch" add-responder
 | |
|         <remove-watched-site-action> "remove-watch" add-responder
 | |
|         <check-sites-action> "check" add-responder
 | |
|         <spider-list-action> "spider-list" add-responder
 | |
|         <add-spidered-site-action> "add-spider" add-responder
 | |
|         <remove-spidered-site-action> "remove-spider" add-responder
 | |
|         <spider-sites-action> "spider" add-responder
 | |
|         <update-notify-action> "update-notify" add-responder ;
 | |
| 
 | |
| : <login-config> ( responder -- responder' )
 | |
|     "SiteWatcher" <login-realm>
 | |
|         "SiteWatcher" >>name
 | |
|         allow-registration
 | |
|         allow-password-recovery
 | |
|         allow-edit-profile
 | |
|         allow-deactivation ;
 | |
| 
 | |
| : <site-watcher-server> ( -- threaded-server )
 | |
|     <http-server>
 | |
|         <test-secure-config> >>secure-config
 | |
|         8081 >>insecure
 | |
|         8431 >>secure ;
 | |
| 
 | |
| : site-watcher-db ( -- db )
 | |
|     "test.db" temp-file <sqlite-db> ;
 | |
| 
 | |
| <site-watcher-app>
 | |
| <login-config>
 | |
| <boilerplate> { site-watcher-app "site-watcher" } >>template
 | |
| site-watcher-db <alloy>
 | |
| main-responder set-global
 | |
| 
 | |
| M: site-watcher-app init-user-profile
 | |
|     drop "username" value "email" value <account> insert-tuple ;
 | |
| 
 | |
| : init-db ( -- )
 | |
|     site-watcher-db [
 | |
|         { site account watching-site spidering-site }
 | |
|         [ ensure-table ] each
 | |
|     ] with-db ;
 | |
| 
 | |
| : start-site-watcher ( -- )
 | |
|     init-db
 | |
|     site-watcher-db run-site-watcher
 | |
|     <site-watcher-server> start-server ;
 |