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

(module gather-egg-information

(gather-egg-information)

(import chicken scheme)
(use data-structures files posix setup-api srfi-1)

(define (latest-version egg versions)
  (let ((versions (sort versions version>=?)))
    (and (pair? versions)
         (car versions))))

(define (egg-versions-dir egg-dir)
  (let ((tags-dir (make-pathname egg-dir "tags")))
    (if (directory-exists? tags-dir)
        tags-dir  ;; old cache format
        egg-dir   ;; new cache format
        )))

(define (egg-versions versions-dir)
  (directory versions-dir))

(define (locate-egg base-dir egg-name)
  (and-let* ((egg-dir (make-pathname base-dir egg-name))
             ((directory-exists? egg-dir))
             (versions-dir (egg-versions-dir egg-dir))
             (version (latest-version egg-name (egg-versions versions-dir)))
             (latest-version-dir (make-pathname versions-dir version)))
    (cons latest-version-dir version)))

(define (gather-egg-information dir)
  (filter-map
   (lambda (egg)
     (and-let* ((version-dir/version (locate-egg dir egg))
                (version-dir (car version-dir/version))
                (version (cdr version-dir/version))
                (meta (make-pathname version-dir egg "meta"))
                ((file-exists? meta)))
       (call/cc
        (lambda (return)
          (cons (string->symbol egg)
                (cons (list 'version version)
                      (handle-exceptions ex
                        (begin
                          (warning "extension has syntactically invalid .meta file"
                                   egg)
                          (return #f))
                        (with-input-from-file meta read))))))))
   (directory dir)))

) ;; end module