From 37e278ed02d020451869af91e77fd48849381293 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Apr 2009 17:50:54 -0500 Subject: [PATCH 01/11] Use [ ] [ ] map-reduce instead of unclip [ ] reduce --- basis/compiler/cfg/linear-scan/allocation/allocation.factor | 2 +- basis/compiler/tree/propagation/info/info.factor | 2 +- basis/hints/hints.factor | 2 +- core/classes/builtin/builtin.factor | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index 8d00a14ea2..908bf2475b 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -99,7 +99,7 @@ SYMBOL: spill-counts : interval-to-spill ( active-intervals current -- live-interval ) #! We spill the interval with the most distant use location. start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc - unclip-slice [ [ [ second ] bi@ > ] most ] reduce first ; + [ ] [ [ [ second ] bi@ > ] most ] map-reduce first ; : assign-spill ( before after -- before after ) #! If it has been spilled already, reuse spill location. diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index c56db570b2..a22b7aa172 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -238,7 +238,7 @@ DEFER: (value-info-union) : value-infos-union ( infos -- info ) [ null-info ] - [ unclip-slice [ value-info-union ] reduce ] if-empty ; + [ [ ] [ value-info-union ] map-reduce ] if-empty ; : literals<= ( info1 info2 -- ? ) { diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 6fece31d88..2534e0121f 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -25,7 +25,7 @@ M: object specializer-declaration class ; [ drop object eq? not ] assoc-filter [ [ t ] ] [ [ swap specializer-predicate append ] { } assoc>map - unclip [ swap [ f ] \ if 3array append [ ] like ] reduce + [ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce ] if-empty ; : specializer-cases ( quot word -- default alist ) diff --git a/core/classes/builtin/builtin.factor b/core/classes/builtin/builtin.factor index 0e4a3b56fd..f95d66fd05 100644 --- a/core/classes/builtin/builtin.factor +++ b/core/classes/builtin/builtin.factor @@ -55,7 +55,7 @@ M: anonymous-intersection (flatten-class) [ builtins get sift [ (flatten-class) ] each ] [ - unclip [ assoc-intersect ] reduce [ swap set ] assoc-each + [ ] [ assoc-intersect ] map-reduce [ swap set ] assoc-each ] if-empty ; M: anonymous-complement (flatten-class) From 2c08376cd53058a81e589a9a229210fbcd5515d4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Apr 2009 17:52:14 -0500 Subject: [PATCH 02/11] Minor doc updates --- basis/colors/colors-docs.factor | 2 +- basis/help/home/home.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/colors/colors-docs.factor b/basis/colors/colors-docs.factor index 8881d89711..5e2b09380d 100644 --- a/basis/colors/colors-docs.factor +++ b/basis/colors/colors-docs.factor @@ -23,7 +23,7 @@ $nl ARTICLE: "colors" "Colors" "The " { $vocab-link "colors" } " vocabulary defines a protocol for colors, with a concrete implementation for RGBA colors. This vocabulary is used by " { $vocab-link "io.styles" } ", " { $vocab-link "ui" } " and other vocabularies, but it is independent of them." $nl -"RGBA colors:" +"RGBA colors with floating point components in the range " { $snippet "[0,1]" } ":" { $subsection rgba } { $subsection } "Converting a color to RGBA:" diff --git a/basis/help/home/home.factor b/basis/help/home/home.factor index f32c0db30d..9cb3c6f1bb 100644 --- a/basis/help/home/home.factor +++ b/basis/help/home/home.factor @@ -21,7 +21,7 @@ M: apropos add-recent-where recent-searches ; M: object add-recent-where f ; : $recent ( element -- ) - first get [ nl ] [ 1array $pretty-link ] interleave ; + first get reverse [ nl ] [ 1array $pretty-link ] interleave ; : $recent-searches ( element -- ) drop recent-searches get [ <$link> ] map $list ; From c91712bea0d28c158a47222816553e919edd069f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Apr 2009 18:10:49 -0500 Subject: [PATCH 03/11] clean up a combinator in id3 parser --- extra/id3/id3.factor | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor index 8e824d689f..5076a4a8ab 100644 --- a/extra/id3/id3.factor +++ b/extra/id3/id3.factor @@ -163,17 +163,13 @@ TUPLE: id3v1-info title artist album year comment genre ; } cond ] with-mapped-uchar-file ; -: (find-id3-frame) ( id3 name quot: ( obj -- obj' ) -- obj' ) - [ swap frames>> at* ] dip - [ data>> ] prepose [ drop f ] if ; inline - PRIVATE> : mp3>id3 ( path -- id3v2-info/f ) dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ; inline : find-id3-frame ( id3 name -- obj/f ) - [ ] (find-id3-frame) ; inline + swap frames>> at* [ data>> ] when ; inline : title ( id3 -- title/f ) "TIT2" find-id3-frame ; inline @@ -186,7 +182,7 @@ PRIVATE> : comment ( id3 -- comment/f ) "COMM" find-id3-frame ; inline : genre ( id3 -- genre/f ) - "TCON" [ parse-genre ] (find-id3-frame) ; inline + "TCON" find-id3-frame parse-genre ; inline : find-mp3s ( path -- seq ) [ >lower ".mp3" tail? ] find-all-files ; inline From a380ae223985d74b9570b8498f52c8c48e42c6c1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Apr 2009 18:47:46 -0500 Subject: [PATCH 04/11] refactor spider --- extra/spider/spider.factor | 45 ++++++++++++++++++++++++-------------- 1 file changed, 28 insertions(+), 17 deletions(-) diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index 49d6c33f8f..17e91473c3 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -5,12 +5,12 @@ http.client kernel tools.time sets assocs sequences concurrency.combinators io threads namespaces math multiline math.parser inspector urls logging combinators.short-circuit continuations calendar prettyprint dlists deques locals -spider.unique-deque ; +spider.unique-deque combinators concurrency.semaphores ; IN: spider TUPLE: spider base count max-count sleep max-depth initial-links filters spidered todo nonmatching quiet currently-spidering -#threads follow-robots? robots ; +#threads semaphore follow-robots? robots ; TUPLE: spider-result url depth headers fetched-in parsed-html links processed-in fetched-at ; @@ -26,7 +26,12 @@ fetched-in parsed-html links processed-in fetched-at ; 0 >>count 1/0. >>max-count H{ } clone >>spidered - 1 >>#threads ; + 1 [ >>#threads ] [ >>semaphore ] bi ; + +: ( url depth -- spider-result ) + spider-result new + swap >>depth + swap >>url ; > ] [ depth>> ] bi "depth: " write number>string write ", spidering: " write . yield ; -:: new-spidered-result ( spider url depth -- spider-result ) - f url spider spidered>> set-at - [ url http-get ] benchmark :> fetched-at :> html :> headers +:: fill-spidered-result ( spider spider-result -- ) + f spider-result url>> spider spidered>> set-at + [ spider-result url>> http-get ] benchmark :> fetched-in :> html :> headers [ html parse-html spider currently-spidering>> over find-all-links normalize-hrefs - ] benchmark :> processing-time :> links :> parsed-html - url depth headers fetched-at parsed-html links processing-time - now spider-result boa ; + ] benchmark :> processed-in :> links :> parsed-html + spider-result + headers >>headers + fetched-in >>fetched-in + parsed-html >>parsed-html + links >>links + processed-in >>processed-in + now >>fetched-at drop ; -:: spider-page ( spider url depth -- ) - spider quiet>> [ url depth print-spidering ] unless - spider url depth new-spidered-result :> spidered-result - spider quiet>> [ spidered-result describe ] unless - spider spidered-result add-spidered ; +:: spider-page ( spider spider-result -- ) + spider quiet>> [ spider-result print-spidering ] unless + spider spider-result fill-spidered-result + spider quiet>> [ spider-result describe ] unless + spider spider-result add-spidered ; \ spider-page ERROR add-error-logging @@ -94,9 +105,9 @@ fetched-in parsed-html links processed-in fetched-at ; [ [ count>> ] [ max-count>> ] bi < ] } 1&& ; -: setup-next-url ( spider -- spider url depth ) +: setup-next-url ( spider -- spider spider-result ) dup todo>> peek-url url>> >>currently-spidering - dup todo>> pop-url [ url>> ] [ depth>> ] bi ; + dup todo>> pop-url [ url>> ] [ depth>> ] bi ; : spider-next-page ( spider -- ) setup-next-url spider-page ; From fb37e0eacae2f365aa8cb99da133318554f858ff Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Apr 2009 19:43:50 -0500 Subject: [PATCH 05/11] unbreak regexp --- basis/regexp/dfa/dfa.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/basis/regexp/dfa/dfa.factor b/basis/regexp/dfa/dfa.factor index d137ee3e4f..2de4e8b0e0 100644 --- a/basis/regexp/dfa/dfa.factor +++ b/basis/regexp/dfa/dfa.factor @@ -51,10 +51,13 @@ IN: regexp.dfa [ condition-states ] 2dip '[ _ _ add-todo-state ] each ; +: ensure-state ( key table -- ) + 2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ; inline + :: new-transitions ( nfa dfa new-states visited-states -- nfa dfa ) new-states [ nfa dfa ] [ pop :> state - state dfa transitions>> maybe-initialize-key + state dfa transitions>> ensure-state state nfa find-transitions [| trans | state trans nfa find-closure :> new-state From 9f08e3a6bf57a87e4c4ca5bdbcd5e76e6c99dfec Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Apr 2009 21:59:27 -0500 Subject: [PATCH 06/11] Working on site-watcher --- extra/site-watcher/db/db.factor | 37 +++++++--- extra/site-watcher/site-watcher.factor | 6 +- extra/site-watcher/spider/spider.factor | 7 +- extra/spider/report/report.factor | 9 +-- extra/webapps/site-watcher/common/authors.txt | 1 + .../webapps/site-watcher/common/common.factor | 6 ++ extra/webapps/site-watcher/common/main.xml | 13 ++++ .../webapps/site-watcher/common/site-list.xml | 28 ++++++++ .../{ => common}/site-watcher.xml | 0 .../site-watcher/common/spider-list.xml | 28 ++++++++ .../{ => common}/update-notify.xml | 0 extra/webapps/site-watcher/main.xml | 7 -- extra/webapps/site-watcher/site-list.xml | 32 --------- .../webapps/site-watcher/site-watcher.factor | 72 ++++--------------- .../site-watcher/spidering/authors.txt | 1 + .../site-watcher/spidering/spidering.factor | 52 ++++++++++++++ .../webapps/site-watcher/watching/authors.txt | 1 + .../site-watcher/watching/watching.factor | 52 ++++++++++++++ 18 files changed, 234 insertions(+), 118 deletions(-) create mode 100644 extra/webapps/site-watcher/common/authors.txt create mode 100644 extra/webapps/site-watcher/common/common.factor create mode 100644 extra/webapps/site-watcher/common/main.xml create mode 100644 extra/webapps/site-watcher/common/site-list.xml rename extra/webapps/site-watcher/{ => common}/site-watcher.xml (100%) create mode 100644 extra/webapps/site-watcher/common/spider-list.xml rename extra/webapps/site-watcher/{ => common}/update-notify.xml (100%) delete mode 100644 extra/webapps/site-watcher/main.xml delete mode 100644 extra/webapps/site-watcher/site-list.xml create mode 100644 extra/webapps/site-watcher/spidering/authors.txt create mode 100644 extra/webapps/site-watcher/spidering/spidering.factor create mode 100644 extra/webapps/site-watcher/watching/authors.txt create mode 100644 extra/webapps/site-watcher/watching/watching.factor diff --git a/extra/site-watcher/db/db.factor b/extra/site-watcher/db/db.factor index 26d05441f3..003b6bb58b 100644 --- a/extra/site-watcher/db/db.factor +++ b/extra/site-watcher/db/db.factor @@ -2,10 +2,10 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors continuations db db.sqlite db.tuples db.types io.directories io.files.temp kernel io.streams.string calendar -debugger combinators.smart sequences ; +debugger combinators.smart sequences arrays ; IN: site-watcher.db -TUPLE: account account-id account-name email twitter sms ; +TUPLE: account account-name email twitter sms ; : ( account-name email -- account ) account new @@ -25,6 +25,12 @@ TUPLE: site site-id url up? changed? last-up error last-error ; site new swap >>url ; +: site-with-url ( url -- site ) + select-tuple ; + +: site-with-id ( id -- site ) + site new swap >>site-id select-tuple ; + site "SITE" { { "site-id" "SITE_ID" INTEGER +db-assigned-id+ } { "url" "URL" VARCHAR } @@ -49,10 +55,12 @@ watching-site "WATCHING_SITE" { TUPLE: spidering-site < watching-site max-depth max-count ; +C: spidering-site + SLOT: site M: watching-site site>> - site-id>> site new swap >>site-id select-tuple ; + site-id>> site-with-id ; SLOT: account @@ -60,12 +68,25 @@ 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 +: spidering-sites ( username -- sites ) + spidering-site new swap >>account-name select-tuples ; + +: insert-site ( url -- site ) + dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ; + +: select-account/site ( username url -- account site ) + insert-site site-id>> ; + +: add-spidered-site ( username url -- ) + select-account/site 10 10 insert-tuple ; + +: remove-spidered-site ( username url -- ) + select-account/site 10 10 delete-tuples ; + TUPLE: reporting-site site-id email url up? changed? last-up? error last-error ; : set-notify-site-watchers ( site new-up? -- site ) @@ -89,16 +110,10 @@ TUPLE: reporting-site site-id email url up? changed? last-up? error last-error ; [ [ reporting-site boa ] input dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ; - : insert-account ( account-name email -- ) insert-tuple ; : find-sites ( -- seq ) f select-tuples ; -: select-account/site ( username url -- account site ) - insert-site site-id>> ; - : watch-site ( username url -- ) select-account/site insert-tuple ; diff --git a/extra/site-watcher/site-watcher.factor b/extra/site-watcher/site-watcher.factor index c2ec2ada79..535c8cd626 100644 --- a/extra/site-watcher/site-watcher.factor +++ b/extra/site-watcher/site-watcher.factor @@ -38,12 +38,12 @@ SYMBOL: running-site-watcher PRIVATE> -: watch-sites ( db -- ) - [ find-sites check-sites sites-to-report send-reports ] with-db ; +: watch-sites ( -- ) + find-sites check-sites sites-to-report send-reports ; : run-site-watcher ( db -- ) [ running-site-watcher get ] dip '[ - [ _ watch-sites ] site-watcher-frequency get every + [ _ [ watch-sites ] with-db ] site-watcher-frequency get every running-site-watcher set ] unless ; diff --git a/extra/site-watcher/spider/spider.factor b/extra/site-watcher/spider/spider.factor index 1b3a96a018..335f1f11f9 100644 --- a/extra/site-watcher/spider/spider.factor +++ b/extra/site-watcher/spider/spider.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: site-watcher.db site-watcher.email +USING: site-watcher.db site-watcher.email site-watcher.spider spider spider.report accessors kernel sequences -xml.writer ; +xml.writer concurrency.combinators ; IN: site-watcher.spider : ( spidering-site -- spider ) @@ -20,3 +20,6 @@ IN: site-watcher.spider [ run-spider spider-report xml>string ] [ site>> url>> "Spidered " prefix ] tri send-site-email ; + +: spider-sites ( -- ) + f spidering-sites [ spider-and-email ] parallel-each ; \ No newline at end of file diff --git a/extra/spider/report/report.factor b/extra/spider/report/report.factor index 48620cac55..7779b233f9 100644 --- a/extra/spider/report/report.factor +++ b/extra/spider/report/report.factor @@ -39,10 +39,11 @@ SYMBOL: time-std timings get sort-values [ slowest short tail* reverse slowest-pages set ] [ - values - [ mean 1000000 /f mean-time set ] - [ median 1000000 /f median-time set ] - [ std 1000000 /f time-std set ] tri + values [ + [ mean 1000000 /f mean-time set ] + [ median 1000000 /f median-time set ] + [ std 1000000 /f time-std set ] tri + ] unless-empty ] bi ; : process-results ( results -- ) diff --git a/extra/webapps/site-watcher/common/authors.txt b/extra/webapps/site-watcher/common/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/site-watcher/common/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/site-watcher/common/common.factor b/extra/webapps/site-watcher/common/common.factor new file mode 100644 index 0000000000..b27cbf3f7f --- /dev/null +++ b/extra/webapps/site-watcher/common/common.factor @@ -0,0 +1,6 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: http.server.dispatchers ; +IN: webapps.site-watcher.common + +TUPLE: site-watcher-app < dispatcher ; diff --git a/extra/webapps/site-watcher/common/main.xml b/extra/webapps/site-watcher/common/main.xml new file mode 100644 index 0000000000..35a0ccb6d1 --- /dev/null +++ b/extra/webapps/site-watcher/common/main.xml @@ -0,0 +1,13 @@ + + + + +

SiteWatcher is a free service for web masters. It periodically tries fetching your web site via HTTP, and sends you an e-mail, SMS or Tweet if this fails. Sign up now!

+ +
    +
  • Your contact info
    • +
  • Watched sites
    • +
  • Spidered sites
    • +
+ + diff --git a/extra/webapps/site-watcher/common/site-list.xml b/extra/webapps/site-watcher/common/site-list.xml new file mode 100644 index 0000000000..765381a4c4 --- /dev/null +++ b/extra/webapps/site-watcher/common/site-list.xml @@ -0,0 +1,28 @@ + + + + +

Add some sites to watch

+ + + + +
URL:
+ + +

Keep track of your sites

+ + + + + + + + + +
URL
Remove
+

+ Check now +

+ + diff --git a/extra/webapps/site-watcher/site-watcher.xml b/extra/webapps/site-watcher/common/site-watcher.xml similarity index 100% rename from extra/webapps/site-watcher/site-watcher.xml rename to extra/webapps/site-watcher/common/site-watcher.xml diff --git a/extra/webapps/site-watcher/common/spider-list.xml b/extra/webapps/site-watcher/common/spider-list.xml new file mode 100644 index 0000000000..89d191ab41 --- /dev/null +++ b/extra/webapps/site-watcher/common/spider-list.xml @@ -0,0 +1,28 @@ + + + + +

Add a site to spider

+ + + + +
URL:
+ + +

Spidered sites

+ + + + + + + + + +
URL
Remove
+

+ Spider now +

+ + diff --git a/extra/webapps/site-watcher/update-notify.xml b/extra/webapps/site-watcher/common/update-notify.xml similarity index 100% rename from extra/webapps/site-watcher/update-notify.xml rename to extra/webapps/site-watcher/common/update-notify.xml diff --git a/extra/webapps/site-watcher/main.xml b/extra/webapps/site-watcher/main.xml deleted file mode 100644 index 938ff09825..0000000000 --- a/extra/webapps/site-watcher/main.xml +++ /dev/null @@ -1,7 +0,0 @@ - - - - -

SiteWatcher is a free service for web masters. It periodically tries fetching your web site via HTTP, and sends you an e-mail, SMS or Tweet if this fails. Sign up now!

- - diff --git a/extra/webapps/site-watcher/site-list.xml b/extra/webapps/site-watcher/site-list.xml deleted file mode 100644 index c96a25f443..0000000000 --- a/extra/webapps/site-watcher/site-list.xml +++ /dev/null @@ -1,32 +0,0 @@ - - - - -

Don't you hate it when your web site goes down, and all your users go buy that slanket from your competitor instead. Now using SiteWatcher, you can ensure this will never happen again!

- -Contact info - -

Step 2: add some sites to watch

- - - - -
URL:
- - -

Step 3: keep track of your sites

- - - - - - - - - -
URL
Remove
-

- Check now -

- - diff --git a/extra/webapps/site-watcher/site-watcher.factor b/extra/webapps/site-watcher/site-watcher.factor index f173edb814..7651afa4e6 100644 --- a/extra/webapps/site-watcher/site-watcher.factor +++ b/extra/webapps/site-watcher/site-watcher.factor @@ -8,65 +8,14 @@ furnace.auth.features.registration furnace.auth.login furnace.boilerplate furnace.redirection html.forms http.server http.server.dispatchers kernel namespaces site-watcher site-watcher.db site-watcher.private urls validators io.sockets.secure.unix.debug -io.servers.connection db db.tuples sequences ; +io.servers.connection db db.tuples sequences webapps.site-watcher.common +webapps.site-watcher.watching webapps.site-watcher.spidering ; QUALIFIED: assocs IN: webapps.site-watcher -TUPLE: site-watcher-app < dispatcher ; - -CONSTANT: site-list-url URL" $site-watcher-app/" - : ( -- action ) - [ - logged-in? - [ URL" $site-watcher-app/list" ] - [ { site-watcher-app "main" } ] if - ] >>display ; - -: ( -- action ) - - { site-watcher-app "site-list" } >>template - [ - ! Silly query - username watching-sites - "sites" set-value - ] >>init - - "list watched sites" >>description ; - -: ( -- action ) - - [ - { { "url" [ v-url ] } } validate-params - ] >>validate - [ - username "url" value watch-site - site-list-url - ] >>submit - - "add a watched site" >>description ; - -: ( -- action ) - - [ - { { "url" [ v-url ] } } validate-params - ] >>validate - [ - username "url" value unwatch-site - site-list-url - ] >>submit - - "remove a watched site" >>description ; - -: ( -- action ) - - [ - watch-sites - site-list-url - ] >>submit - - "check watched sites" >>description ; + { site-watcher-app "main" } >>template ; : ( -- action ) @@ -95,10 +44,14 @@ CONSTANT: site-list-url URL" $site-watcher-app/" : ( -- dispatcher ) site-watcher-app new-dispatcher "" add-responder - "list" add-responder - "add" add-responder - "remove" add-responder + "watch-list" add-responder + "add-watch" add-responder + "remove-watch" add-responder "check" add-responder + "spider-list" add-responder + "add-spider" add-responder + "remove-spider" add-responder + "spider" add-responder "update-notify" add-responder ; : ( responder -- responder' ) @@ -125,12 +78,13 @@ site-watcher-db main-responder set-global M: site-watcher-app init-user-profile - drop + drop B "username" value "email" value insert-tuple ; : init-db ( -- ) site-watcher-db [ - { site account watching-site } [ ensure-table ] each + { site account watching-site spidering-site } + [ ensure-table ] each ] with-db ; : start-site-watcher ( -- ) diff --git a/extra/webapps/site-watcher/spidering/authors.txt b/extra/webapps/site-watcher/spidering/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/site-watcher/spidering/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/site-watcher/spidering/spidering.factor b/extra/webapps/site-watcher/spidering/spidering.factor new file mode 100644 index 0000000000..d0116a7f2d --- /dev/null +++ b/extra/webapps/site-watcher/spidering/spidering.factor @@ -0,0 +1,52 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors furnace.actions furnace.auth +furnace.redirection html.forms validators webapps.site-watcher.common +site-watcher.db site-watcher.spider kernel urls sequences ; +IN: webapps.site-watcher.spidering + +CONSTANT: site-list-url URL" $site-watcher-app/spider-list" + +: ( -- action ) + + { site-watcher-app "spider-list" } >>template + [ + ! Silly query + username B spidering-sites [ site>> ] map + "sites" set-value + ] >>init + + "list spidered sites" >>description ; + +: ( -- action ) + + [ + { { "url" [ v-url ] } } validate-params + ] >>validate + [ + username "url" value add-spidered-site + site-list-url + ] >>submit + + "add a spidered site" >>description ; + +: ( -- action ) + + [ + { { "url" [ v-url ] } } validate-params + ] >>validate + [ + username "url" value remove-spidered-site + site-list-url + ] >>submit + + "remove a spidered site" >>description ; + +: ( -- action ) + + [ + spider-sites + site-list-url + ] >>submit + + "spider sites" >>description ; \ No newline at end of file diff --git a/extra/webapps/site-watcher/watching/authors.txt b/extra/webapps/site-watcher/watching/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/site-watcher/watching/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/site-watcher/watching/watching.factor b/extra/webapps/site-watcher/watching/watching.factor new file mode 100644 index 0000000000..414595a12a --- /dev/null +++ b/extra/webapps/site-watcher/watching/watching.factor @@ -0,0 +1,52 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors furnace.actions furnace.auth +furnace.redirection html.forms site-watcher site-watcher.db +validators webapps.site-watcher.common urls ; +IN: webapps.site-watcher.watching + +CONSTANT: site-list-url URL" $site-watcher-app/watch-list" + +: ( -- action ) + + { site-watcher-app "site-list" } >>template + [ + ! Silly query + username watching-sites + "sites" set-value + ] >>init + + "list watched sites" >>description ; + +: ( -- action ) + + [ + { { "url" [ v-url ] } } validate-params + ] >>validate + [ + username "url" value watch-site + site-list-url + ] >>submit + + "add a watched site" >>description ; + +: ( -- action ) + + [ + { { "url" [ v-url ] } } validate-params + ] >>validate + [ + username "url" value unwatch-site + site-list-url + ] >>submit + + "remove a watched site" >>description ; + +: ( -- action ) + + [ + watch-sites + site-list-url + ] >>submit + + "check watched sites" >>description ; \ No newline at end of file From 959e659cdc67daff6b64e53bc2a94873c5b90e76 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Apr 2009 21:59:52 -0500 Subject: [PATCH 07/11] Makefile: clean target should delete libfactor.dylib too --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 5e63017218..35a5ba58bf 100644 --- a/Makefile +++ b/Makefile @@ -166,7 +166,7 @@ factor-ffi-test: vm/ffi_test.o clean: rm -f vm/*.o - rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib} + rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib} Factor.app/Contents/Frameworks/libfactor.dylib vm/resources.o: $(WINDRES) vm/factor.rs vm/resources.o From 2e03bd5cc0d7ef52fc8ff5aa93e1bbac8c1651bd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Apr 2009 22:00:08 -0500 Subject: [PATCH 08/11] db.errors.sqlite: don't give up on bad inputs --- basis/db/errors/sqlite/sqlite.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/basis/db/errors/sqlite/sqlite.factor b/basis/db/errors/sqlite/sqlite.factor index c247a36257..c73409b850 100644 --- a/basis/db/errors/sqlite/sqlite.factor +++ b/basis/db/errors/sqlite/sqlite.factor @@ -4,7 +4,8 @@ USING: accessors combinators db kernel sequences peg.ebnf strings db.errors ; IN: db.errors.sqlite -ERROR: unparsed-sqlite-error error ; +TUPLE: unparsed-sqlite-error error ; +C: unparsed-sqlite-error SINGLETONS: table-exists table-missing ; @@ -22,4 +23,6 @@ SqliteError = => [[ table >string message sqlite-table-error ]] | "no such table: " .+:table => [[ table >string ]] + | .*:error + => [[ error >string ]] ;EBNF From 6f53db568fcf0b25d40e97c0d332eea927084e5a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Apr 2009 22:00:18 -0500 Subject: [PATCH 09/11] furnace.redirection: load urls.secure --- basis/furnace/redirection/redirection.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/furnace/redirection/redirection.factor b/basis/furnace/redirection/redirection.factor index 01297288dc..ff81d73f7f 100644 --- a/basis/furnace/redirection/redirection.factor +++ b/basis/furnace/redirection/redirection.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors combinators namespaces fry urls http -http.server http.server.redirection http.server.responses +USING: kernel accessors combinators namespaces fry urls urls.secure +http http.server http.server.redirection http.server.responses http.server.remapping http.server.filters furnace.utilities ; IN: furnace.redirection From cb675cfe477c456d5bac689dd0f0c43204f69629 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Apr 2009 22:05:17 -0500 Subject: [PATCH 10/11] furnace.actions: load chloe tags --- basis/furnace/actions/actions.factor | 1 + basis/furnace/furnace.factor | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index a582755dc4..c7893117d1 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -9,6 +9,7 @@ http.server.responses furnace.utilities furnace.redirection furnace.conversations +furnace.chloe-tags html.forms html.components html.components diff --git a/basis/furnace/furnace.factor b/basis/furnace/furnace.factor index adafb21524..37b2f40e82 100644 --- a/basis/furnace/furnace.factor +++ b/basis/furnace/furnace.factor @@ -17,7 +17,6 @@ USE: vocabs.loader "furnace.auth.providers.db" require "furnace.auth.providers.null" require "furnace.boilerplate" require -"furnace.chloe-tags" require "furnace.conversations" require "furnace.db" require "furnace.json" require From 1032e57e8e79781d97de4634f7a7bad0b3574fda Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Apr 2009 23:32:21 -0500 Subject: [PATCH 11/11] Fix bootstrap --- basis/delegate/protocols/protocols.factor | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/basis/delegate/protocols/protocols.factor b/basis/delegate/protocols/protocols.factor index f568a3e388..40054bc4b0 100644 --- a/basis/delegate/protocols/protocols.factor +++ b/basis/delegate/protocols/protocols.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2007 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: delegate sequences.private sequences assocs -io definitions kernel continuations ; +USING: delegate sequences.private sequences assocs io ; IN: delegate.protocols PROTOCOL: sequence-protocol @@ -19,7 +18,3 @@ stream-read-until ; PROTOCOL: output-stream-protocol stream-flush stream-write1 stream-write stream-nl ; - -PROTOCOL: definition-protocol -where set-where forget uses -synopsis* definer definition ;