123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475 |
- (define-module (guix build cvs)
- #:use-module (guix build utils)
- #:use-module (ice-9 regex)
- #:use-module (ice-9 ftw)
- #:export (cvs-fetch))
- (define (find-cvs-directories)
- (define (enter? path st result)
- (not (string-suffix? "/CVS" path)))
- (define (leaf path st result) result)
- (define (down path st result) result)
- (define (up path st result) result)
- (define (skip path st result)
- (if (and (string-suffix? "/CVS" path)
- (eqv? 'directory (stat:type st)))
- (cons path result)
- result))
- (define (error path st errno result)
- (format (current-error-port) "cvs-fetch: ~a: ~a~%"
- path (strerror errno)))
- (sort (file-system-fold enter? leaf down up skip error '() "." lstat)
- string<?))
- (define* (cvs-fetch cvs-root-directory module revision directory
- #:key (cvs-command "cvs"))
- "Fetch REVISION from MODULE of CVS-ROOT-DIRECTORY into DIRECTORY. REVISION
- must either be a date in ISO-8601 format (e.g. \"2012-12-21\") or a CVS tag.
- Return #t on success, #f otherwise."
-
-
-
- (invoke cvs-command "-z0"
- "-d" cvs-root-directory
- "checkout"
- (if (string-match "^[0-9]{4}-[0-9]{2}-[0-9]{2}$" revision)
- "-D" "-r")
- revision
- module)
-
-
- (copy-recursively module directory)
- (with-directory-excursion directory
- (for-each delete-file-recursively (find-cvs-directories)))
- #t)
|