steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
John Benediktsson 2009-04-06 21:59:18 -07:00
parent db280b6323 1032e57e8e
commit d39aa343b5
33 changed files with 283 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -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

2
basis/colors/colors-docs.factor
View File

@ -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 <rgba> }
"Converting a color to RGBA:"

2
basis/compiler/cfg/linear-scan/allocation/allocation.factor
View File

@ -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.

2
basis/compiler/tree/propagation/info/info.factor
View File

@ -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 -- ? )
{

5
basis/db/errors/sqlite/sqlite.factor
View File

@ -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> 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 <sql-table-missing> ]]
| .*:error
=> [[ error >string <unparsed-sqlite-error> ]]
;EBNF

7
basis/delegate/protocols/protocols.factor
View File

@ -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 ;

1
basis/furnace/actions/actions.factor
View File

@ -9,6 +9,7 @@ http.server.responses
furnace.utilities
furnace.redirection
furnace.conversations
furnace.chloe-tags
html.forms
html.components
html.components

1
basis/furnace/furnace.factor
View File

@ -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

4
basis/furnace/redirection/redirection.factor
View File

@ -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

2
basis/help/home/home.factor
View File

@ -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 ;

2
basis/hints/hints.factor
View File

@ -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 )

5
basis/regexp/dfa/dfa.factor
View File

@ -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

2
core/classes/builtin/builtin.factor
View File

@ -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)

8
extra/id3/id3.factor
View File

@ -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

37
extra/site-watcher/db/db.factor
View File

@ -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> ( 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 )
<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> 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 )
<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 <spidering-site> insert-tuple ;
: remove-spidered-site ( username url -- )
select-account/site 10 10 <spidering-site> 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<sequence ] map
"update site set changed = 0;" sql-command ;
: insert-site ( url -- site )
<site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
: insert-account ( account-name email -- ) <account> insert-tuple ;
: find-sites ( -- seq ) f <site> select-tuples ;
: select-account/site ( username url -- account site )
insert-site site-id>> ;
: watch-site ( username url -- )
select-account/site <watching-site> insert-tuple ;

6
extra/site-watcher/site-watcher.factor
View File

@ -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 ;

7
extra/site-watcher/spider/spider.factor
View File

@ -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
: <site-spider> ( spidering-site -- spider )
@ -20,3 +20,6 @@ IN: site-watcher.spider
[ <site-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 ;

9
extra/spider/report/report.factor
View File

@ -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 -- )

45
extra/spider/spider.factor
View File

@ -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> >>semaphore ] bi ;
: <spider-result> ( url depth -- spider-result )
spider-result new
swap >>depth
swap >>url ;
<PRIVATE
@ -57,26 +62,32 @@ fetched-in parsed-html links processed-in fetched-at ;
: normalize-hrefs ( base links -- links' )
[ derive-url ] with map ;
: print-spidering ( url depth -- )
: print-spidering ( spider-result -- )
[ 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-result> ;
: spider-next-page ( spider -- )
setup-next-url spider-page ;

1
extra/webapps/site-watcher/common/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

6
extra/webapps/site-watcher/common/common.factor Normal file
View File

@ -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 ;

13
extra/webapps/site-watcher/common/main.xml Normal file
View File

@ -0,0 +1,13 @@
<?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<p>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. <t:a t:href="$site-watcher-app/login">Sign up now!</t:a></p>
<ul>
<li><t:a t:href="$site-watcher-app/update-notify">Your contact info</t:a></li>
<li><t:a t:href="$site-watcher-app/watch-list">Watched sites</t:a></li>
<li><t:a t:href="$site-watcher-app/spider-list">Spidered sites</t:a></li>
</ul>
</t:chloe>

28
extra/webapps/site-watcher/common/site-list.xml Normal file
View File

@ -0,0 +1,28 @@
<?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<h1>Add some sites to watch</h1>
<t:form t:action="$site-watcher-app/add-watch">
<table>
<tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
</table>
</t:form>
<h1>Keep track of your sites</h1>
<table border="2">
<tr> <th>URL</th><th></th> </tr>
<t:bind-each t:name="sites">
<tr>
<td> <t:label t:name="url" /> </td>
<td> <t:button t:action="$site-watcher-app/remove-watch" t:for="url">Remove</t:button> </td>
</tr>
</t:bind-each>
</table>
<p>
<t:button t:action="$site-watcher-app/check">Check now</t:button>
</p>
</t:chloe>

0
extra/webapps/site-watcher/site-watcher.xml → extra/webapps/site-watcher/common/site-watcher.xml
View File

28
extra/webapps/site-watcher/common/spider-list.xml Normal file
View File

@ -0,0 +1,28 @@
<?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<h1>Add a site to spider</h1>
<t:form t:action="$site-watcher-app/add-spider">
<table>
<tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
</table>
</t:form>
<h1>Spidered sites</h1>
<table border="2">
<tr> <th>URL</th><th></th> </tr>
<t:bind-each t:name="sites">
<tr>
<td> <t:label t:name="url" /> </td>
<td> <t:button t:action="$site-watcher-app/remove-spider" t:for="url">Remove</t:button> </td>
</tr>
</t:bind-each>
</table>
<p>
<t:button t:action="$site-watcher-app/spider">Spider now</t:button>
</p>
</t:chloe>

0
extra/webapps/site-watcher/update-notify.xml → extra/webapps/site-watcher/common/update-notify.xml
View File

7
extra/webapps/site-watcher/main.xml
View File

@ -1,7 +0,0 @@
<?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<p>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. <t:a t:href="$site-watcher-app/list">Sign up now!</t:a></p>
</t:chloe>

32
extra/webapps/site-watcher/site-list.xml
View File

@ -1,32 +0,0 @@
<?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<p> Don't you hate it when your web site goes down, and all your users go buy that <a href="http://en.wikipedia.org/wiki/Slanket">slanket</a> from your competitor instead. Now using SiteWatcher, you can ensure this will never happen again! </p>
<t:a t:href="$site-watcher-app/update-notify">Contact info</t:a>
<h3>Step 2: add some sites to watch</h3>
<t:form t:action="$site-watcher-app/add">
<table>
<tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
</table>
</t:form>
<h3>Step 3: keep track of your sites</h3>
<table border="2">
<tr> <th>URL</th><th></th> </tr>
<t:bind-each t:name="sites">
<tr>
<td> <t:label t:name="url" /> </td>
<td> <t:button t:action="$site-watcher-app/remove" t:for="url">Remove</t:button> </td>
</tr>
</t:bind-each>
</table>
<p>
<t:button t:action="$site-watcher-app/check">Check now</t:button>
</p>
</t:chloe>

72
extra/webapps/site-watcher/site-watcher.factor
View File

@ -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/"
: <main-action> ( -- action )
<page-action>
[
logged-in?
[ URL" $site-watcher-app/list" <redirect> ]
[ { site-watcher-app "main" } <chloe-content> ] if
] >>display ;
: <site-list-action> ( -- action )
<page-action>
{ site-watcher-app "site-list" } >>template
[
! Silly query
username watching-sites
"sites" set-value
] >>init
<protected>
"list watched sites" >>description ;
: <add-site-action> ( -- action )
<action>
[
{ { "url" [ v-url ] } } validate-params
] >>validate
[
username "url" value watch-site
site-list-url <redirect>
] >>submit
<protected>
"add a watched site" >>description ;
: <remove-site-action> ( -- action )
<action>
[
{ { "url" [ v-url ] } } validate-params
] >>validate
[
username "url" value unwatch-site
site-list-url <redirect>
] >>submit
<protected>
"remove a watched site" >>description ;
: <check-sites-action> ( -- action )
<action>
[
watch-sites
site-list-url <redirect>
] >>submit
<protected>
"check watched sites" >>description ;
{ site-watcher-app "main" } >>template ;
: <update-notify-action> ( -- action )
<page-action>
@ -95,10 +44,14 @@ CONSTANT: site-list-url URL" $site-watcher-app/"
: <site-watcher-app> ( -- dispatcher )
site-watcher-app new-dispatcher
<main-action> "" add-responder
<site-list-action> "list" add-responder
<add-site-action> "add" add-responder
<remove-site-action> "remove" add-responder
<watch-list-action> "watch-list" add-responder
<add-watched-site-action> "add-watch" add-responder
<remove-watched-site-action> "remove-watch" add-responder
<check-sites-action> "check" add-responder
<spider-list-action> "spider-list" add-responder
<add-spidered-site-action> "add-spider" add-responder
<remove-spidered-site-action> "remove-spider" add-responder
<spider-sites-action> "spider" add-responder
<update-notify-action> "update-notify" add-responder ;
: <login-config> ( responder -- responder' )
@ -125,12 +78,13 @@ site-watcher-db <alloy>
main-responder set-global
M: site-watcher-app init-user-profile
drop
drop B
"username" value "email" value <account> 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 ( -- )

1
extra/webapps/site-watcher/spidering/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

52
extra/webapps/site-watcher/spidering/spidering.factor Normal file
View File

@ -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"
: <spider-list-action> ( -- action )
<page-action>
{ site-watcher-app "spider-list" } >>template
[
! Silly query
username B spidering-sites [ site>> ] map
"sites" set-value
] >>init
<protected>
"list spidered sites" >>description ;
: <add-spidered-site-action> ( -- action )
<action>
[
{ { "url" [ v-url ] } } validate-params
] >>validate
[
username "url" value add-spidered-site
site-list-url <redirect>
] >>submit
<protected>
"add a spidered site" >>description ;
: <remove-spidered-site-action> ( -- action )
<action>
[
{ { "url" [ v-url ] } } validate-params
] >>validate
[
username "url" value remove-spidered-site
site-list-url <redirect>
] >>submit
<protected>
"remove a spidered site" >>description ;
: <spider-sites-action> ( -- action )
<action>
[
spider-sites
site-list-url <redirect>
] >>submit
<protected>
"spider sites" >>description ;

1
extra/webapps/site-watcher/watching/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

52
extra/webapps/site-watcher/watching/watching.factor Normal file
View File

@ -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"
: <watch-list-action> ( -- action )
<page-action>
{ site-watcher-app "site-list" } >>template
[
! Silly query
username watching-sites
"sites" set-value
] >>init
<protected>
"list watched sites" >>description ;
: <add-watched-site-action> ( -- action )
<action>
[
{ { "url" [ v-url ] } } validate-params
] >>validate
[
username "url" value watch-site
site-list-url <redirect>
] >>submit
<protected>
"add a watched site" >>description ;
: <remove-watched-site-action> ( -- action )
<action>
[
{ { "url" [ v-url ] } } validate-params
] >>validate
[
username "url" value unwatch-site
site-list-url <redirect>
] >>submit
<protected>
"remove a watched site" >>description ;
: <check-sites-action> ( -- action )
<action>
[
watch-sites
site-list-url <redirect>
] >>submit
<protected>
"check watched sites" >>description ;