site-watcher uses the db now

diff --git a/extra/site-watcher/authors.txt b/extra/site-watcher/authors.txt
index 7c1b2f22790bfdca05f14a555a40b7eaa3ce2abd..b4bd0e7b35e6a8f0d41992b7e7faba52bb7d25da 100644 (file)
--- a/extra/site-watcher/authors.txt
+++ b/extra/site-watcher/authors.txt
@@ -1 +1 @@
-Doug Coleman
+Doug Coleman
\ No newline at end of file

diff --git a/extra/site-watcher/site-watcher-docs.factor b/extra/site-watcher/site-watcher-docs.factor
deleted file mode 100644 (file)
index 37a1cf1..0000000
--- a/extra/site-watcher/site-watcher-docs.factor
+++ /dev/null
@@ -1,60 +0,0 @@
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: assocs help.markup help.syntax kernel urls alarms calendar ;
-IN: site-watcher
-
-HELP: run-site-watcher
-{ $description "Starts the site-watcher on the assoc stored in " { $link sites } "." } ;
-
-HELP: running-site-watcher
-{ $var-description "A symbol storing the alarm of a running site-watcher if started with the " { $link run-site-watcher } " word. To prevent multiple site-watchers from running, this variable is checked before allowing another site-watcher to start." } ;
-
-HELP: site-watcher-from
-{ $var-description "The email address from which site-watcher sends emails." } ;
-
-HELP: sites
-{ $var-description "A symbol storing an assoc of URLs, data about a site, and who to notify if a site goes down." } ;
-
-HELP: watch-site
-{ $values
-    { "emails" "a string containing an email address, or an array of such" }
-    { "url" url }
-}
-{ $description "Adds a new site to the watch assoc stored in " { $link sites } ", or adds email addresses to an already watched site." } ;
-
-HELP: watch-sites
-{ $values
-    { "assoc" assoc }
-    { "alarm" alarm }
-}
-{ $description "Runs the site-watcher on the input assoc and returns the alarm that times the site check loop. This alarm may be turned off with " { $link cancel-alarm } ", thus stopping the site-watcher." } ;
-
-HELP: site-watcher-frequency
-{ $var-description "A " { $link duration } " specifying how long to wait between checking sites." } ;
-
-HELP: unwatch-site
-{ $values
-    { "emails" "a string containing an email, or an array of such" }
-    { "url" url }
-}
-{ $description "Removes an email address from being notified when a site's goes down. If this email was the last one watching the site, removes the site as well." } ;
-
-HELP: delete-site
-{ $values
-    { "url" url }
-}
-{ $description "Removes a watched site from the " { $link sites } " assoc." } ;
-
-ARTICLE: "site-watcher" "Site watcher"
-"The " { $vocab-link "site-watcher" } " vocabulary monitors websites and sends email when a site goes down or comes up." $nl
-"To monitor a site:"
-{ $subsection watch-site }
-"To stop email addresses from being notified if a site's status changes:"
-{ $subsection unwatch-site }
-"To stop monitoring a site for all email addresses:"
-{ $subsection delete-site }
-"To run site-watcher using the sites variable:"
-{ $subsection run-site-watcher }
-;
-
-ABOUT: "site-watcher"

diff --git a/extra/site-watcher/site-watcher.factor b/extra/site-watcher/site-watcher.factor
index c538b12ed164ae341e63b90510f50146a2241eab..f1e7acbb5a5fa0dabf7f522ba8e70b375ed3f76c 100644 (file)
--- a/extra/site-watcher/site-watcher.factor
+++ b/extra/site-watcher/site-watcher.factor
@@ -1,114 +1,166 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alarms assocs calendar combinators
-continuations fry http.client io.streams.string kernel init
-namespaces prettyprint smtp arrays sequences math math.parser
-strings sets ;
+USING: db.sqlite db.types db.tuples kernel accessors
+db io.files io.files.temp locals io.directories continuations
+assocs sequences alarms namespaces http.client init calendar
+math math.parser smtp strings io prettyprint combinators arrays
+generalizations combinators.smart ;
 IN: site-watcher
 
-SYMBOL: sites
+: ?unparse ( string/object -- string )
+    dup string? [ unparse ] unless ; inline
 
-SYMBOL: site-watcher-from
+: site-watcher-path ( -- path ) "site-watcher.db" temp-file ; inline
 
-sites [ H{ } clone ] initialize
+[ site-watcher-path delete-file ] ignore-errors
 
-TUPLE: watching emails url last-up up? send-email? error ;
+: with-sqlite-db ( quot -- )
+    site-watcher-path <sqlite-db> swap with-db ; inline
 
-<PRIVATE
+TUPLE: account account-id email ;
+
+: <account> ( email -- account )
+    account new
+        swap >>email ;
+
+account "ACCOUNT" {
+    { "account-id" "ACCOUNT_ID" +db-assigned-id+ }
+    { "email" "EMAIL" VARCHAR }
+} define-persistent
+
+TUPLE: site site-id url up? changed? last-up error last-error ;
+
+: <site> ( url -- site )
+    site new
+        swap >>url ;
 
-: ?1array ( array/object -- array )
-    dup array? [ 1array ] unless ; inline
+site "SITE" {
+    { "site-id" "SITE_ID" INTEGER +db-assigned-id+ }
+    { "url" "URL" VARCHAR }
+    { "up?" "UP" BOOLEAN }
+    { "changed?" "CHANGED" BOOLEAN }
+    { "last-up" "LAST_UP" TIMESTAMP }
+    { "error" "ERROR" VARCHAR }
+    { "last-error" "LAST_ERROR" TIMESTAMP }
+} define-persistent
 
-: <watching> ( emails url -- watching )
-    watching new
-        swap >>url
-        swap ?1array >>emails
-        now >>last-up
-        t >>up? ;
+TUPLE: watching-site account-id site-id ;
 
-ERROR: not-watching-site url status ;
+: <watching-site> ( account-id site-id -- watching-site )
+    watching-site new
+        swap >>site-id
+        swap >>account-id ;
+
+watching-site "WATCHING_SITE" {
+    { "account-id" "ACCOUNT_ID" INTEGER +user-assigned-id+ }
+    { "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
+} define-persistent
+
+: select-account/site ( email url -- account site )
+    [ <account> select-tuple account-id>> ]
+    [ <site> select-tuple site-id>> ] bi* ;
+    
+: watch-site ( email url -- )
+    select-account/site <watching-site> insert-tuple ;
+
+: unwatch-site ( email url -- )
+    select-account/site <watching-site> delete-tuples ;
+
+SYMBOL: site-watcher-from
+"factor-site-watcher@gmail.com" site-watcher-from set-global
+
+SYMBOL: site-watcher-frequency
+10 seconds site-watcher-frequency set-global
+ 
+SYMBOL: running-site-watcher
 
-: set-site-flags ( watching new-up? -- watching )
-    [ over up?>> = [ t >>send-email? ] unless ] keep >>up? ;
+<PRIVATE
 
-: site-bad ( watching error -- )
-    >>error f set-site-flags drop ;
+: set-notify-site-watchers ( site new-up? -- site )
+    [ over up?>> = [ t >>changed? ] unless ] keep >>up? ;
 
-: site-good ( watching -- )
+: site-good ( site -- )
+    t set-notify-site-watchers
+    now >>last-up
     f >>error
-    t set-site-flags
-    now >>last-up drop ;
+    f >>last-error
+    update-tuple ;
+
+: site-bad ( site error -- )
+    ?unparse >>error
+    f set-notify-site-watchers
+    now >>last-error
+    update-tuple ;
 
-: check-sites ( assoc -- )
+: check-sites ( seq -- )
     [
-        swap '[ _ http-get 2drop site-good ] [ site-bad ] recover
-    ] assoc-each ;
+        [ dup url>> http-get 2drop site-good ] [ site-bad ] recover
+    ] each ;
 
-: site-up-email ( email watching -- email )
+: site-up-email ( email site -- email )
     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 ;
 
-: ?unparse ( string/object -- string )
-    dup string? [ unparse ] unless ; inline
-
-: site-down-email ( email watching -- email )
-    error>> ?unparse >>body ;
+: site-down-email ( email site -- email )
+    error>> >>body ;
 
-: send-report ( watching -- )
+: send-report ( site -- )
     [ <email> ] dip
     {
-        [ emails>> >>to ]
+        [ 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 ]
-        [ f >>send-email? drop ]
     } cleave send-email ;
 
-: report-sites ( assoc -- )
-    [ nip send-email?>> ] assoc-filter
-    [ nip send-report ] assoc-each ;
+: email-accounts ( seq -- )
+    [ ] [ [ send-report ] each ] if-empty ;
 
-PRIVATE>
+TUPLE: reporting-site email url up? changed? last-up? error last-error ;
 
-SYMBOL: site-watcher-frequency
-site-watcher-frequency [ 5 minutes ] initialize
+: report-sites ( -- )
+    "select account.email, site.url, site.up, site.changed, site.last_up, site.error, site.last_error from account, site, watching_site where account.account_id = watching_site.account_id and site.site_id = watching_site.site_id and site.changed = '1'" sql-query 
+    [ [ reporting-site boa ] input<sequence ] map email-accounts
+    "update site set changed = 'f';" sql-command ;
+
+PRIVATE>
 
-: watch-sites ( assoc -- alarm )
-    '[
-        _ [ check-sites ] [ report-sites ] bi
+: watch-sites ( -- alarm )
+    [
+        [ 
+            f <site> select-tuples check-sites report-sites
+        ] with-sqlite-db
     ] site-watcher-frequency get every ;
 
-: watch-site ( emails url -- )
-    sites get ?at [
-        [ [ ?1array ] dip append prune ] change-emails drop
-    ] [
-        <watching> dup url>> sites get set-at
-    ] if ;
-
-: delete-site ( url -- )
-    sites get delete-at ;
-
-: unwatch-site ( emails url -- )
-    [ ?1array ] dip
-    sites get ?at [
-        [ diff ] change-emails dup emails>> empty? [
-            url>> delete-site
-        ] [
-            drop
-        ] if 
-    ] [
-        nip delete-site
-    ] if ;
+: watch-new-site ( url -- )
+    <site> t >>up? insert-tuple ;
 
-SYMBOL: running-site-watcher
+: insert-account ( email -- )
+    <account> insert-tuple ;
 
 : run-site-watcher ( -- )
-    running-site-watcher get-global [
-        sites get-global watch-sites running-site-watcher set-global
+    running-site-watcher get [ 
+        watch-sites running-site-watcher set-global 
     ] unless ;
 
+: stop-site-watcher ( -- )
+    running-site-watcher get [ cancel-alarm ] when* ;
+
 [ f running-site-watcher set-global ] "site-watcher" add-init-hook
 
-MAIN: run-site-watcher
+
+:: fake-sites ( -- seq )
+    [
+        account ensure-table
+        site ensure-table
+        watching-site ensure-table
+
+        "erg@factorcode.org" insert-account
+        "http://asdfasdfasdfasdfqwerqqq.com" watch-new-site
+        "http://fark.com" watch-new-site
+
+        "erg@factorcode.org" "http://asdfasdfasdfasdfqwerqqq.com" watch-site
+        f <site> select-tuples
+    ] with-sqlite-db ;