1 ! Copyright (C) 2006 Chris Double.
2 ! See http://factorcode.org/license.txt for BSD license.
4 ! Create a test database like follows:
7 ! > create table rss (url text, title text, link text, primary key (url));
8 ! > create table entries (url text, link text, title text, description text, pubdate text, primary key(url, link));
12 USING: kernel html cont-responder namespaces sequences io hashtables sqlite errors tuple-db ;
14 TUPLE: reader-feed url title link ;
15 TUPLE: reader-entry url link title description pubdate ;
17 reader-feed default-mapping set-mapping
18 reader-entry default-mapping set-mapping
23 db get-global [ sqlite-close ] when*
24 "rss-reader.db" exists? [
25 "rss-reader.db" sqlite-open db set-global
27 "rss-reader.db" sqlite-open dup db set-global
28 dup reader-feed create-tuple-table
29 reader-entry create-tuple-table
33 "" "" <reader-feed> db get swap insert-tuple ;
35 : remove-feed ( url -- )
36 f f <reader-feed> db get swap find-tuples [ db get swap delete-tuple ] each ;
38 : all-urls ( -- urls )
39 f f f <reader-feed> db get swap find-tuples [ reader-feed-url ] map ;
41 : ask-for-url ( -- url )
44 <head> <title> "Enter a Feed URL" write </title> </head>
46 <form =action "post" =method form>
48 <input "text" =type "url" =name "100" =size input/>
49 <input "submit" =type input/>
53 ] show "url" swap hash ;
55 : get-entries ( url -- entries )
56 f f f f <reader-entry> db get swap find-tuples ;
58 : display-entries ( url -- )
61 <head> <title> "View entries for " write over write </title> </head>
64 <h2> dup reader-entry-title write </h2>
66 reader-entry-description write
69 <p> <a =href a> "Back" write </a> </p>
74 : rss>reader-feed ( url rss -- reader-feed )
75 [ rss-title ] keep rss-link <reader-feed> ;
77 : rss-entry>reader-entry ( url entry -- reader-entry )
78 [ rss-entry-link ] keep
79 [ rss-entry-title ] keep
80 [ rss-entry-description ] keep
84 : update-feed-database ( url -- )
87 2dup rss>reader-feed db get swap save-tuple
89 dupd rss-entry>reader-entry
90 dup >r reader-entry-link f f f <reader-entry> db get swap find-tuples [ db get swap delete-tuple ] each r>
91 db get swap save-tuple
94 : update-feeds ( seq -- )
95 [ update-feed-database ] each
98 <head> <title> "Feeds Updated" write </title> </head>
100 <p> "Feeds Updated." write </p>
101 <p> <a =href a> "Back" write </a> </p>
106 : maintain-feeds ( -- )
109 <head> <title> "Maintain Feeds" write </title> </head>
112 <table "1" =border table>
116 <td> dup [ remove-feed ] curry "Remove" swap quot-href </td>
117 <td> [ display-entries ] curry "Database" swap quot-href </td>
122 <p> "Add Feed" [ ask-for-url add-feed ] quot-href </p>
123 <p> "Update Feeds" [ all-urls update-feeds ] quot-href </p>
128 "maintain-feeds" [ init-db maintain-feeds ] install-cont-responder