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 : any-tag-named ( tag names -- tag-inside )
  13     f -rot [ tag-named nip dup ] curry* find 2drop ;
  14
  15 TUPLE: feed title link entries ;
  16
  17 C: <feed> feed
  18
  19 TUPLE: entry title link description pub-date ;
  20
  21 C: <entry> entry
  22
  23 : rss1.0-entry ( tag -- entry )
  24     [ "title" tag-named children>string ] keep
  25     [ "link" tag-named children>string ] keep
  26     [ "description" tag-named children>string ] keep
  27     f "date" "http://purl.org/dc/elements/1.1/" <name>
  28     tag-named ?children>string
  29     <entry> ;
  30
  31 : rss1.0 ( xml -- feed )
  32     [
  33         "channel" tag-named
  34         [ "title" tag-named children>string ] keep
  35         "link" tag-named children>string
  36     ] keep
  37     "item" tags-named [ rss1.0-entry ] map <feed> ;
  38
  39 : rss2.0-entry ( tag -- entry )
  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
  46 : rss2.0 ( xml -- feed )
  47     "channel" tag-named
  48     [ "title" tag-named children>string ] keep
  49     [ "link" tag-named children>string ] keep
  50     "item" tags-named [ rss2.0-entry ] map <feed> ;
  51
  52 : atom1.0-entry ( tag -- entry )
  53     [ "title" tag-named children>string ] keep
  54     [ "link" tag-named "href" swap at ] keep
  55     [
  56         { "content" "summary" } any-tag-named
  57         dup tag-children [ string? not ] contains?
  58         [ tag-children [ write-chunk ] string-out ]
  59         [ children>string ] if
  60     ] keep
  61     { "published" "updated" "issued" "modified" } any-tag-named
  62     children>string <entry> ;
  63
  64 : atom1.0 ( xml -- feed )
  65     [ "title" tag-named children>string ] keep
  66     [ "link" tag-named "href" swap at ] keep
  67     "entry" tags-named [ atom1.0-entry ] map <feed> ;
  68
  69 : xml>feed ( xml -- feed )
  70     dup name-tag {
  71         { "RDF" [ rss1.0 ] }
  72         { "rss" [ rss2.0 ] }
  73         { "feed" [ atom1.0 ] }
  74     } case ;
  75
  76 : read-feed ( stream -- feed )
  77     [ read-xml ] with-html-entities xml>feed ;
  78
  79 : download-feed ( url -- feed )
  80     #! Retrieve an news syndication file, return as a feed tuple.
  81     http-get-stream rot 200 = [
  82         nip read-feed
  83     ] [
  84         2drop "Error retrieving newsfeed file" throw
  85     ] if ;
  86
  87 ! Atom generation
  88 : entry, ( entry -- )
  89     << entry >> [
  90         << title >> [ dup entry-title , ]
  91         << link [ dup entry-link ] == href // >>
  92         << published >> [ dup entry-pub-date , ]
  93         << content >> [ entry-description , ]
  94     ] ;
  95
  96 : feed>xml ( feed -- xml )
  97     <XML
  98         << feed [ "http://www.w3.org/2005/Atom" ] == xmlns >> [
  99             << title >> [ dup feed-title , ]
 100             << link [ dup feed-link ] == href // >>
 101             feed-entries [ entry, ] each
 102         ]
 103     XML> ;
 104
 105 : write-feed ( feed -- )
 106     feed>xml write-xml ;