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 arrays ;
8 TUPLE: account account-name email twitter sms ;
10 : <account> ( account-name email -- account )
16 { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
17 { "email" "EMAIL" VARCHAR }
18 { "twitter" "TWITTER" VARCHAR }
19 { "sms" "SMS" VARCHAR }
22 TUPLE: site site-id url up? changed? last-up error last-error ;
24 : <site> ( url -- site )
28 : site-with-url ( url -- site )
31 : site-with-id ( id -- site )
32 site new swap >>site-id select-tuple ;
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 }
44 TUPLE: watching-site account-name site-id ;
46 : <watching-site> ( account-name site-id -- watching-site )
51 watching-site "WATCHING_SITE" {
52 { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
53 { "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
56 TUPLE: spidering-site < watching-site max-depth max-count ;
58 C: <spidering-site> spidering-site
62 M: watching-site site>>
63 site-id>> site-with-id ;
67 M: watching-site account>>
68 account-name>> account new swap >>account-name select-tuple ;
70 spidering-site "SPIDERING_SITE" {
71 { "max-depth" "MAX_DEPTH" INTEGER }
72 { "max-count" "MAX_COUNT" INTEGER }
75 : spidering-sites ( username -- sites )
76 spidering-site new swap >>account-name select-tuples ;
78 : insert-site ( url -- site )
79 <site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
81 : select-account/site ( username url -- account site )
82 insert-site site-id>> ;
84 : add-spidered-site ( username url -- )
85 select-account/site 10 10 <spidering-site> insert-tuple ;
87 : remove-spidered-site ( username url -- )
88 select-account/site 10 10 <spidering-site> delete-tuples ;
90 TUPLE: reporting-site site-id email url up? changed? last-up? error last-error ;
92 : set-notify-site-watchers ( site new-up? -- site )
93 [ over up?>> = [ t >>changed? ] unless ] keep >>up? ;
95 : site-good ( site -- )
96 t set-notify-site-watchers
102 : site-bad ( site error -- )
103 [ error. ] with-string-writer >>error
104 f set-notify-site-watchers
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 ;
113 : insert-account ( account-name email -- ) <account> insert-tuple ;
115 : find-sites ( -- seq ) f <site> select-tuples ;
117 : watch-site ( username url -- )
118 select-account/site <watching-site> insert-tuple ;
120 : unwatch-site ( username url -- )
121 select-account/site <watching-site> delete-tuples ;
123 : watching-sites ( username -- sites )
124 f <watching-site> select-tuples
125 [ site-id>> site new swap >>site-id select-tuple ] map ;
127 : site-watcher-path ( -- path ) "site-watcher.db" cache-file ; inline
129 : with-site-watcher-db ( quot -- )
130 site-watcher-path <sqlite-db> swap with-db ; inline