extra/rss/rss.factor

   1 ! Copyright (C) 2006 Chris Double, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: rss
   4 USING: xml.utilities kernel assocs xml.generator
   5     strings sequences xml.data xml.writer
   6     io.streams.string combinators xml xml.entities io.files io
   7     http.client namespaces xml.generator hashtables ;
   8
   9 : ?children>string ( tag/f -- string/f )
  10     [ children>string ] [ f ] if* ;
  11
  12 TUPLE: feed title link entries ;
  13
  14 C: <feed> feed
  15
  16 TUPLE: entry title link description pub-date ;
  17
  18 C: <entry> entry
  19
  20 : rss1.0 ( xml -- feed )
  21     [
  22         "channel" tag-named
  23         [ "title" tag-named children>string ] keep
  24         "link" tag-named children>string
  25     ] keep
  26     "item" tags-named [
  27         [ "title" tag-named children>string ] keep
  28         [ "link" tag-named children>string ] keep
  29         [ "description" tag-named children>string ] keep
  30         f "date" "http://purl.org/dc/elements/1.1/" <name>
  31         tag-named ?children>string
  32         <entry>
  33     ] map <feed> ;
  34
  35 : rss2.0 ( xml -- feed )
  36     "channel" tag-named
  37     [ "title" tag-named children>string ] keep
  38     [ "link" tag-named children>string ] keep
  39     "item" tags-named [
  40         [ "title" tag-named children>string ] keep
  41         [ "link" tag-named ] keep
  42         [ "guid" tag-named dupd ? children>string ] keep
  43         [ "description" tag-named children>string ] keep
  44         "pubDate" tag-named children>string <entry>
  45     ] map <feed> ;
  46
  47 : atom1.0 ( xml -- feed )
  48     [ "title" tag-named children>string ] keep
  49     [ "link" tag-named "href" swap at ] keep
  50     "entry" tags-named [
  51         [ "title" tag-named children>string ] keep
  52         [ "link" tag-named "href" swap at ] keep
  53         [
  54             dup "content" tag-named
  55             [ nip ] [ "summary" tag-named ] if*
  56             dup tag-children [ tag? ] contains?
  57             [ tag-children [ write-chunk ] string-out ]
  58             [ children>string ] if
  59         ] keep
  60         dup "published" tag-named
  61         [ nip ] [ "updated" tag-named ] if*
  62         children>string <entry>
  63     ] map <feed> ;
  64
  65 : xml>feed ( xml -- feed )
  66     dup name-tag {
  67         { "RDF" [ rss1.0 ] }
  68         { "rss" [ rss2.0 ] }
  69         { "feed" [ atom1.0 ] }
  70     } case ;
  71
  72 : read-feed ( stream -- feed )
  73     [ read-xml ] with-html-entities xml>feed ;
  74
  75 : download-feed ( url -- feed )
  76     #! Retrieve an news syndication file, return as a feed tuple.
  77     http-get-stream rot 200 = [
  78         nip read-feed
  79     ] [
  80         2drop "Error retrieving newsfeed file" throw
  81     ] if ;
  82
  83 ! Atom generation
  84 : entry, ( entry -- )
  85     << entry >> [
  86         << title >> [ dup entry-title , ]
  87         << link [ dup entry-link ] == href // >>
  88         << published >> [ dup entry-pub-date , ]
  89         << content >> [ entry-description , ]
  90     ] ;
  91
  92 : feed>xml ( feed -- xml )
  93     <XML
  94         << feed [ "http://www.w3.org/2005/Atom" ] == xmlns >> [
  95             << title >> [ dup feed-title , ]
  96             << link [ dup feed-link ] == href // >>
  97             feed-entries [ entry, ] each
  98         ]
  99     XML> ;
 100
 101 : write-feed ( feed -- xml )
 102     feed>xml write-xml ;