steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Working on site-watcher

db4
Slava Pestov 2009-03-18 19:36:04 -05:00
parent 3f1e6a46e4
commit 2628ddde5e
7 changed files with 176 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
extra/site-watcher/db/db.factor
View File

@ -12,8 +12,7 @@ TUPLE: account account-id account-name email ;
swap >>account-name ; swap >>account-name ;
account "ACCOUNT" { account "ACCOUNT" {
{ "account-id" "ACCOUNT_ID" +db-assigned-id+ } { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
{ "account-name" "ACCOUNT_NAME" VARCHAR }
{ "email" "EMAIL" VARCHAR } { "email" "EMAIL" VARCHAR }
} define-persistent } define-persistent
@ -33,15 +32,15 @@ site "SITE" {
{ "last-error" "LAST_ERROR" TIMESTAMP } { "last-error" "LAST_ERROR" TIMESTAMP }
} define-persistent } define-persistent
TUPLE: watching-site account-id site-id ; TUPLE: watching-site account-name site-id ;
: <watching-site> ( account-id site-id -- watching-site ) : <watching-site> ( account-name site-id -- watching-site )
watching-site new watching-site new
swap >>site-id swap >>site-id
swap >>account-id ; swap >>account-name ;
watching-site "WATCHING_SITE" { watching-site "WATCHING_SITE" {
{ "account-id" "ACCOUNT_ID" INTEGER +user-assigned-id+ } { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
{ "site-id" "SITE_ID" INTEGER +user-assigned-id+ } { "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
} define-persistent } define-persistent
@ -71,22 +70,23 @@ TUPLE: reporting-site email url up? changed? last-up? error last-error ;
"update site set changed = 'f';" sql-command ; "update site set changed = 'f';" sql-command ;
: insert-site ( url -- site ) : insert-site ( url -- site )
<site> dup select-tuple [ <site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
dup t >>up? insert-tuple
] unless ;
: insert-account ( account-name -- ) <account> insert-tuple ; : insert-account ( account-name -- ) <account> insert-tuple ;
: find-sites ( -- seq ) f <site> select-tuples ; : find-sites ( -- seq ) f <site> select-tuples ;
: select-account/site ( email url -- account site ) : select-account/site ( username url -- account site )
[ <account> select-tuple account-id>> ] insert-site site-id>> ;
[ insert-site site-id>> ] bi* ;
PRIVATE> PRIVATE>
: watch-site ( email url -- ) : watch-site ( username url -- )
select-account/site <watching-site> insert-tuple ; select-account/site <watching-site> insert-tuple ;
: unwatch-site ( email url -- ) : unwatch-site ( username url -- )
select-account/site <watching-site> delete-tuples ; select-account/site <watching-site> delete-tuples ;
: watching-sites ( username -- sites )
f <watching-site> select-tuples
[ site-id>> site new swap >>site-id select-tuple ] map ;

9
extra/site-watcher/site-watcher.factor
View File

@ -44,14 +44,13 @@ SYMBOL: running-site-watcher
PRIVATE> PRIVATE>
: watch-sites ( -- alarm ) : watch-sites ( -- )
[ find-sites check-sites sites-to-report send-reports ;
find-sites check-sites sites-to-report send-reports
] site-watcher-frequency get every ;
: run-site-watcher ( -- ) : run-site-watcher ( -- )
running-site-watcher get [ running-site-watcher get [
watch-sites running-site-watcher set-global [ watch-sites ] site-watcher-frequency get every
running-site-watcher set-global
] unless ; ] unless ;
: stop-site-watcher ( -- ) : stop-site-watcher ( -- )

7
extra/webapps/site-watcher/main.xml Normal file
View File

@ -0,0 +1,7 @@
<?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<p>SiteWatcher is a free service for web masters. It periodically tries fetching your web site via HTTP, and sends you an e-mail, SMS or Tweet if this fails. <t:a t:href="$site-watcher-app/list">Sign up now!</t:a></p>
</t:chloe>

61
extra/webapps/site-watcher/site-list.xml
View File

@ -2,40 +2,31 @@
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0"> <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<html> <p> Don't you hate it when your web site goes down, and all your users go buy that <a href="http://en.wikipedia.org/wiki/Slanket">slanket</a> from your competitor instead. Now using SiteWatcher, you can ensure this will never happen again! </p>
<head>
<title>SiteWatcher</title> <t:a t:href="$site-watcher-app/update-notify">Contact info</t:a>
</head>
<body> <h3>Step 2: add some sites to watch</h3>
<h1>SiteWatcher</h1>
<h2>It tells you if your web site goes down.</h2> <t:form t:action="$site-watcher-app/add">
<table> <table>
<t:bind-each t:name="sites"> <tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
<tr> </table>
<td> <t:label t:name="url" /> </td> </t:form>
<td> <t:button t:action="$site-watcher-app/remove" t:for="url">Remove</t:button> </td>
</tr> <h3>Step 3: keep track of your sites</h3>
</t:bind-each>
</table> <table border="2">
<p> <tr> <th>URL</th><th></th> </tr>
<t:button t:action="$site-watcher-app/check">Check now</t:button> <t:bind-each t:name="sites">
</p> <tr>
<hr /> <td> <t:label t:name="url" /> </td>
<h3>Add a new site</h3> <td> <t:button t:action="$site-watcher-app/remove" t:for="url">Remove</t:button> </td>
<t:form t:action="$site-watcher-app/add"> </tr>
<table> </t:bind-each>
<tr> </table>
<th>URL:</th> <p>
<td> <t:field t:name="url" t:size="80" /> </td> <t:button t:action="$site-watcher-app/check">Check now</t:button>
</tr> </p>
<tr>
<th>E-mail:</th>
<td> <t:field t:name="email" t:size="80" /> </td>
</tr>
</table>
<p> <button type="submit">Done</button> </p>
</t:form>
</body>
</html>
</t:chloe> </t:chloe>

109
extra/webapps/site-watcher/site-watcher.factor
View File

@ -1,31 +1,51 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors furnace.actions furnace.alloy furnace.redirection USING: accessors assocs db.sqlite furnace.actions furnace.alloy
html.forms http.server http.server.dispatchers namespaces site-watcher furnace.auth furnace.auth.features.deactivate-user
site-watcher.private kernel urls validators db.sqlite assocs ; 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 IN: webapps.site-watcher
TUPLE: site-watcher-app < dispatcher ; TUPLE: site-watcher-app < dispatcher ;
CONSTANT: site-list-url URL" $site-watcher-app/" CONSTANT: site-list-url URL" $site-watcher-app/"
: <main-action> ( -- action )
<page-action>
[
logged-in?
[ URL" $site-watcher-app/list" <redirect> ]
[ { site-watcher-app "main" } <chloe-content> ] if
] >>display ;
: <site-list-action> ( -- action ) : <site-list-action> ( -- action )
<page-action> <page-action>
{ site-watcher-app "site-list" } >>template { site-watcher-app "site-list" } >>template
[ [
begin-form ! Silly query
sites get values "sites" set-value username watching-sites
] >>init ; "sites" set-value
] >>init
<protected>
"list watched sites" >>description ;
: <add-site-action> ( -- action ) : <add-site-action> ( -- action )
<action> <action>
[ [
{ { "url" [ v-url ] } { "email" [ v-email ] } } validate-params { { "url" [ v-url ] } } validate-params
] >>validate ] >>validate
[ [
"email" value "url" value watch-site username "url" value watch-site
site-list-url <redirect> site-list-url <redirect>
] >>submit ; ] >>submit
<protected>
"add a watched site" >>description ;
: <remove-site-action> ( -- action ) : <remove-site-action> ( -- action )
<action> <action>
@ -33,22 +53,79 @@ CONSTANT: site-list-url URL" $site-watcher-app/"
{ { "url" [ v-url ] } } validate-params { { "url" [ v-url ] } } validate-params
] >>validate ] >>validate
[ [
"url" value delete-site username "url" value unwatch-site
site-list-url <redirect> site-list-url <redirect>
] >>submit ; ] >>submit
<protected>
"remove a watched site" >>description ;
: <check-sites-action> ( -- action ) : <check-sites-action> ( -- action )
<action> <action>
[ [
sites get [ check-sites ] [ report-sites ] bi watch-sites
site-list-url <redirect> site-list-url <redirect>
] >>submit ; ] >>submit
<protected>
"check watched sites" >>description ;
: <update-notify-action> ( -- action )
<page-action>
[
username <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 <account> select-tuple
"email" value >>email
update-tuple
site-list-url <redirect>
] >>submit
<protected>
"update notification details" >>description ;
: <site-watcher-app> ( -- dispatcher ) : <site-watcher-app> ( -- dispatcher )
site-watcher-app new-dispatcher site-watcher-app new-dispatcher
<site-list-action> "" add-responder <main-action> "" add-responder
<site-list-action> "list" add-responder
<add-site-action> "add" add-responder <add-site-action> "add" add-responder
<remove-site-action> "remove" add-responder <remove-site-action> "remove" add-responder
<check-sites-action> "check" add-responder ; <check-sites-action> "check" add-responder
<update-notify-action> "update-notify" add-responder ;
<site-watcher-app> "resource:test.db" <sqlite-db> <alloy> main-responder set-global : <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 )
"resource:test.db" <sqlite-db> ;
<site-watcher-app>
<login-config>
<boilerplate> { site-watcher-app "site-watcher" } >>template
site-watcher-db <alloy>
main-responder set-global
: start-site-watcher ( -- )
<site-watcher-server> start-server ;
: init-db ( -- )
site-watcher-db [
{ site account watching-site } [ ensure-table ] each
] with-db ;

16
extra/webapps/site-watcher/site-watcher.xml Normal file
View File

@ -0,0 +1,16 @@
<?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<html>
<head>
<title>SiteWatcher</title>
</head>
<body>
<h1>SiteWatcher</h1>
<h2>It tells you if your web site goes down.</h2>
<t:call-next-template />
</body>
</html>
</t:chloe>

16
extra/webapps/site-watcher/update-notify.xml Normal file
View File

@ -0,0 +1,16 @@
<?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<h3>Enter your contact details</h3>
<t:form t:action="$site-watcher-app/update-notify">
<table>
<tr><th>E-mail:</th><td><t:field t:name="email" t:size="80" /></td></tr>
<tr><th>Twitter:</th><td><t:field t:name="twitter" t:size="80" /></td></tr>
<tr><th>SMS:</th><td><t:field t:name="sms" t:size="80" /></td></tr>
</table>
<p> <button type="submit">Done</button> </p>
</t:form>
</t:chloe>