! 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
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 }
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
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 )
[ [ 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 ;
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 ;
! 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 )
[ <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 ;
\ No newline at end of file
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 -- )
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! 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 ;
--- /dev/null
+<?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>
--- /dev/null
+<?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>
--- /dev/null
+<?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>
--- /dev/null
+<?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>
--- /dev/null
+<?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>
+++ /dev/null
-<?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>
+++ /dev/null
-<?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>
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>
: <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' )
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 ( -- )
+++ /dev/null
-<?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>
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! 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 ;
\ No newline at end of file
+++ /dev/null
-<?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>
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! 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 ;
\ No newline at end of file