source: project/chicken/trunk/scripts/make-egg-rss-feed.scm @ 14257

Last change on this file since 14257 was 14257, checked in by felix winkelmann, 11 years ago

make-egg-rss-feed uses sxml-transforms, now

File size: 3.3 KB
Line 
1;;;; make-egg-rss-feed.scm - create RSS 2.0 feed for extension release directory
2
3(load-relative "tools.scm")
4
5;; uses sxml-transforms since htmlprag idiotically attempts to be clever
6;; about empty elements (i.e. "link").
7
8(use setup-download matchable sxml-transforms data-structures regex srfi-1)
9
10(import irregex)
11
12(define *major-version* (##sys#fudge 41))
13
14(define +categories+
15  '((lang-exts "Language extensions")
16    (graphics "Graphics")
17    (debugging "Debugging tools")
18    (logic "Logic programming")
19    (net "Networking")
20    (io "Input/Output")
21    (db "Databases")
22    (os "OS interface")
23    (ffi "Interfacing to other languages")
24    (web "Web programing")
25    (xml "XML processing")
26    (doc-tools "Documentation tools")
27    (egg-tools "Egg tools")
28    (math "Mathematical libraries")
29    (oop "Object-oriented programming")
30    (data "Algorithms and data-structures")
31    (parsing "Data formats and parsing")
32    (tools "Tools")
33    (sound "Sound")
34    (testing "Unit-testing")
35    (crypt "Cryptography")
36    (ui "User interface toolkits")
37    (code-generation "Code generation")
38    (macros "Macros and meta-syntax")
39    (misc "Miscellaneous")
40    (hell "Concurrency and parallelism")
41    (uncategorized "Not categorized")
42    (obsolete "Unsupported or redundant") ) )
43
44(define (d fstr . args)
45  (fprintf (current-error-port) "~?~%" fstr args))
46
47(define (usage code)
48  (print "make-egg-rss-feed.scm [--major-version=MAJOR] [DIR]")
49  (exit code))
50
51(define (make-egg-rss-feed dir)
52  (let ((title (sprintf "Eggs Unlimited (release branch ~a)" *major-version*))
53        (eggs (gather-egg-information dir)))
54    (display "<?xml version='1.0'?>\n")
55    (SXML->HTML
56     `(rss
57       (@ (version "2.0"))
58       (channel
59        ,@(channel title)
60        ,@(items eggs))))))
61
62(define (channel title)
63  (let ((date (seconds->string (current-seconds))))
64    `((title ,title)
65      (link "http://galinha.ucpel.tche.br/chicken-projects/egg-rss-feed-4.xml")
66      (description "RSS feed for publishing latest CHICKEN extensions")
67      (language "en-us")
68      (copyright "(c)2009 The CHICKEN Team")
69      (pubDate ,date)
70      (lastBuildDate ,date))))
71
72(define (items eggs)
73  (map
74   (lambda (egg)
75     (call/cc
76      (lambda (return)
77        (define (prop name def pred)
78          (cond ((assq name (cdr egg)) => (o (cut check pred <> name) cadr))
79                (else def)))
80        (define (check pred x p)
81          (cond ((pred x) x)
82                (else
83                 (warning "extension has .meta entry of incorrect type and will not be listed" (car egg) p x)
84                 (return '()))))
85        (d "  ~a   ~a" (car egg) (prop 'version "HEAD" any?))
86        `(item 
87          (title ,(sprintf "~a ~a (~a)" 
88                           (car egg) 
89                           (prop 'version "" version?)
90                           (let* ((c1 (prop 'category 'uncategorized name?))
91                                  (c (assq c1 +categories+)))
92                             (if c (cadr c) (sprintf "unknown category: ~a" c1)))))
93          (guid ,(symbol->string (car egg)))
94          (link ,(sprintf "http://chicken.wiki.br/eggref/~a/~a" *major-version* (car egg)))
95          (description ,(prop 'synopsis "unknown" string?))
96          (author ,(prop 'author "unknown" name?))))))
97   eggs))
98
99(define name?
100  (disjoin string? symbol?))
101
102(define version?
103  (disjoin string? number?))
104
105(define (main args)
106  (match args
107    (((or "-h" "-help" "--help") . _) (usage 0))
108    ((dir)
109     (make-egg-rss-feed dir))
110    (() (make-egg-rss-feed "."))
111    (_ (usage 1))))
112
113(main (simple-args (command-line-arguments)))
Note: See TracBrowser for help on using the repository browser.