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 calendar combinators.smart db db.sqlite
   4 db.tuples db.types debugger io.files.temp io.streams.string
   5 kernel sequences ;
   6 IN: site-watcher.db
   7
   8 TUPLE: account account-name email twitter sms ;
   9
  10 : <account> ( account-name email -- account )
  11     account new
  12         swap >>email
  13         swap >>account-name ;
  14
  15 account "ACCOUNT" {
  16     { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
  17     { "email" "EMAIL" VARCHAR }
  18     { "twitter" "TWITTER" VARCHAR }
  19     { "sms" "SMS" VARCHAR }
  20 } define-persistent
  21
  22 TUPLE: site site-id url up? changed? last-up error last-error ;
  23
  24 : <site> ( url -- site )
  25     site new
  26         swap >>url ;
  27
  28 : site-with-url ( url -- site )
  29     <site> select-tuple ;
  30
  31 : site-with-id ( id -- site )
  32     site new swap >>site-id select-tuple ;
  33
  34 site "SITE" {
  35     { "site-id" "SITE_ID" INTEGER +db-assigned-id+ }
  36     { "url" "URL" VARCHAR }
  37     { "up?" "UP" BOOLEAN }
  38     { "changed?" "CHANGED" BOOLEAN }
  39     { "last-up" "LAST_UP" TIMESTAMP }
  40     { "error" "ERROR" VARCHAR }
  41     { "last-error" "LAST_ERROR" TIMESTAMP }
  42 } define-persistent
  43
  44 TUPLE: watching-site account-name site-id ;
  45
  46 : <watching-site> ( account-name site-id -- watching-site )
  47     watching-site new
  48         swap >>site-id
  49         swap >>account-name ;
  50
  51 watching-site "WATCHING_SITE" {
  52     { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
  53     { "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
  54 } define-persistent
  55
  56 TUPLE: spidering-site < watching-site max-depth max-count ;
  57
  58 C: <spidering-site> spidering-site
  59
  60 SLOT: site
  61
  62 M: watching-site site>>
  63     site-id>> site-with-id ;
  64
  65 SLOT: account
  66
  67 M: watching-site account>>
  68     account-name>> account new swap >>account-name select-tuple ;
  69
  70 spidering-site "SPIDERING_SITE" {
  71     { "max-depth" "MAX_DEPTH" INTEGER }
  72     { "max-count" "MAX_COUNT" INTEGER }
  73 } define-persistent
  74
  75 : spidering-sites ( username -- sites )
  76     spidering-site new swap >>account-name select-tuples ;
  77
  78 : insert-site ( url -- site )
  79     <site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
  80
  81 : select-account/site ( username url -- account site )
  82     insert-site site-id>> ;
  83
  84 : add-spidered-site ( username url -- )
  85     select-account/site 10 10 <spidering-site> insert-tuple ;
  86
  87 : remove-spidered-site ( username url -- )
  88     select-account/site 10 10 <spidering-site> delete-tuples ;
  89
  90 TUPLE: reporting-site site-id email url up? changed? last-up? error last-error ;
  91
  92 : set-notify-site-watchers ( site new-up? -- site )
  93     [ over up?>> = [ t >>changed? ] unless ] keep >>up? ;
  94
  95 : site-good ( site -- )
  96     t set-notify-site-watchers
  97     now >>last-up
  98     f >>error
  99     f >>last-error
 100     update-tuple ;
 101
 102 : site-bad ( site error -- )
 103     [ error. ] with-string-writer >>error
 104     f set-notify-site-watchers
 105     now >>last-error
 106     update-tuple ;
 107
 108 : sites-to-report ( -- seq )
 109     "select users.email, site.url, site.up, site.changed, site.last_up, site.error, site.last_error from users, site, watching_site where users.username = watching_site.account_name and site.site_id = watching_site.site_id and site.changed = '1'" sql-query
 110     [ [ reporting-site boa ] input<sequence ] map
 111     "update site set changed = 0;" sql-command ;
 112
 113 : insert-account ( account-name email -- ) <account> insert-tuple ;
 114
 115 : find-sites ( -- seq ) f <site> select-tuples ;
 116
 117 : watch-site ( username url -- )
 118     select-account/site <watching-site> insert-tuple ;
 119
 120 : unwatch-site ( username url -- )
 121     select-account/site <watching-site> delete-tuples ;
 122
 123 : watching-sites ( username -- sites )
 124     f <watching-site> select-tuples
 125     [ site-id>> site new swap >>site-id select-tuple ] map ;
 126
 127 : site-watcher-path ( -- path ) "site-watcher.db" cache-file ; inline
 128
 129 : with-site-watcher-db ( quot -- )
 130     site-watcher-path <sqlite-db> swap with-db ; inline