root/lang/scheme/bloscheme/template-rdf.scm @ 32353

#!gosh
(use text.html-lite)
(use text.tree)

(define-module
  text.xml-lite
  (extend text.html-lite)
  (define-macro (define-elements prefix . elements)
                (define (make-scheme-name name)
                  (string->symbol (format #f "~a:~a" prefix name)))
                (let loop ((elements elements)
                           (r '()))
                  (cond ((null? elements) `(begin ,@(reverse r)))
                        ((and (pair? (cdr elements)) (eqv? (cadr elements) :empty))
                         (loop (cddr elements)
                               (list* `(define ,(make-scheme-name (car elements))
                                         (make-html-element ',(make-scheme-name (car elements)) :empty? #t))
                                      `(export ,(make-scheme-name (car elements)))
                                      r)))
                        (else
                          (loop (cdr elements)
                                (list* `(define ,(make-scheme-name (car elements))
                                          (make-html-element ',(make-scheme-name (car elements))))
                                       `(export ,(make-scheme-name (car elements)))
                                       r))))
                  ))
  (define-elements rdf RDF Seq Alt Bag li)
  (define-elements rss channel items item title link description)
  (define-elements content encoded)
  (define-elements dc creator date title description)
  (define-elements admin generatorAgent)
  )
(import text.xml-lite)

(define (result stash-table)
  (define (stash name)
    (html-escape-string (hash-table-get stash-table name)))
  (define (stash-raw name)
    (hash-table-get stash-table name))
  (define base *server-root*)

  `(,(cgi-header :content-type "application/rss+xml; charset=UTF-8")
     ,(rdf:RDF
        :xmlns:rss     "http://purl.org/rss/1.0/"
        :xmlns:rdf     "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
        :xmlns:dc      "http://purl.org/dc/elements/1.1/"
        :xmlns:admin   "http://webns.net/mvcb/"
        :xmlns:content "http://purl.org/rss/1.0/modules/content/"

        (rss:channel
          :rdf:about ""
          (rss:title (html-escape-string *blog-title*))
          (rss:link (string-join (list base (stash 'home)) ""))
          (rss:description "")
          (admin:generatorAgent :rdf:resource "http://jknaoya.s311.xrea.com/bloscheme/bloscheme.cgi/?v=0")
          (rss:items
            (rdf:Seq
              (map (lambda (file)
                     (rdf:li :rdf:resource (string-join (list base (stash 'home) (file 'name)) "")))
                   (stash-raw 'files))
              )))
        (map (lambda (file)
               (rss:item
                 :rdf:about (string-join (list base (stash 'home) (file 'name)) "")

                 (rss:title (html-escape-string (file 'title)))
                 (rss:link (string-join (list base (stash 'home) (file 'name)) ""))
                 (dc:date (date->string (file 'date) "~Y-~m-~dT~H:~M:~S+09:00"))
                 (content:encoded (html-escape-string (string-join (file 'body) "\n")))

                 ))
             (stash-raw 'files))
        ) ; /rdf:RDF
     )
  )