diff --git a/extra/webapps/site-watcher/authors.txt b/extra/webapps/site-watcher/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/site-watcher/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/site-watcher/site-list.xml b/extra/webapps/site-watcher/site-list.xml new file mode 100644 index 0000000000..9bd1467fc7 --- /dev/null +++ b/extra/webapps/site-watcher/site-list.xml @@ -0,0 +1,41 @@ + + + + + + + SiteWatcher + + +

SiteWatcher

+

It tells you if your web site goes down.

+ + + + + + + +
Remove
+

+ Check now +

+
+

Add a new site

+ + + + + + + + + + +
URL:
E-mail:
+

+
+ + + +
diff --git a/extra/webapps/site-watcher/site-watcher.factor b/extra/webapps/site-watcher/site-watcher.factor new file mode 100644 index 0000000000..a71a14a37a --- /dev/null +++ b/extra/webapps/site-watcher/site-watcher.factor @@ -0,0 +1,54 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors furnace.actions furnace.alloy furnace.redirection +html.forms http.server http.server.dispatchers namespaces site-watcher +site-watcher.private kernel urls validators db.sqlite assocs ; +IN: webapps.site-watcher + +TUPLE: site-watcher-app < dispatcher ; + +CONSTANT: site-list-url URL" $site-watcher-app/" + +: ( -- action ) + + { site-watcher-app "site-list" } >>template + [ + begin-form + sites get values "sites" set-value + ] >>init ; + +: ( -- action ) + + [ + { { "url" [ v-url ] } { "email" [ v-email ] } } validate-params + ] >>validate + [ + "email" value "url" value watch-site + site-list-url + ] >>submit ; + +: ( -- action ) + + [ + { { "url" [ v-url ] } } validate-params + ] >>validate + [ + "url" value delete-site + site-list-url + ] >>submit ; + +: ( -- action ) + + [ + sites get [ check-sites ] [ report-sites ] bi + site-list-url + ] >>submit ; + +: ( -- dispatcher ) + site-watcher-app new-dispatcher + "" add-responder + "add" add-responder + "remove" add-responder + "check" add-responder ; + + "resource:test.db" main-responder set-global \ No newline at end of file