diff --git a/contrib/rss/load.factor b/contrib/rss/load.factor new file mode 100644 index 0000000000..0380c3639f --- /dev/null +++ b/contrib/rss/load.factor @@ -0,0 +1,5 @@ +REQUIRES: httpd sqlite ; +PROVIDE: rss { + "rss.factor" + "rss-reader.factor" +} { } ; diff --git a/contrib/rss/rss-reader.factor b/contrib/rss/rss-reader.factor new file mode 100644 index 0000000000..ae3d8f3b73 --- /dev/null +++ b/contrib/rss/rss-reader.factor @@ -0,0 +1,150 @@ +! Copyright (C) 2006 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +! +! Create a test database like follows: +! +! sqlite3 history.db +! > create table rss (url text, title text, link text, primary key (url)); +! > create table entries (url text, link text, title text, description text, pubdate text, primary key(url, link)); +! > [eof] +! +IN: rss +USING: kernel html cont-responder namespaces sequences io hashtables sqlite errors ; + +SYMBOL: feeds + +: init-feeds ( -- ) + V{ } clone feeds set-global ; + +: add-feed ( url -- ) + feeds get push ; + +: remove-feed ( url -- ) + feeds get remove feeds set-global ; + +: get-feed ( -- url ) + [ + + "Enter a Feed URL" write + +
+ "URL: " write + + +
+ + + ] show "url" swap hash ; + +: get-entries ( url -- ) + "history.db" sqlite-open ( db ) + "select * from entries where url='" rot append "'" append dupd sqlite-prepare ( db stmt ) + [ [ [ 2 column-text ] keep + [ 1 column-text ] keep + [ 3 column-text ] keep + 4 column-text + ] sqlite-map + ] keep + sqlite-finalize + swap sqlite-close ; + +: view-entries ( url -- ) + [ + + "View entries for " write over write + + swap get-entries [ +

dup rss-entry-title write

+

+ rss-entry-description write +

+ ] each +

"Back" write

+ + + ] show 2drop ; + +: rss-delete-statement ( url -- string ) + [ + "delete from rss where url='" % % "';" % ] "" make ; + +: rss-insert-statement ( url rss -- string ) + [ + "insert into rss values('" % swap % "','" % + [ rss-title "'" "''" rot replace % "','" % ] keep + rss-link % "');" % + ] "" make ; + +: entry-delete-statement ( url entry -- string ) + [ + "delete from entries where url='" % swap % "' and link='" % + rss-entry-link "'" "''" rot replace % "';" % + ] "" make ; + +: entry-insert-statement ( url entry -- string ) + [ + "insert into entries values('" % swap % "','" % + [ rss-entry-link "'" "''" rot replace % "','" % ] keep + [ rss-entry-title "'" "''" rot replace % "','" % ] keep + [ rss-entry-description "'" "''" rot replace % "','" % ] keep + rss-entry-pub-date "'" "''" rot replace % "');" % + ] "" make ; + +: do-update ( string -- ) + "history.db" sqlite-open ( db ) + dup rot sqlite-prepare [ [ drop ] sqlite-each ] keep + sqlite-finalize + sqlite-close ; + +: update-feed-database ( url rss -- ) + over rss-delete-statement do-update + 2dup rss-insert-statement do-update ( url rss - ) + rss-entries [ ( url entry ) + 2dup entry-delete-statement do-update + entry-insert-statement do-update + ] each-with ; + +: update-feeds ( seq -- ) + [ + [ + dup rss-get + ] catch [ + update-feed-database + ] unless + ] each + [ + + "Feeds Updated" write + +

"Feeds Updated." write

+

"Back" write

+ + + ] show drop ; + +: maintain-feeds ( -- ) + [ + + "Maintain Feeds" write + +

+ + feeds get [ + + + + + + ] each +
dup write dup [ remove-feed ] curry "Remove" swap quot-href [ view-entries ] curry "Database" swap quot-href
+

+

"Add Feed" [ get-feed add-feed ] quot-href

+

"Update Feeds" [ feeds get update-feeds ] quot-href

+ + + ] show-final ; + +init-feeds + + +"maintain-feeds" [ maintain-feeds ] install-cont-responder diff --git a/contrib/rss.factor b/contrib/rss/rss.factor similarity index 96% rename from contrib/rss.factor rename to contrib/rss/rss.factor index 95e1159cda..15eb590de1 100644 --- a/contrib/rss.factor +++ b/contrib/rss/rss.factor @@ -1,6 +1,5 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. -REQUIRES: httpd ; IN: rss USING: kernel http-client sequences namespaces math errors io ; @@ -10,8 +9,8 @@ USING: kernel http-client sequences namespaces math errors io ; drop % 2drop ] [ dup ( str1 str2 string n n-1 ) - pick head % ( str1 str2 string n ) - >r pick length r> + swap tail ( str1 str2 tail ) + pick swap head % ( str1 str2 string n ) + >r pick length r> + tail ( str1 str2 tail ) over % (replace) ] if ; @@ -106,6 +105,3 @@ TUPLE: rss-entry title link description pub-date ; ] [ 2drop "Error retrieving rss file" throw ] if ; - - -PROVIDE: rss ;