basis/syndication/syndication.factor

   1 ! Copyright (C) 2006 Chris Double, Daniel Ehrenberg.
   2 ! Portions copyright (C) 2008, 2009 Slava Pestov.
   3 ! See http://factorcode.org/license.txt for BSD license.
   4 USING: xml.traversal kernel assocs math.order strings sequences
   5 xml.data xml.writer io.streams.string combinators xml
   6 xml.entities.html io.files io http.client namespaces make
   7 xml.syntax hashtables calendar.format accessors continuations
   8 urls present byte-arrays fry arrays ;
   9 IN: syndication
  10
  11 : any-tag-named ( tag names -- tag-inside )
  12     [ f ] 2dip [ tag-named nip dup ] with find 2drop ;
  13
  14 TUPLE: feed title url entries hubs ;
  15
  16 : <feed> ( -- feed ) feed new ;
  17
  18 TUPLE: entry title url description date ;
  19
  20 : set-entries ( feed entries -- feed )
  21     [ dup url>> ] dip
  22     [ [ derive-url ] change-url ] with map
  23     >>entries ;
  24
  25 : <entry> ( -- entry ) entry new ;
  26
  27 : try-parsing-timestamp ( string -- timestamp )
  28     [ rfc822>timestamp ] [ drop rfc3339>timestamp ] recover ;
  29
  30 : rss1.0-entry ( tag -- entry )
  31     <entry> swap {
  32         [ "title" tag-named children>string >>title ]
  33         [ "link" tag-named children>string >url >>url ]
  34         [ "description" tag-named children>string >>description ]
  35         [
  36             f "date" "http://purl.org/dc/elements/1.1/" <name>
  37             tag-named dup [ children>string try-parsing-timestamp ] when
  38             >>date
  39         ]
  40     } cleave ;
  41
  42 : rss1.0 ( xml -- feed )
  43     <feed> swap [
  44         "channel" tag-named
  45         [ "title" tag-named children>string >>title ]
  46         [ "link" tag-named children>string >url >>url ] bi
  47     ] [ "item" tags-named [ rss1.0-entry ] map set-entries ] bi ;
  48
  49 : rss2.0-entry ( tag -- entry )
  50     <entry> swap {
  51         [ "title" tag-named children>string >>title ]
  52         [ { "link" "guid" } any-tag-named children>string >url >>url ]
  53         [ { "description" "encoded" } any-tag-named children>string >>description ]
  54         [
  55             { "date" "pubDate" } any-tag-named
  56             children>string try-parsing-timestamp >>date
  57         ]
  58     } cleave ;
  59
  60 : rss2.0 ( xml -- feed )
  61     <feed> swap
  62     "channel" tag-named
  63     [ "title" tag-named children>string >>title ]
  64     [ "link" tag-named children>string >url >>url ]
  65     [ "item" tags-named [ rss2.0-entry ] map set-entries ]
  66     tri ;
  67
  68 : atom-links ( tag rel -- seq )
  69     [ "links" tags-named ] dip
  70     dup "alternate" = [ f 2array ] [ 1array ] if
  71     '[ "rel" attr _ member? ] filter
  72     [ "href" attr >url ] map ;
  73
  74 : atom-link ( tag rel -- url/f )
  75     atom-links [ f ] [ first ] if-empty ;
  76
  77 : atom1.0-entry ( tag -- entry )
  78     <entry> swap {
  79         [ "title" tag-named children>string >>title ]
  80         [ "alternate" atom-link >>url ]
  81         [
  82             { "content" "summary" } any-tag-named
  83             dup children>> [ string? not ] any?
  84             [ children>> xml>string ]
  85             [ children>string ] if >>description
  86         ]
  87         [
  88             { "published" "updated" "issued" "modified" }
  89             any-tag-named children>string try-parsing-timestamp
  90             >>date
  91         ]
  92     } cleave ;
  93
  94 : atom1.0 ( xml -- feed )
  95     <feed> swap {
  96         [ "title" tag-named children>string >>title ]
  97         [ "alternate" atom-link >>url ]
  98         [ "hub" atom-links >>hubs ]
  99         [ "entry" tags-named [ atom1.0-entry ] map set-entries ]
 100     } cleave ;
 101
 102 : xml>feed ( xml -- feed )
 103     dup main>> {
 104         { "RDF" [ rss1.0 ] }
 105         { "rss" [ rss2.0 ] }
 106         { "feed" [ atom1.0 ] }
 107     } case ;
 108
 109 GENERIC: parse-feed ( seq -- feed )
 110
 111 M: string parse-feed [ string>xml xml>feed ] with-html-entities ;
 112
 113 M: byte-array parse-feed [ bytes>xml xml>feed ] with-html-entities ;
 114
 115 : download-feed ( url -- feed )
 116     #! Retrieve an news syndication file, return as a feed tuple.
 117     http-get nip parse-feed ;
 118
 119 ! Atom generation
 120
 121 : entry>xml ( entry -- xml )
 122     {
 123         [ title>> ]
 124         [ url>> present ]
 125         [ date>> timestamp>rfc3339 ]
 126         [ description>> ]
 127     } cleave
 128     [XML
 129         <entry>
 130             <title type="html"><-></title>
 131             <link href=<-> />
 132             <published><-></published>
 133             <content type="html"><-></content>
 134         </entry>
 135     XML] ;
 136
 137 : hub>xml ( hub -- xml )
 138     present [XML <link rel="hub" href=<-> /> XML] ;
 139
 140 : feed>xml ( feed -- xml )
 141     {
 142         [ title>> ]
 143         [ url>> present ]
 144         [ hubs>> [ hub>xml ] map ]
 145         [ entries>> [ entry>xml ] map ]
 146     } cleave
 147     <XML
 148         <feed xmlns="http://www.w3.org/2005/Atom">
 149             <title><-></title>
 150             <link href=<-> />
 151             <->
 152             <->
 153         </feed>
 154     XML> ;