]> gitweb.factorcode.org Git - factor.git/commitdiff
Working on site-watcher
authorSlava Pestov <slava@c-75-72-215-201.hsd1.mn.comcast.net>
Tue, 7 Apr 2009 02:59:27 +0000 (21:59 -0500)
committerSlava Pestov <slava@c-75-72-215-201.hsd1.mn.comcast.net>
Tue, 7 Apr 2009 02:59:27 +0000 (21:59 -0500)
20 files changed:
extra/site-watcher/db/db.factor
extra/site-watcher/site-watcher.factor
extra/site-watcher/spider/spider.factor
extra/spider/report/report.factor
extra/webapps/site-watcher/common/authors.txt [new file with mode: 0644]
extra/webapps/site-watcher/common/common.factor [new file with mode: 0644]
extra/webapps/site-watcher/common/main.xml [new file with mode: 0644]
extra/webapps/site-watcher/common/site-list.xml [new file with mode: 0644]
extra/webapps/site-watcher/common/site-watcher.xml [new file with mode: 0644]
extra/webapps/site-watcher/common/spider-list.xml [new file with mode: 0644]
extra/webapps/site-watcher/common/update-notify.xml [new file with mode: 0644]
extra/webapps/site-watcher/main.xml [deleted file]
extra/webapps/site-watcher/site-list.xml [deleted file]
extra/webapps/site-watcher/site-watcher.factor
extra/webapps/site-watcher/site-watcher.xml [deleted file]
extra/webapps/site-watcher/spidering/authors.txt [new file with mode: 0644]
extra/webapps/site-watcher/spidering/spidering.factor [new file with mode: 0644]
extra/webapps/site-watcher/update-notify.xml [deleted file]
extra/webapps/site-watcher/watching/authors.txt [new file with mode: 0644]
extra/webapps/site-watcher/watching/watching.factor [new file with mode: 0644]

index 26d05441f3d41f00dd6e13bb43a68e0f02d64a25..003b6bb58bd295df1eb142cdf0dd8b46b8cd3473 100644 (file)
@@ -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 ;
 
index c2ec2ada79fd45ae245d0add1b6e2ebe7dadcf8f..535c8cd6261e942548cd35f027b07ed5fc475114 100644 (file)
@@ -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 ;
 
index 1b3a96a018408738efa2085c221bb10629f5136a..335f1f11f9154c48c26963f358a826d0c118e348 100644 (file)
@@ -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
index 48620cac5568e5b5d9f98863d2bf19cb39b18337..7779b233f9adda966f9a6d37ef6ec31c4022fe33 100644 (file)
@@ -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 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -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 (file)
index 0000000..b27cbf3
--- /dev/null
@@ -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 (file)
index 0000000..35a0ccb
--- /dev/null
@@ -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 (file)
index 0000000..765381a
--- /dev/null
@@ -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/common/site-watcher.xml b/extra/webapps/site-watcher/common/site-watcher.xml
new file mode 100644 (file)
index 0000000..5b2b129
--- /dev/null
@@ -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>
diff --git a/extra/webapps/site-watcher/common/spider-list.xml b/extra/webapps/site-watcher/common/spider-list.xml
new file mode 100644 (file)
index 0000000..89d191a
--- /dev/null
@@ -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/common/update-notify.xml b/extra/webapps/site-watcher/common/update-notify.xml
new file mode 100644 (file)
index 0000000..02075de
--- /dev/null
@@ -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>
diff --git a/extra/webapps/site-watcher/main.xml b/extra/webapps/site-watcher/main.xml
deleted file mode 100644 (file)
index 938ff09..0000000
+++ /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 (file)
index c96a25f..0000000
+++ /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>
index f173edb8149cd4ca7b96ab23c731c83f85157e2b..7651afa4e6b1c30473ee1804dbf2d23c034793dc 100644 (file)
@@ -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/site-watcher.xml b/extra/webapps/site-watcher/site-watcher.xml
deleted file mode 100644 (file)
index 5b2b129..0000000
+++ /dev/null
@@ -1,16 +0,0 @@
-<?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>
diff --git a/extra/webapps/site-watcher/spidering/authors.txt b/extra/webapps/site-watcher/spidering/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -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 (file)
index 0000000..d0116a7
--- /dev/null
@@ -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/update-notify.xml b/extra/webapps/site-watcher/update-notify.xml
deleted file mode 100644 (file)
index 02075de..0000000
+++ /dev/null
@@ -1,16 +0,0 @@
-<?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>
diff --git a/extra/webapps/site-watcher/watching/authors.txt b/extra/webapps/site-watcher/watching/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -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 (file)
index 0000000..414595a
--- /dev/null
@@ -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