(class +Rss)

(dm parse> (Lst)
  (apply (checkType> This Lst) (list This Lst)))
    
(dm getMeta> (Lst)
   (if (= 'rss> (checkType> This Lst))
      (metaRss> This Lst)
      (metaAtom> This Lst)))
    
(dm metaRss> (L)  
   (use (@A @X @Y @E @Z)
      (if (match '(@A "<" "l" "i" "n" "k" ">" @E "<" "/" "l" "i" "n" "k" ">" @Z) L)
         (make
            (link (cons 'htmlUrl (pack @E)))
            (match '(@A "<" "t" "i" "t" "l" "e" ">" @E "<" "/" "t" "i" "t" "l" "e" ">" @Z) L)
            (link (cons 'title (pack @E))))
         NIL )))
    
(dm metaAtom> (L)  
   (use (@A @X @Y @E @Z)
      (if (match '(@A"<" "l" "i" "n" "k" @X "h" "r" "e" "f" "=" @E "/" ">"@Z) L)
         (make
            (link (cons 'htmlUrl (any (pack @E))))
            (match '(@A "<" "t" "i" "t" "l" "e" ">" @E "<" "/" "t" "i" "t" "l" "e" ">" @Z) L)
            (link (cons 'title (pack @E))))
         NIL )))

(dm parseOpml> (Lst)
   (=: feeds (list)) (=: tags (list)) 
   (opml> This (attr> This Lst 'body) "na")
   (cons (: feeds) (: tags)))

(dm checkType> (Lst)
   (use @A @B 
      (if (and (match '(@A "<" "s" "t" "a" "t" "u" "s" "e" "s" @B) Lst) (> 100 (length @A)))
         'twitter>
         (if (and 
                (match '(@A "<" "f" "e" "e" "d" " " @B) Lst)
                (> 1000 (length @A))) 
            'atom> 
            'rss>))))

(dm rss> (L)  
  (use (@A @X @E @Z)         
     (make
        (while (match '(@A "<" "i" "t" "e" @X ">" @E "<" "/" "i" "t" "e" "m" ">" @Z) L)
           (let R (rssEntry> This @E)
              (when R (link R)))
           (setq L @Z)))))
    
(dm twitter> (L)  
  (use (@A @X @E @Z)         
     (make
        (while (match '(@A "<" "s" "t" "a" "t" "u" "s" ">" @E "<" "/" "s" "t" "a" "t" "u" "s" ">" @Z) L)
           (let R (twitterEntry> This @E)
              (when R (link R)))
           (setq L @Z)))))
    
(dm twitterEntry> (L)
   (use (@A @X @Y @E @Z Body)
      (make
         (match '(@A "<" "s" "c" "r" "e" "e" "n" "_" "n" "a" "m" "e" ">" @E "<" "/" "s" "c" "r" "e" "e" "n" "_" "n" "a" "m" "e" ">" @Z) L)
         (let Name @E
            (match '(@A "<" "t" "e" "x" "t" ">" @E "<" "/" "t" "e" "x" "t" ">" @Z) L)
            (link (cons 'body (setq Body (pack @E))))
            (match '(@A "<" "c" "r" "e" "a" "t" "e" "d" "_" "a" "t" ">" @E "<" "/" "c" "r" "e" "a" "t" "e" "d" "_" "a" "t" ">" @Z) L)
            (link (cons 'pubDate (pack @E)))
            (let Dat (UTCtoPico> '+Gh (pack @E))
               (link (cons 'picoDate (car Dat)))
               (link (cons 'picoTime (cdr Dat)))
               (link (cons 'picoStamp (stamp> '+Gh (car Dat) (cdr Dat)))))
            (match '(@A "<" "i" "d" ">" @E "<" "/" "i" "d" ">" @Z) L)
            (link (cons 'htmlUrl (pack @E)))
            (match '(@A "<" "p" "r" "o" "f" "i" "l" "e" "_" "i" "m" "a" "g" "e" "_" "u" "r" "l" ">" @E "<" "/" "p" "r" "o" "f" "i" "l" "e" "_" "i" "m" "a" "g" "e" "_" "u" "r" "l" ">" @Z) L)
            (link (cons 'xtra (list (cons 'profileImage (pack @E)) (cons 'screenName (pack Name)))))
            (link (cons 'title (truncate> '+Gh Body 30 "...")))
            (link (cons 'summary " "))
            (link (cons 'type "twitter"))))))
    
#<dc:date>2009-06-01T03:36:14+00:00</dc:date>
(dm rssEntry> (L)  
   (use (@A @X @Y @E @Z)
      (if (match '(@A "<" "l" "i" "n" "k" ">" @E "<" "/" "l" "i" "n" "k" ">" @Z) L)
         (make
            (link (cons 'type "rss"))
            (link (cons 'htmlUrl (pack @E)))
            (if
               (or 
                  (match '(@A "<" "p" "u" "b" "d" "a" "t" "e" ">" @E "<" "/" "p" "u" "b" "d" "a" "t" "e" ">" @Z) L)
                  (match '(@A "<" "p" "u" "b" "D" "a" "t" "e" ">" @E "<" "/" "p" "u" "b" "D" "a" "t" "e" ">" @Z) L)
                  (match '(@A "<" @X "d" "a" "t" "e" ">" @E "<" "/" @Y "d" "a" "t" "e" ">" @Z) L))
               (link (cons 'pubDate (pack @E)))
               (link (cons 'pubDate (datStr (date)))))
            (let Dat (UTCtoPico> '+Gh (pack @E))
               (link (cons 'picoDate (car Dat)))
               (link (cons 'picoTime (cdr Dat)))
               (link (cons 'picoStamp (stamp> '+Gh (car Dat) (cdr Dat)))))
            (mapc 
               '((Key Match Error)
                   (link (cons Key (if (match Match L) (pack @E) Error))))
               '(title body summary)
               '((@A "<" "t" "i" "t" "l" "e" ">" @E "<" "/" "t" "i" "t" "l" "e" ">" @Z)
                 (@A "<" "c" "o" "n" "t" "e" "n" @X ">" @E "<" "/" "c" "o" "n" "t" "e" "n" @Y ">" @Z)
                 (@A "<" "d" "e" "s" "c" "r" "i" @X ">" @E "<" "/" "d" "e" "s" "c" "r" "i" @Y ">" @Z))
               '("no title" "no body" "no summary")))
         NIL )))

(dm atom> (L)  
  (use (@A @X @E @Z)         
     (make
        (while (match '(@A "<" "e" "n" "t" "r" "y" @X ">" @E "<" "/" "e" "n" "t" "r" "y" ">" @Z) L)
           (let R (atomEntry> This @E)
              (when R (link R)))
           (setq L @Z)))))
    
#<link rel="self" type="application/atom+xml" href="http://steve-yegge.blogspot.com/feeds/posts/default/5446768042043105070" />
#(@A "<" "i" "d" ">" @E "<" "/" "i" "d" ">" @Z)
#<link rel="self" type="application/atom+xml" href="
#<![CDATA[RailsConf Wrapup]]>
#<link rel='alternate' type='text/html' href='http://fairleads.blogspot.com/2008/02/rails-20-step-by-step-part-21.html' title='Rails 2.0 Step by Step (part 2.1)'/>
(dm atomEntry> (L)  
   (use (@A @X @E @Z)
      (if (or             
             (match '(@A"<" "l" "i" "n" "k" " " "r" "e" "l" "=" "\"" "a" "l" "t" "e" "r" "n" "a" "t" "e" "\"" @X "h" "r" "e" "f" "=" @E " " @Z) L)
             (match '(@A"<" "l" "i" "n" "k" " " "r" "e" "l" "=" "\"" "s" "e" "l" "f" "\"" @X "h" "r" "e" "f" "=" @E " " @Z) L)
             (match '(@A"<" "l" "i" "n" "k" " " "r" "e" "l" "=" "'" "a" "l" "t" "e" "r" "n" "a" "t" "e" "'" @X "h" "r" "e" "f" "=" "'" @E "'" @Z) L)
             (match '(@A"<" "l" "i" "n" "k" @X "h" "r" "e" "f" "=" @E "/" ">"@Z) L)
             (match '(@A "<" "l" "i" "n" "k" ">" @E "<" "/" "l" "i" "n" "k" ">" @Z) L))
         (make
            (link (cons 'type "atom"))
            (link (cons 'htmlUrl (any (pack @E))))
            (if 
               (or
                  (match '(@A "<" "u" "p" "d" "a" "t" "e" "d" ">" @E "<" "/" "u" "p" "d" "a" "t" "e" "d" ">" @Z) L)
                  (match '(@A "<" "m" "o" "d" "i" "f" "i" "e" "d" ">" @E "<" "/" "m" "o" "d" "i" "f" "i" "e" "d" ">" @Z) L)
                  (match '(@A "<" "p" "u" "b" "l" "i" "s" "h" "e" "d" ">" @E "<" "/" "p" "u" "b" "l" "i" "s" "h" "e" "d" ">" @Z) L)
                  (match '(@A "<" "p" "u" "b" "l" "i" "s" "h" "e" "d" ">" @E "<" "/" "p" "u" "b" "l" "i" "s" "h" "e" "d" ">" @Z) L))
               (link (cons 'pubDate (pack @E)))               
               (link (cons 'pubDate (datStr (date)))))
            (let Dat (UTCtoPico> '+Gh (pack @E))
               (link (cons 'picoDate (car Dat)))
               (link (cons 'picoTime (cdr Dat)))
               (link (cons 'picoStamp (stamp> '+Gh (car Dat) (cdr Dat)))))
            (mapc 
               '((Key Match Error)
                   (link 
                      (cons Key 
                         (if (match Match L) 
                            (pack 
                               (if 
                                  (and 
                                     (= Key 'title) 
                                     (match '("<" "!" "[" "C" "D" "A" "T" "A" "[" @A "]" "]" ">") @E)) 
                                  @A @E)) 
                            Error ))))
               '(title body summary)
               '((@A "<" "t" "i" "t" "l" @X ">" @E "<" "/" "t" "i" "t" "l" "e" ">" @Z)
                   (@A "<" "c" "o" "n" "t" "e" "n" @X ">" @E "<" "/" "c" "o" "n" "t" "e" "n" "t" ">" @Z)
                   (@A "<" "s" "u" "m" "m" "a" "r" @X ">" @E "<" "/" "s" "u" "m" "m" "a" "r" "y" ">" @Z))
               '("no title" "no body" "no summary")))
         NIL )))
    
(dm opmlItem> (Lst Tag)
  (push (: feeds)
     (mapcar 
        '((Attr)
          (prog
             (when (= Attr 'xmlUrl) 
                (push1 
                   (: tags) 
                   (cons Tag (val> This Lst 'xmlUrl))))
             (val> This Lst Attr)))
        '(title type xmlUrl htmlUrl))))

(dm val> (El Key)
  (cdr (assoc Key El)))

(dm opml> (Lst Tag)  
  (for El Lst
     (let Item (cadr El)        
        (if (opmlItem?> This Item)
           (opmlItem> This Item Tag)
           (opml> This (cddr El) (val> This Item 'text))))))
    
(dm opmlItem?> (Item)
  (assoc 'xmlUrl Item))

(dm attr> (Lst Key . @)
  (while (args)
     (setq
        Lst (cdr (assoc Key Lst))
        Key (next)))
  (cddr (assoc Key (cdr Lst))))
    
(dm dbg> (L)
  (println (last L))
  (quit))