Factor out site-watcher.email, start work on site-watcher.spider

extra/benchmark/fib6/deploy.factor

@@ -0,0 +1,15 @@
+USING: tools.deploy.config ;
+H{
+    { deploy-name "benchmark.fib6" }
+    { deploy-threads? f }
+    { deploy-math? f }
+    { deploy-word-props? f }
+    { deploy-ui? f }
+    { deploy-io 1 }
+    { deploy-compiler? t }
+    { deploy-reflection 1 }
+    { "stop-after-last-window?" t }
+    { deploy-unicode? f }
+    { deploy-word-defs? f }
+    { deploy-c-types? f }
+}

extra/site-watcher/db/db.factor

@@ -47,9 +47,26 @@ watching-site "WATCHING_SITE" {
     { "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
 } define-persistent
 
-TUPLE: reporting-site email url up? changed? last-up? error last-error ;
+TUPLE: spidering-site < watching-site max-depth max-count ;
 
-<PRIVATE
+SLOT: site
+
+M: watching-site site>>
+    site-id>> site new swap >>site-id select-tuple ;
+
+SLOT: account
+
+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
+
+TUPLE: reporting-site site-id email url up? changed? last-up? error last-error ;
 
 : set-notify-site-watchers ( site new-up? -- site )
     [ over up?>> = [ t >>changed? ] unless ] keep >>up? ;
@@ -82,8 +99,6 @@ TUPLE: reporting-site email url up? changed? last-up? error last-error ;
 : select-account/site ( username url -- account site )
     insert-site site-id>> ;
 
-PRIVATE>
-
 : watch-site ( username url -- )
     select-account/site <watching-site> insert-tuple ;
 

extra/site-watcher/email/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/site-watcher/email/email.factor

@@ -0,0 +1,14 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: smtp namespaces accessors kernel arrays ;
+IN: site-watcher.email
+
+SYMBOL: site-watcher-from
+site-watcher-from [ "factor-site-watcher@gmail.com" ] initialize
+
+: send-site-email ( watching-site body subject -- )
+    [ account>> email>> ] 2dip
+    pick [
+        [ <email> site-watcher-from get >>from ] 3dip
+        [ 1array >>to ] [ >>body ] [ >>subject ] tri* send-email 
+    ] [ 3drop ] if ;

extra/site-watcher/site-watcher.factor

@@ -3,13 +3,9 @@
 USING: accessors alarms arrays calendar combinators
 combinators.smart continuations debugger http.client fry
 init io.streams.string kernel locals math math.parser db
-namespaces sequences site-watcher.db site-watcher.db.private
-smtp ;
+namespaces sequences site-watcher.db site-watcher.email ;
 IN: site-watcher
 
-SYMBOL: site-watcher-from
-"factor-site-watcher@gmail.com" site-watcher-from set-global
-
 SYMBOL: site-watcher-frequency
 5 minutes site-watcher-frequency set-global
  
@@ -23,22 +19,19 @@ SYMBOL: running-site-watcher
         [ dup url>> http-get 2drop site-good ] [ site-bad ] recover
     ] each ;
 
-: site-up-email ( email site -- email )
+: site-up-email ( site -- body )
     last-up>> now swap time- duration>minutes 60 /mod
     [ >integer number>string ] bi@
     [ " hours, " append ] [ " minutes" append ] bi* append
-    "Site was down for (at least): " prepend >>body ;
+    "Site was down for (at least): " prepend ;
 
-: site-down-email ( email site -- email ) error>> >>body ;
+: site-down-email ( site -- body ) error>> ;
 
 : send-report ( site -- )
-    [ <email> ] dip
-    {
-        [ email>> 1array >>to ]
-        [ drop site-watcher-from get "factor.site.watcher@gmail.com" or >>from ]
-        [ dup up?>> [ site-up-email ] [ site-down-email ] if ]
-        [ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue >>subject ]
-    } cleave send-email ;
+    [ ]
+    [ dup up?>> [ site-up-email ] [ site-down-email ] if ]
+    [ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue ] tri
+    send-site-email ;
 
 : send-reports ( seq -- )
     [ ] [ [ send-report ] each ] if-empty ;

extra/site-watcher/spider/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/site-watcher/spider/spider.factor

@@ -0,0 +1,22 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: site-watcher.db site-watcher.email
+spider spider.report
+accessors kernel sequences
+xml.writer ;
+IN: site-watcher.spider
+
+: <site-spider> ( spidering-site -- spider )
+    [ max-depth>> ]
+    [ max-count>> ]
+    [ site>> url>> ]
+    tri
+    <spider>
+        swap >>max-count
+        swap >>max-depth ;
+
+: spider-and-email ( spidering-site -- )
+    [ ]
+    [ <site-spider> run-spider spider-report xml>string ]
+    [ site>> url>> "Spidered " prefix ] tri
+    send-site-email ;

extra/spider/report/report.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators kernel math
 math.statistics namespaces sequences sorting xml.syntax
-spider ;
+spider urls html ;
 IN: spider.report
 
 SYMBOL: network-failures
@@ -87,27 +87,37 @@ SYMBOL: time-std
     slowest-pages-table
     timing-summary-table
     [XML
-    <h2>Slowest pages</h2>
+    <h3>Slowest pages</h3>
     <->
 
-    <h2>Summary</h2>
+    <h3>Summary</h3>
     <->
     XML] ;
 
 : generate-report ( -- html )
+    url get dup
     report-broken-pages
     report-network-failures
     report-timings
     [XML
-    <h1>Broken pages</h1>
+    <h1>Spider report</h1>
+    URL: <a href=<->><-></a>
+
+    <h2>Broken pages</h2>
     <->
 
-    <h1>Network failures</h1>
+    <h2>Network failures</h2>
     <->
 
-    <h1>Load times</h1>
+    <h2>Load times</h2>
     <->
     XML] ;
 
 : spider-report ( spider -- html )
-    [ spidered>> process-results generate-report ] with-scope ;
+    [ "Spider report" f ] dip
+    [
+        [ base>> url set ]
+        [ spidered>> process-results ] bi
+        generate-report
+    ] with-scope
+    simple-page ;