"UTF-8" >>content-charset
utf8 >>content-encoding ;
-TUPLE: feed-action < action title url hubs entries ;
+TUPLE: feed-action < action title url entries ;
: <feed-action> ( -- action )
feed-action new-action
dup '[
feed new
_
- {
- [ title>> call >>title ]
- [ url>> call adjust-url >>url ]
- [ hubs>> [ call [ adjust-url ] map >>hubs ] when* ]
- [ entries>> call process-entries >>entries ]
- } cleave
+ [ title>> call >>title ]
+ [ url>> call adjust-url >>url ]
+ [ entries>> call process-entries >>entries ]
+ tri
<feed-content>
] >>display ;
+++ /dev/null
-! Copyright (c) 2010 Samuel Tardieu.
-! See http://factorcode.org/license.txt for BSD license.
-USING: http syndication.pubsubhubbub tools.test urls ;
-
-[
- T{ request
- { method "POST" }
- { url URL" http://rfc1149.superfeedr.com:80/" }
- { version "1.1" }
- { header
- H{
- { "user-agent" "Factor http.client" }
- { "connection" "close" }
- }
- }
- { post-data
- T{ post-data
- { data
- B{
- 104 117 98 46 109 111 100 101 61 112 117 98
- 108 105 115 104 38 104 117 98 46 117 114
- 108 61 104 116 116 112 58 47 47 119 119 119
- 46 114 102 99 49 49 52 57 46 110 101 116 47
- 98 108 111 103 47 102 101 101 100 47 38 104
- 117 98 46 117 114 108 61 104 116 116 112 58
- 47 47 119 119 119 46 114 102 99 49 49 52 57
- 46 110 101 116 47 98 108 111 103 47 101 110
- 47 102 101 101 100 47
- }
- }
- { content-type
- "application/x-www-form-urlencoded"
- }
- }
- }
- { cookies V{ } }
- { redirects 10 }
- }
-] [
- { "http://www.rfc1149.net/blog/feed/" "http://www.rfc1149.net/blog/en/feed/" } "http://rfc1149.superfeedr.com/" <ping-request>
-] unit-test
+++ /dev/null
-! Copyright (c) 2010 Samuel Tardieu.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays kernel http http.client sequences urls.encoding ;
-IN: syndication.pubsubhubbub
-
-<PRIVATE
-
-: <ping-data> ( feeds -- post-data )
- [ url-encode "hub.url=" prepend ] map "&" join
- "hub.mode=publish&" prepend >byte-array
- "application/x-www-form-urlencoded" <post-data> [ data<< ] keep ;
-
-PRIVATE>
-
-: <ping-request> ( feeds url -- request )
- [ <ping-data> ] [ <post-request> ] bi* ;
-
-: ping ( feeds url -- )
- <ping-request> http-request drop
- dup code>> 204 = [ drop ] [ download-failed ] if ;
\ No newline at end of file
xml.data xml.writer io.streams.string combinators xml
xml.entities.html io.files io http.client namespaces make
xml.syntax hashtables calendar.format accessors continuations
-urls present byte-arrays fry arrays ;
+urls present byte-arrays ;
IN: syndication
: any-tag-named ( tag names -- tag-inside )
[ f ] 2dip [ tag-named nip dup ] with find 2drop ;
-TUPLE: feed title url entries hubs ;
+TUPLE: feed title url entries ;
: <feed> ( -- feed ) feed new ;
[ "item" tags-named [ rss2.0-entry ] map set-entries ]
tri ;
-: atom-links ( tag rel -- seq )
- [ "links" tags-named ] dip
- dup "alternate" = [ f 2array ] [ 1array ] if
- '[ "rel" attr _ member? ] filter
- [ "href" attr >url ] map ;
-
-: atom-link ( tag rel -- url/f )
- atom-links [ f ] [ first ] if-empty ;
+: atom-entry-link ( tag -- url/f )
+ "link" tags-named
+ [ "rel" attr { f "alternate" } member? ] find nip
+ dup [ "href" attr >url ] when ;
: atom1.0-entry ( tag -- entry )
<entry> swap {
[ "title" tag-named children>string >>title ]
- [ "alternate" atom-link >>url ]
+ [ atom-entry-link >>url ]
[
{ "content" "summary" } any-tag-named
dup children>> [ string? not ] any?
} cleave ;
: atom1.0 ( xml -- feed )
- <feed> swap {
- [ "title" tag-named children>string >>title ]
- [ "alternate" atom-link >>url ]
- [ "hub" atom-links >>hubs ]
- [ "entry" tags-named [ atom1.0-entry ] map set-entries ]
- } cleave ;
+ <feed> swap
+ [ "title" tag-named children>string >>title ]
+ [ "link" tag-named "href" attr >url >>url ]
+ [ "entry" tags-named [ atom1.0-entry ] map set-entries ]
+ tri ;
: xml>feed ( xml -- feed )
dup main>> {
</entry>
XML] ;
-: hub>xml ( hub -- xml )
- present [XML <link rel="hub" href=<-> /> XML] ;
-
: feed>xml ( feed -- xml )
- {
- [ title>> ]
- [ url>> present ]
- [ hubs>> [ hub>xml ] map ]
- [ entries>> [ entry>xml ] map ]
- } cleave
+ [ title>> ]
+ [ url>> present ]
+ [ entries>> [ entry>xml ] map ] tri
<XML
<feed xmlns="http://www.w3.org/2005/Atom">
<title><-></title>
<link href=<-> />
<->
- <->
</feed>
XML> ;
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences sorting math math.order
calendar timers logging concurrency.combinators namespaces
-db.types db.tuples db fry locals hashtables continuations
+db.types db.tuples db fry locals hashtables
syndication urls xml.writer validators
html.forms
html.components
furnace.boilerplate
furnace.auth.login
furnace.auth
-furnace.syndication
-syndication.pubsubhubbub ;
+furnace.syndication ;
IN: webapps.planet
TUPLE: planet < dispatcher ;
{ "date" "DATE" TIMESTAMP +not-null+ }
} define-persistent
-CONSTANT: hubs { { URL" http://pubsubhubbub.appspot.com/"
- URL" http://pubsubhubbub.appspot.com/publish" } }
-
: <blog> ( id -- todo )
blog new
swap >>id ;
f <blog> select-tuples
[ name>> ] sort-with ;
-: sort-postings ( seq -- seq )
- [ date>> ] inv-sort-with ;
-
: postings ( -- seq )
posting new select-tuples
- sort-postings ;
+ [ date>> ] inv-sort-with ;
: <edit-blogroll-action> ( -- action )
<page-action>
{ planet "planet" } >>template ;
-: hubs-urls ( -- seq )
- hubs [ first ] map ;
-
-: ping-hubs ( -- )
- { URL" http://planet.factorcode.org/feed.xml" }
- hubs [ second ] map
- [ [ ping ] [ 3drop ] recover ] with each ;
-
: <planet-feed-action> ( -- action )
<feed-action>
[ "Planet Factor" ] >>title
[ URL" $planet" ] >>url
- [ hubs-urls ] >>hubs
[ postings ] >>entries ;
:: <posting> ( entry name -- entry' )
: sort-entries ( entries -- entries' )
[ date>> ] inv-sort-with ;
-: set-cached-postings ( seq -- )
- [
+: update-cached-postings ( -- )
+ blogroll fetch-blogroll sort-entries 8 short head [
posting new delete-tuples
[ insert-tuple ] each
] with-transaction ;
-: update-cached-postings ( -- )
- blogroll fetch-blogroll sort-entries 8 short head sort-postings
- dup postings = [ drop ] [ set-cached-postings ping-hubs ] if ;
-
: <update-action> ( -- action )
<action>
[