Scheme code to generate a "provide" list for ArchLinux's perl package.

provides.rkt

#lang racket

;; Generate a provides list for the ArchLinux perl package. Scan the appropriate directories
;; under the perl source tree for directories containing distributions, suitable for CPAN.
;; Search the files in the distributions for VERSION strings, which are perl expressions.
;; Filters these version strings through the perl interpreter, then transform the dist.
;; names and versions into package names and versions. This last step is much easier now.
;; The perl source tree has been greatly organized since even 5.18.

(define perl-src-dir "/Users/juster/src/perl-5.20.0")

(define (perl-dist-versions perl-dir)
  (append (find-dist-versions (build-path perl-dir "cpan"))
          (find-dist-versions (build-path perl-dir "dist"))))

(define (path->dist-name dist-path)
  (let-values ([(x top y) (split-path dist-path)])
    (path->string top)))

(define (lib-mod-path dist-path mod-name)
  (apply build-path dist-path "lib"
         (string-split (string-append mod-name ".pm") "::")))

(define (dumb-mod-path dist-path mod-name file-suffix)
  (let ([mod-file (regexp-match #rx"[^:]+$" mod-name)])
    (if mod-file (build-path dist-path (string-append (first mod-file) file-suffix)) #f)))

(define (dist-source-path dist-path)
  (define dist-mods '(("PathTools" . "Cwd")
                      ("Scalar-List-Utils" . "List::Util")
                      ("IO-Compress" . "IO::Compress::Gzip")))
  (let* ([dist-name (path->dist-name dist-path)]
         [mod-force (assoc dist-name dist-mods)]
         [mod-name (if mod-force (cdr mod-force)
                       (string-join (string-split dist-name "-") "::"))])
    (findf (lambda (p) (and p (file-exists? p)))
           (list (lib-mod-path dist-path mod-name)
                 (dumb-mod-path dist-path mod-name ".pm")
                 (dumb-mod-path dist-path mod-name "_pm.PL")
                 (build-path dist-path "VERSION")))))

(define (scan-version-line src-path)
  (call-with-input-file src-path
    (lambda (in)
      (let ([ver-ln (regexp-match (string-append "(?m:^.*VERSION *=>?.*$)") in)])
        (if ver-ln (bytes->string/utf-8 (regexp-replace "^.*VERSION *=>? *" (first ver-ln) "")) #f)))))

(define (scan-module-ver src-path)
  (scan-version-line src-path))

;; libnet is the only dist which has its version solely in Makefile.PL!
(define (scan-makefile-ver mk-path)
  (let ([verln (scan-version-line mk-path)])
    (if verln (string-replace verln "," ";") #f))) ; match the other VERSION strings

(define (dist-version dist-path)
  (let ([source-path (dist-source-path dist-path)]
        [makefile-path (build-path dist-path "Makefile.PL")])
    (cond [source-path (scan-module-ver source-path)]
          [(file-exists? makefile-path) (scan-makefile-ver makefile-path)]
          [else #f])))

(define (find-dist-versions dist-base-path)
  (define (find-dist-versions dir-list found-versions)
    (if (empty? dir-list) found-versions
        (find-dist-versions
         (rest dir-list)
         (if (directory-exists? (first dir-list))
             (cons (cons (path->dist-name (first dir-list)) (dist-version (first dir-list)))
                   found-versions)
             found-versions))))
  (find-dist-versions (directory-list dist-base-path #:build? #t) empty))


(define (eval-perl-verstr verstr)
  (let-values ([(p out in err) (subprocess #f #f #f "/usr/bin/perl")])
    (displayln (string-append "print " verstr) in)
    (close-output-port in) ; perl blocks until stdin is closed
    (subprocess-wait p)
    (let ([sane-ver (port->string out)]
          [perl-err (port->string err)])
      (close-input-port out)
      (close-input-port err)
      (if (not (zero? (subprocess-status p)))
          (error 'eval-perl-verstr (string-append "perl interpreter error: " perl-err))
          sane-ver))))

(define (eval-dist-vers dv-alist)
  (define (eval-dvs alist-in alist-out)
    (if (empty? alist-in) alist-out
        (eval-dvs (rest alist-in)
                  (cons (cons (car (first alist-in)) (eval-perl-verstr (cdr (first alist-in))))
                        alist-out))))
  (eval-dvs dv-alist empty))

(define (dist-alist->pkg-alist dv-alist)
  (define (pkg-name dist-name)
    (string-append "perl-" (string-downcase dist-name)))
  (define (pkg-ver dist-ver)
    dist-ver)
  (define (dist->pkg dv-alist pv-alist)
    (if (empty? dv-alist) pv-alist
        (dist->pkg (rest dv-alist)
                   (cons (cons (pkg-name (car (first dv-alist))) (pkg-ver (cdr (first dv-alist)))) pv-alist))))
  (dist->pkg dv-alist empty))

(define (perl-src-provides src-dir)
  (let ([pkg-alist (dist-alist->pkg-alist (eval-dist-vers (perl-dist-versions src-dir)))])
    (sort (filter (lambda (dv) (not (regexp-match #rx"win32" (car dv)))) pkg-alist)
          (lambda (a b) (string<? (car a) (car b))))))