Changeset 15665 in project


Ignore:
Timestamp:
08/31/09 08:27:23 (10 years ago)
Author:
felix
Message:

enclosures and more namespace prefixes by Christian Kellermann

Location:
release/4/rss
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/rss/rss.meta

    r14582 r15665  
    1 ;;; rss.meta -*- Hen -*-
    2 ((egg "rss.egg")
    3  (files "rss.scm" "rss.setup" "rss.html")
     1;;;; rss.meta -*- Scheme -*-
     2
     3((files "rss.scm" "rss.setup")
    44 (license "BSD")
    55 (doc-from-wiki)
    6  (author
    7    "<a href=\"mailto:felix@call-with-current-continuation.org\">felix</a>")
     6 (author "felix winkelmann")
    87 (synopsis "A RSS parser")
    98 (needs ssax matchable)
  • release/4/rss/rss.scm

    r14582 r15665  
    1 ;;;; rss.scm
     1 ;;; rss.scm
    22
    33(module rss
     
    55 rss:item-attributes rss:item-attribute
    66 rss:feed? rss:feed-version rss:feed-channel rss:feed-items
    7  rss:item=? rss:read)
     7 rss:item-enclosure rss:enclosure-type rss:enclosure-length
     8 rss:enclosure? rss:enclosure-url  rss:item=? rss:read)
    89
    910(import scheme chicken extras)
     
    1617    (admin . "http://webns.net/mvcb/")
    1718    (rss . "http://purl.org/rss/1.0/")
    18     (rdf . "http://my.netscape.com/rdf/simple/0.9/") ) )
     19    (rdf . "http://my.netscape.com/rdf/simple/0.9/")
     20    (itunes . "http://www.itunes.com/dtds/podcast-1.0.dtd")
     21    (content . "http://purl.org/rss/1.0/modules/content/")
     22    (atom . "http://www.w3.org/2005/Atom") ) )
    1923
    2024(define-record-type rss:item
    21   (make-rss:item title link description attributes)
     25  (make-rss:item title link description enclosure attributes)
    2226  rss:item?
    2327  (title rss:item-title rss:item-title-set!)
    2428  (link rss:item-link rss:item-link-set!)
    2529  (description rss:item-description rss:item-description-set!)
     30  (enclosure rss:item-enclosure rss:item-enclosure-set!)
    2631  (attributes rss:item-attributes rss:item-attributes-set!)
    2732  )
     
    3439  (items rss:feed-items rss:feed-items-set!)
    3540  )
     41
     42(define-record-type rss:enclosure
     43   (make-rss:enclosure type url length)
     44   rss:enclosure?
     45   (type rss:enclosure-type rss:enclosure-type-set!)
     46   (url rss:enclosure-url rss:enclosure-url-set!)
     47   (length rss:enclosure-length rss:enclosure-length-set!)
     48)
     49
     50(define (sxml->enclosure sxml)
     51   (let ((enc (make-rss:enclosure #f #f #f)))
     52      (letrec ((parse
     53         (match-lambda
     54           ['() enc] 
     55           [('@ rest ...) (parse rest)]
     56           [(('url url) rest ...) (rss:enclosure-url-set! enc url) (parse rest)]
     57           [(('length len) rest ...) (rss:enclosure-length-set! enc len) (parse rest)]
     58           [(('type type) rest ...) (rss:enclosure-type-set! enc type)(parse rest)]
     59           [ x (warn "uncatched pattern ~S" x)]
     60         )))
     61      (parse sxml))))
    3662
    3763(define (rss:item-attribute item attr)
     
    6288     (let loop ([items items])
    6389       (match (car items)
     90         [('@ . _) (loop (cdr items))]
     91         [('@@ . _) (loop (cdr items))]
    6492         [('*PI* . _) (loop (cdr items))]
    6593         [('*NAMESPACES* . _) (loop (cdr items))]
     
    101129    (match sxml
    102130      [((or 'channel 'rss:channel 'rdf:channel) elts ...)
    103        (fluid-let ([channel (make-rss:item #f #f #f '())])
     131       (fluid-let ([channel (make-rss:item #f #f #f #f '())])
    104132         (set! last-channel channel)
    105133         (rss:feed-channel-set! feed channel)
    106134         (for-each rec elts) ) ]
    107135      [((or 'item 'rss:item 'rdf:item) elts ...)
    108        (fluid-let ([item (make-rss:item #f #f #f '())])
     136       (fluid-let ([item (make-rss:item #f #f #f #f '())])
    109137         (rss:feed-items-set! feed (cons item (rss:feed-items feed)))
    110138         (for-each rec elts) ) ]
     
    123151               (rss:item-attributes-set! d (alist-cons 'link link (rss:item-attributes d))) )
    124152             (warn "tag `link' with content ~S in wrong context" link) ) ) ]
     153      [((or 'enclosure 'rss:enclosure 'rdf:enclosure) enclosure)
     154       (let ([d (or item channel last-channel)])
     155         (if d
     156            (begin
     157               (rss:item-enclosure-set! d (sxml->enclosure enclosure))
     158               (rss:item-attributes-set! d (alist-cons 'enclosure enclosure (rss:item-attributes d))) )
     159            (warn "tag `enclosure' with content ~S in wrong context" enclosure) ) ) ]
    125160      [((or 'description 'rss:description 'rdf:description) description)
    126161       (let ([d (or item channel last-channel)])
  • release/4/rss/rss.setup

    r14582 r15665  
    11
    22(compile -s -O2 -d1 -j rss rss.scm)
    3 (compile -s -O2 -d1 rss.import.scm)
     3(compile -s -O2 -d0 rss.import.scm)
    44
    55(install-extension
    66 'rss
    7  '("rss.so" "rss.import.so" "rss.html")
    8  '((version 1.3) (documentation "rss.html")))
     7 '("rss.so" "rss.import.so")
     8 '((version 1.4) (documentation "rss.html")))
Note: See TracChangeset for help on using the changeset viewer.