From 9f08e3a6bf57a87e4c4ca5bdbcd5e76e6c99dfec Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@c-75-72-215-201.hsd1.mn.comcast.net>
Date: Mon, 6 Apr 2009 21:59:27 -0500
Subject: [PATCH] Working on site-watcher

---
 extra/site-watcher/db/db.factor               | 37 +++++++---
 extra/site-watcher/site-watcher.factor        |  6 +-
 extra/site-watcher/spider/spider.factor       |  7 +-
 extra/spider/report/report.factor             |  9 +--
 extra/webapps/site-watcher/common/authors.txt |  1 +
 .../webapps/site-watcher/common/common.factor |  6 ++
 extra/webapps/site-watcher/common/main.xml    | 13 ++++
 .../webapps/site-watcher/common/site-list.xml | 28 ++++++++
 .../{ => common}/site-watcher.xml             |  0
 .../site-watcher/common/spider-list.xml       | 28 ++++++++
 .../{ => common}/update-notify.xml            |  0
 extra/webapps/site-watcher/main.xml           |  7 --
 extra/webapps/site-watcher/site-list.xml      | 32 ---------
 .../webapps/site-watcher/site-watcher.factor  | 72 ++++---------------
 .../site-watcher/spidering/authors.txt        |  1 +
 .../site-watcher/spidering/spidering.factor   | 52 ++++++++++++++
 .../webapps/site-watcher/watching/authors.txt |  1 +
 .../site-watcher/watching/watching.factor     | 52 ++++++++++++++
 18 files changed, 234 insertions(+), 118 deletions(-)
 create mode 100644 extra/webapps/site-watcher/common/authors.txt
 create mode 100644 extra/webapps/site-watcher/common/common.factor
 create mode 100644 extra/webapps/site-watcher/common/main.xml
 create mode 100644 extra/webapps/site-watcher/common/site-list.xml
 rename extra/webapps/site-watcher/{ => common}/site-watcher.xml (100%)
 create mode 100644 extra/webapps/site-watcher/common/spider-list.xml
 rename extra/webapps/site-watcher/{ => common}/update-notify.xml (100%)
 delete mode 100644 extra/webapps/site-watcher/main.xml
 delete mode 100644 extra/webapps/site-watcher/site-list.xml
 create mode 100644 extra/webapps/site-watcher/spidering/authors.txt
 create mode 100644 extra/webapps/site-watcher/spidering/spidering.factor
 create mode 100644 extra/webapps/site-watcher/watching/authors.txt
 create mode 100644 extra/webapps/site-watcher/watching/watching.factor

diff --git a/extra/site-watcher/db/db.factor b/extra/site-watcher/db/db.factor
index 26d05441f3..003b6bb58b 100644
--- a/extra/site-watcher/db/db.factor
+++ b/extra/site-watcher/db/db.factor
@@ -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 ;
 
diff --git a/extra/site-watcher/site-watcher.factor b/extra/site-watcher/site-watcher.factor
index c2ec2ada79..535c8cd626 100644
--- a/extra/site-watcher/site-watcher.factor
+++ b/extra/site-watcher/site-watcher.factor
@@ -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 ;
 
diff --git a/extra/site-watcher/spider/spider.factor b/extra/site-watcher/spider/spider.factor
index 1b3a96a018..335f1f11f9 100644
--- a/extra/site-watcher/spider/spider.factor
+++ b/extra/site-watcher/spider/spider.factor
@@ -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 ;
\ No newline at end of file
diff --git a/extra/spider/report/report.factor b/extra/spider/report/report.factor
index 48620cac55..7779b233f9 100644
--- a/extra/spider/report/report.factor
+++ b/extra/spider/report/report.factor
@@ -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 -- )
diff --git a/extra/webapps/site-watcher/common/authors.txt b/extra/webapps/site-watcher/common/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /dev/null
+++ b/extra/webapps/site-watcher/common/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/extra/webapps/site-watcher/common/common.factor b/extra/webapps/site-watcher/common/common.factor
new file mode 100644
index 0000000000..b27cbf3f7f
--- /dev/null
+++ b/extra/webapps/site-watcher/common/common.factor
@@ -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 ;
diff --git a/extra/webapps/site-watcher/common/main.xml b/extra/webapps/site-watcher/common/main.xml
new file mode 100644
index 0000000000..35a0ccb6d1
--- /dev/null
+++ b/extra/webapps/site-watcher/common/main.xml
@@ -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>
diff --git a/extra/webapps/site-watcher/common/site-list.xml b/extra/webapps/site-watcher/common/site-list.xml
new file mode 100644
index 0000000000..765381a4c4
--- /dev/null
+++ b/extra/webapps/site-watcher/common/site-list.xml
@@ -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>
diff --git a/extra/webapps/site-watcher/site-watcher.xml b/extra/webapps/site-watcher/common/site-watcher.xml
similarity index 100%
rename from extra/webapps/site-watcher/site-watcher.xml
rename to extra/webapps/site-watcher/common/site-watcher.xml
diff --git a/extra/webapps/site-watcher/common/spider-list.xml b/extra/webapps/site-watcher/common/spider-list.xml
new file mode 100644
index 0000000000..89d191ab41
--- /dev/null
+++ b/extra/webapps/site-watcher/common/spider-list.xml
@@ -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>
diff --git a/extra/webapps/site-watcher/update-notify.xml b/extra/webapps/site-watcher/common/update-notify.xml
similarity index 100%
rename from extra/webapps/site-watcher/update-notify.xml
rename to extra/webapps/site-watcher/common/update-notify.xml
diff --git a/extra/webapps/site-watcher/main.xml b/extra/webapps/site-watcher/main.xml
deleted file mode 100644
index 938ff09825..0000000000
--- a/extra/webapps/site-watcher/main.xml
+++ /dev/null
@@ -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>
diff --git a/extra/webapps/site-watcher/site-list.xml b/extra/webapps/site-watcher/site-list.xml
deleted file mode 100644
index c96a25f443..0000000000
--- a/extra/webapps/site-watcher/site-list.xml
+++ /dev/null
@@ -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>
diff --git a/extra/webapps/site-watcher/site-watcher.factor b/extra/webapps/site-watcher/site-watcher.factor
index f173edb814..7651afa4e6 100644
--- a/extra/webapps/site-watcher/site-watcher.factor
+++ b/extra/webapps/site-watcher/site-watcher.factor
@@ -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 ( -- )
diff --git a/extra/webapps/site-watcher/spidering/authors.txt b/extra/webapps/site-watcher/spidering/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /dev/null
+++ b/extra/webapps/site-watcher/spidering/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/extra/webapps/site-watcher/spidering/spidering.factor b/extra/webapps/site-watcher/spidering/spidering.factor
new file mode 100644
index 0000000000..d0116a7f2d
--- /dev/null
+++ b/extra/webapps/site-watcher/spidering/spidering.factor
@@ -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 ;
\ No newline at end of file
diff --git a/extra/webapps/site-watcher/watching/authors.txt b/extra/webapps/site-watcher/watching/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /dev/null
+++ b/extra/webapps/site-watcher/watching/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/extra/webapps/site-watcher/watching/watching.factor b/extra/webapps/site-watcher/watching/watching.factor
new file mode 100644
index 0000000000..414595a12a
--- /dev/null
+++ b/extra/webapps/site-watcher/watching/watching.factor
@@ -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 ;
\ No newline at end of file