source: project/release/4/gather-egg-information/trunk/gather-egg-information.scm @ 31442

Last change on this file since 31442 was 31442, checked in by Mario Domenech Goulart, 6 years ago

release/4: add gather-egg-information

File size: 1.7 KB
Line 
1(module gather-egg-information
2
3(gather-egg-information)
4
5(import chicken scheme)
6(use data-structures files posix setup-api srfi-1)
7
8(define (latest-version egg versions)
9  (let ((versions (sort versions version>=?)))
10    (and (pair? versions)
11         (car versions))))
12
13(define (egg-versions-dir egg-dir)
14  (let ((tags-dir (make-pathname egg-dir "tags")))
15    (if (directory-exists? tags-dir)
16        tags-dir  ;; old cache format
17        egg-dir   ;; new cache format
18        )))
19
20(define (egg-versions versions-dir)
21  (directory versions-dir))
22
23(define (locate-egg base-dir egg-name)
24  (and-let* ((egg-dir (make-pathname base-dir egg-name))
25             ((directory-exists? egg-dir))
26             (versions-dir (egg-versions-dir egg-dir))
27             (version (latest-version egg-name (egg-versions versions-dir)))
28             (latest-version-dir (make-pathname versions-dir version)))
29    (cons latest-version-dir version)))
30
31(define (gather-egg-information dir)
32  (filter-map
33   (lambda (egg)
34     (and-let* ((version-dir/version (locate-egg dir egg))
35                (version-dir (car version-dir/version))
36                (version (cdr version-dir/version))
37                (meta (make-pathname version-dir egg "meta"))
38                ((file-exists? meta)))
39       (call/cc
40        (lambda (return)
41          (cons (string->symbol egg)
42                (cons (list 'version version)
43                      (handle-exceptions ex
44                        (begin
45                          (warning "extension has syntactically invalid .meta file"
46                                   egg)
47                          (return #f))
48                        (with-input-from-file meta read))))))))
49   (directory dir)))
50
51) ;; end module
Note: See TracBrowser for help on using the repository browser.