! 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.reader USING: kernel html namespaces sequences io quotations assocs sqlite.tuple-db sqlite io.files html.elements rss webapps.continuation ; TUPLE: reader-feed url title link ; C: reader-feed TUPLE: reader-entry url link title description pubdate ; C: reader-entry reader-feed default-mapping set-mapping reader-entry default-mapping set-mapping : init-db ( -- ) db get-global [ sqlite-close ] when* "rss-reader.db" exists? [ "rss-reader.db" sqlite-open db set-global ] [ "rss-reader.db" sqlite-open dup db set-global dup reader-feed create-tuple-table reader-entry create-tuple-table ] if ; : add-feed ( url -- ) "" "" db get swap insert-tuple ; : remove-feed ( url -- ) f f db get swap find-tuples [ db get swap delete-tuple ] each ; : all-urls ( -- urls ) f f f db get swap find-tuples [ reader-feed-url ] map ; : ask-for-url ( -- url ) [ "Enter a Feed URL" write
"URL: " write
] show "url" swap at ; : get-entries ( url -- entries ) f f f f db get swap find-tuples ; : display-entries ( url -- ) [ "View entries for " write over write swap get-entries [

dup reader-entry-title write

reader-entry-description write

] each

"Back" write

] show 2drop ; : rss>reader-feed ( url rss -- reader-feed ) [ feed-title ] keep feed-link ; : rss-entry>reader-entry ( url entry -- reader-entry ) [ entry-link ] keep [ entry-title ] keep [ entry-description ] keep entry-pub-date ; : update-feed-database ( url -- ) dup remove-feed dup news-get 2dup rss>reader-feed db get swap save-tuple feed-entries [ dupd rss-entry>reader-entry dup >r reader-entry-link f f f db get swap find-tuples [ db get swap delete-tuple ] each r> db get swap save-tuple ] curry* each ; : update-feeds ( seq -- ) [ update-feed-database ] each [ "Feeds Updated" write

"Feeds Updated." write

"Back" write

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

all-urls [ ] each
dup write dup [ remove-feed ] curry "Remove" swap quot-href [ display-entries ] curry "Database" swap quot-href

"Add Feed" [ ask-for-url add-feed ] quot-href

"Update Feeds" [ all-urls update-feeds ] quot-href

] show-final ; "maintain-feeds" [ init-db maintain-feeds ] install-cont-responder