extra/site-watcher/db/db.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors continuations db db.sqlite db.tuples db.types
   4 io.directories io.files.temp kernel io.streams.string calendar
   5 debugger combinators.smart sequences ;
   6 IN: site-watcher.db
   7
   8 TUPLE: account account-id account-name email ;
   9
  10 : <account> ( account-name -- account )
  11     account new
  12         swap >>account-name ;
  13
  14 account "ACCOUNT" {
  15     { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
  16     { "email" "EMAIL" VARCHAR }
  17 } define-persistent
  18
  19 TUPLE: site site-id url up? changed? last-up error last-error ;
  20
  21 : <site> ( url -- site )
  22     site new
  23         swap >>url ;
  24
  25 site "SITE" {
  26     { "site-id" "SITE_ID" INTEGER +db-assigned-id+ }
  27     { "url" "URL" VARCHAR }
  28     { "up?" "UP" BOOLEAN }
  29     { "changed?" "CHANGED" BOOLEAN }
  30     { "last-up" "LAST_UP" TIMESTAMP }
  31     { "error" "ERROR" VARCHAR }
  32     { "last-error" "LAST_ERROR" TIMESTAMP }
  33 } define-persistent
  34
  35 TUPLE: watching-site account-name site-id ;
  36
  37 : <watching-site> ( account-name site-id -- watching-site )
  38     watching-site new
  39         swap >>site-id
  40         swap >>account-name ;
  41
  42 watching-site "WATCHING_SITE" {
  43     { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
  44     { "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
  45 } define-persistent
  46
  47 TUPLE: reporting-site email url up? changed? last-up? error last-error ;
  48
  49 <PRIVATE
  50
  51 : set-notify-site-watchers ( site new-up? -- site )
  52     [ over up?>> = [ t >>changed? ] unless ] keep >>up? ;
  53
  54 : site-good ( site -- )
  55     t set-notify-site-watchers
  56     now >>last-up
  57     f >>error
  58     f >>last-error
  59     update-tuple ;
  60
  61 : site-bad ( site error -- )
  62     [ error. ] with-string-writer >>error
  63     f set-notify-site-watchers
  64     now >>last-error
  65     update-tuple ;
  66
  67 : sites-to-report ( -- seq )
  68     "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_name = watching_site.account_name and site.site_id = watching_site.site_id and site.changed = '1'" sql-query
  69     [ [ reporting-site boa ] input<sequence ] map
  70     "update site set changed = 'f';" sql-command ;
  71
  72 : insert-site ( url -- site )
  73     <site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
  74
  75 : insert-account ( account-name -- ) <account> insert-tuple ;
  76
  77 : find-sites ( -- seq ) f <site> select-tuples ;
  78
  79 : select-account/site ( username url -- account site )
  80     insert-site site-id>> ;
  81
  82 PRIVATE>
  83
  84 : watch-site ( username url -- )
  85     select-account/site <watching-site> insert-tuple ;
  86
  87 : unwatch-site ( username url -- )
  88     select-account/site <watching-site> delete-tuples ;
  89
  90 : watching-sites ( username -- sites )
  91     f <watching-site> select-tuples
  92     [ site-id>> site new swap >>site-id select-tuple ] map ;