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 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/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/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 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 ; 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 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 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 ; 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/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 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) 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 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/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 ; 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