Working on site-watcher
Slava Pestov
parent
dc8329bca0
commit
9f08e3a6bf
|
|
@ -2,10 +2,10 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors continuations db db.sqlite db.tuples db.types
|
||||
io.directories io.files.temp kernel io.streams.string calendar
|
||||
debugger combinators.smart sequences ;
|
||||
debugger combinators.smart sequences arrays ;
|
||||
IN: site-watcher.db
|
||||
|
||||
TUPLE: account account-id account-name email twitter sms ;
|
||||
TUPLE: account account-name email twitter sms ;
|
||||
|
||||
: <account> ( account-name email -- account )
|
||||
account new
|
||||
|
|
@ -25,6 +25,12 @@ TUPLE: site site-id url up? changed? last-up error last-error ;
|
|||
site new
|
||||
swap >>url ;
|
||||
|
||||
: site-with-url ( url -- site )
|
||||
<site> select-tuple ;
|
||||
|
||||
: site-with-id ( id -- site )
|
||||
site new swap >>site-id select-tuple ;
|
||||
|
||||
site "SITE" {
|
||||
{ "site-id" "SITE_ID" INTEGER +db-assigned-id+ }
|
||||
{ "url" "URL" VARCHAR }
|
||||
|
|
@ -49,10 +55,12 @@ watching-site "WATCHING_SITE" {
|
|||
|
||||
TUPLE: spidering-site < watching-site max-depth max-count ;
|
||||
|
||||
C: <spidering-site> spidering-site
|
||||
|
||||
SLOT: site
|
||||
|
||||
M: watching-site site>>
|
||||
site-id>> site new swap >>site-id select-tuple ;
|
||||
site-id>> site-with-id ;
|
||||
|
||||
SLOT: account
|
||||
|
||||
|
|
@ -60,12 +68,25 @@ M: watching-site account>>
|
|||
account-name>> account new swap >>account-name select-tuple ;
|
||||
|
||||
spidering-site "SPIDERING_SITE" {
|
||||
{ "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
|
||||
{ "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
|
||||
{ "max-depth" "MAX_DEPTH" INTEGER }
|
||||
{ "max-count" "MAX_COUNT" INTEGER }
|
||||
} define-persistent
|
||||
|
||||
: spidering-sites ( username -- sites )
|
||||
spidering-site new swap >>account-name select-tuples ;
|
||||
|
||||
: insert-site ( url -- site )
|
||||
<site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
|
||||
|
||||
: select-account/site ( username url -- account site )
|
||||
insert-site site-id>> ;
|
||||
|
||||
: add-spidered-site ( username url -- )
|
||||
select-account/site 10 10 <spidering-site> insert-tuple ;
|
||||
|
||||
: remove-spidered-site ( username url -- )
|
||||
select-account/site 10 10 <spidering-site> delete-tuples ;
|
||||
|
||||
TUPLE: reporting-site site-id email url up? changed? last-up? error last-error ;
|
||||
|
||||
: set-notify-site-watchers ( site new-up? -- site )
|
||||
|
|
@ -89,16 +110,10 @@ TUPLE: reporting-site site-id email url up? changed? last-up? error last-error ;
|
|||
[ [ reporting-site boa ] input<sequence ] map
|
||||
"update site set changed = 0;" sql-command ;
|
||||
|
||||
: insert-site ( url -- site )
|
||||
<site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
|
||||
|
||||
: insert-account ( account-name email -- ) <account> insert-tuple ;
|
||||
|
||||
: find-sites ( -- seq ) f <site> select-tuples ;
|
||||
|
||||
: select-account/site ( username url -- account site )
|
||||
insert-site site-id>> ;
|
||||
|
||||
: watch-site ( username url -- )
|
||||
select-account/site <watching-site> insert-tuple ;
|
||||
|
||||
|
|
|
|||
|
|
@ -38,12 +38,12 @@ SYMBOL: running-site-watcher
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: watch-sites ( db -- )
|
||||
[ find-sites check-sites sites-to-report send-reports ] with-db ;
|
||||
: watch-sites ( -- )
|
||||
find-sites check-sites sites-to-report send-reports ;
|
||||
|
||||
: run-site-watcher ( db -- )
|
||||
[ running-site-watcher get ] dip '[
|
||||
[ _ watch-sites ] site-watcher-frequency get every
|
||||
[ _ [ watch-sites ] with-db ] site-watcher-frequency get every
|
||||
running-site-watcher set
|
||||
] unless ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: site-watcher.db site-watcher.email
|
||||
USING: site-watcher.db site-watcher.email site-watcher.spider
|
||||
spider spider.report
|
||||
accessors kernel sequences
|
||||
xml.writer ;
|
||||
xml.writer concurrency.combinators ;
|
||||
IN: site-watcher.spider
|
||||
|
||||
: <site-spider> ( spidering-site -- spider )
|
||||
|
|
@ -20,3 +20,6 @@ IN: site-watcher.spider
|
|||
[ <site-spider> run-spider spider-report xml>string ]
|
||||
[ site>> url>> "Spidered " prefix ] tri
|
||||
send-site-email ;
|
||||
|
||||
: spider-sites ( -- )
|
||||
f spidering-sites [ spider-and-email ] parallel-each ;
|
||||
|
|
@ -39,10 +39,11 @@ SYMBOL: time-std
|
|||
timings get sort-values
|
||||
[ slowest short tail* reverse slowest-pages set ]
|
||||
[
|
||||
values
|
||||
[ mean 1000000 /f mean-time set ]
|
||||
[ median 1000000 /f median-time set ]
|
||||
[ std 1000000 /f time-std set ] tri
|
||||
values [
|
||||
[ mean 1000000 /f mean-time set ]
|
||||
[ median 1000000 /f median-time set ]
|
||||
[ std 1000000 /f time-std set ] tri
|
||||
] unless-empty
|
||||
] bi ;
|
||||
|
||||
: process-results ( results -- )
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: http.server.dispatchers ;
|
||||
IN: webapps.site-watcher.common
|
||||
|
||||
TUPLE: site-watcher-app < dispatcher ;
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
<?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/login">Sign up now!</t:a></p>
|
||||
|
||||
<ul>
|
||||
<li><t:a t:href="$site-watcher-app/update-notify">Your contact info</t:a></li>
|
||||
<li><t:a t:href="$site-watcher-app/watch-list">Watched sites</t:a></li>
|
||||
<li><t:a t:href="$site-watcher-app/spider-list">Spidered sites</t:a></li>
|
||||
</ul>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<h1>Add some sites to watch</h1>
|
||||
|
||||
<t:form t:action="$site-watcher-app/add-watch">
|
||||
<table>
|
||||
<tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
|
||||
</table>
|
||||
</t:form>
|
||||
|
||||
<h1>Keep track of your sites</h1>
|
||||
|
||||
<table border="2">
|
||||
<tr> <th>URL</th><th></th> </tr>
|
||||
<t:bind-each t:name="sites">
|
||||
<tr>
|
||||
<td> <t:label t:name="url" /> </td>
|
||||
<td> <t:button t:action="$site-watcher-app/remove-watch" t:for="url">Remove</t:button> </td>
|
||||
</tr>
|
||||
</t:bind-each>
|
||||
</table>
|
||||
<p>
|
||||
<t:button t:action="$site-watcher-app/check">Check now</t:button>
|
||||
</p>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<h1>Add a site to spider</h1>
|
||||
|
||||
<t:form t:action="$site-watcher-app/add-spider">
|
||||
<table>
|
||||
<tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
|
||||
</table>
|
||||
</t:form>
|
||||
|
||||
<h1>Spidered sites</h1>
|
||||
|
||||
<table border="2">
|
||||
<tr> <th>URL</th><th></th> </tr>
|
||||
<t:bind-each t:name="sites">
|
||||
<tr>
|
||||
<td> <t:label t:name="url" /> </td>
|
||||
<td> <t:button t:action="$site-watcher-app/remove-spider" t:for="url">Remove</t:button> </td>
|
||||
</tr>
|
||||
</t:bind-each>
|
||||
</table>
|
||||
<p>
|
||||
<t:button t:action="$site-watcher-app/spider">Spider now</t:button>
|
||||
</p>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
<?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>
|
||||
|
|
@ -1,32 +0,0 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<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>
|
||||
|
||||
<t:a t:href="$site-watcher-app/update-notify">Contact info</t:a>
|
||||
|
||||
<h3>Step 2: add some sites to watch</h3>
|
||||
|
||||
<t:form t:action="$site-watcher-app/add">
|
||||
<table>
|
||||
<tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
|
||||
</table>
|
||||
</t:form>
|
||||
|
||||
<h3>Step 3: keep track of your sites</h3>
|
||||
|
||||
<table border="2">
|
||||
<tr> <th>URL</th><th></th> </tr>
|
||||
<t:bind-each t:name="sites">
|
||||
<tr>
|
||||
<td> <t:label t:name="url" /> </td>
|
||||
<td> <t:button t:action="$site-watcher-app/remove" t:for="url">Remove</t:button> </td>
|
||||
</tr>
|
||||
</t:bind-each>
|
||||
</table>
|
||||
<p>
|
||||
<t:button t:action="$site-watcher-app/check">Check now</t:button>
|
||||
</p>
|
||||
|
||||
</t:chloe>
|
||||
|
|
@ -8,65 +8,14 @@ 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 ;
|
||||
io.servers.connection db db.tuples sequences webapps.site-watcher.common
|
||||
webapps.site-watcher.watching webapps.site-watcher.spidering ;
|
||||
QUALIFIED: assocs
|
||||
IN: webapps.site-watcher
|
||||
|
||||
TUPLE: site-watcher-app < dispatcher ;
|
||||
|
||||
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 )
|
||||
<page-action>
|
||||
{ site-watcher-app "site-list" } >>template
|
||||
[
|
||||
! Silly query
|
||||
username watching-sites
|
||||
"sites" set-value
|
||||
] >>init
|
||||
<protected>
|
||||
"list watched sites" >>description ;
|
||||
|
||||
: <add-site-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
{ { "url" [ v-url ] } } validate-params
|
||||
] >>validate
|
||||
[
|
||||
username "url" value watch-site
|
||||
site-list-url <redirect>
|
||||
] >>submit
|
||||
<protected>
|
||||
"add a watched site" >>description ;
|
||||
|
||||
: <remove-site-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
{ { "url" [ v-url ] } } validate-params
|
||||
] >>validate
|
||||
[
|
||||
username "url" value unwatch-site
|
||||
site-list-url <redirect>
|
||||
] >>submit
|
||||
<protected>
|
||||
"remove a watched site" >>description ;
|
||||
|
||||
: <check-sites-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
watch-sites
|
||||
site-list-url <redirect>
|
||||
] >>submit
|
||||
<protected>
|
||||
"check watched sites" >>description ;
|
||||
{ site-watcher-app "main" } >>template ;
|
||||
|
||||
: <update-notify-action> ( -- action )
|
||||
<page-action>
|
||||
|
|
@ -95,10 +44,14 @@ CONSTANT: site-list-url URL" $site-watcher-app/"
|
|||
: <site-watcher-app> ( -- dispatcher )
|
||||
site-watcher-app new-dispatcher
|
||||
<main-action> "" add-responder
|
||||
<site-list-action> "list" add-responder
|
||||
<add-site-action> "add" add-responder
|
||||
<remove-site-action> "remove" 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' )
|
||||
|
|
@ -125,12 +78,13 @@ site-watcher-db <alloy>
|
|||
main-responder set-global
|
||||
|
||||
M: site-watcher-app init-user-profile
|
||||
drop
|
||||
drop B
|
||||
"username" value "email" value <account> insert-tuple ;
|
||||
|
||||
: init-db ( -- )
|
||||
site-watcher-db [
|
||||
{ site account watching-site } [ ensure-table ] each
|
||||
{ site account watching-site spidering-site }
|
||||
[ ensure-table ] each
|
||||
] with-db ;
|
||||
|
||||
: start-site-watcher ( -- )
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors furnace.actions furnace.auth
|
||||
furnace.redirection html.forms validators webapps.site-watcher.common
|
||||
site-watcher.db site-watcher.spider kernel urls sequences ;
|
||||
IN: webapps.site-watcher.spidering
|
||||
|
||||
CONSTANT: site-list-url URL" $site-watcher-app/spider-list"
|
||||
|
||||
: <spider-list-action> ( -- action )
|
||||
<page-action>
|
||||
{ site-watcher-app "spider-list" } >>template
|
||||
[
|
||||
! Silly query
|
||||
username B spidering-sites [ site>> ] map
|
||||
"sites" set-value
|
||||
] >>init
|
||||
<protected>
|
||||
"list spidered sites" >>description ;
|
||||
|
||||
: <add-spidered-site-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
{ { "url" [ v-url ] } } validate-params
|
||||
] >>validate
|
||||
[
|
||||
username "url" value add-spidered-site
|
||||
site-list-url <redirect>
|
||||
] >>submit
|
||||
<protected>
|
||||
"add a spidered site" >>description ;
|
||||
|
||||
: <remove-spidered-site-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
{ { "url" [ v-url ] } } validate-params
|
||||
] >>validate
|
||||
[
|
||||
username "url" value remove-spidered-site
|
||||
site-list-url <redirect>
|
||||
] >>submit
|
||||
<protected>
|
||||
"remove a spidered site" >>description ;
|
||||
|
||||
: <spider-sites-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
spider-sites
|
||||
site-list-url <redirect>
|
||||
] >>submit
|
||||
<protected>
|
||||
"spider sites" >>description ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors furnace.actions furnace.auth
|
||||
furnace.redirection html.forms site-watcher site-watcher.db
|
||||
validators webapps.site-watcher.common urls ;
|
||||
IN: webapps.site-watcher.watching
|
||||
|
||||
CONSTANT: site-list-url URL" $site-watcher-app/watch-list"
|
||||
|
||||
: <watch-list-action> ( -- action )
|
||||
<page-action>
|
||||
{ site-watcher-app "site-list" } >>template
|
||||
[
|
||||
! Silly query
|
||||
username watching-sites
|
||||
"sites" set-value
|
||||
] >>init
|
||||
<protected>
|
||||
"list watched sites" >>description ;
|
||||
|
||||
: <add-watched-site-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
{ { "url" [ v-url ] } } validate-params
|
||||
] >>validate
|
||||
[
|
||||
username "url" value watch-site
|
||||
site-list-url <redirect>
|
||||
] >>submit
|
||||
<protected>
|
||||
"add a watched site" >>description ;
|
||||
|
||||
: <remove-watched-site-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
{ { "url" [ v-url ] } } validate-params
|
||||
] >>validate
|
||||
[
|
||||
username "url" value unwatch-site
|
||||
site-list-url <redirect>
|
||||
] >>submit
|
||||
<protected>
|
||||
"remove a watched site" >>description ;
|
||||
|
||||
: <check-sites-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
watch-sites
|
||||
site-list-url <redirect>
|
||||
] >>submit
|
||||
<protected>
|
||||
"check watched sites" >>description ;
|
||||
Loading…
Reference in New Issue