Mark H Weaver writes:
In a somewhat related effort I've been fighting with reading stderr for
./configure and reverted to using redirection in the shell.
Greetings, Jan
-- ./configure
#! /usr/bin/guile \
-e main
!#
(define (main . args)
((@@ (configure) main) (command-line)))
(read-set! keywords 'prefix)
(define-module (configure)
:use-module (ice-9 curried-definitions)
:use-module (ice-9 and-let-star)
:use-module (ice-9 getopt-long)
:use-module (ice-9 optargs)
:use-module (ice-9 match)
:use-module (ice-9 rdelim)
:use-module (os process))
(define (logf port string . rest)
(apply format (cons* port string rest))
(force-output port)
#t)
(define (stderr string . rest)
(apply logf (cons* (current-error-port) string rest)))
(define (stdout string . rest)
(apply logf (cons* (current-output-port) string rest)))
(define* (gulp-port :optional (port (current-input-port)))
(or (and-let* ((result (read-delimited "" port))
((string? result)))
result)
""))
(define (gulp-pipe command)
(gulp-port (cdr (apply run-with-pipe (list "r" "/bin/bash" "-c" command)))))
(define (parse-opts args)
(let* ((option-spec
'((help (single-char #\h))))
(options (getopt-long args option-spec
:stop-at-first-non-option #t))
(help? (option-ref options 'help #f))
(files (option-ref options '() '()))
(usage? (and (not help?) (not (null? files))))
(version? (option-ref options 'version #f)))
(or
(and version?
(stdout "0.1\n")
(exit 0))
(and (or help? usage?)
((or (and usage? stderr) stdout) "\
Usage: ./configure [OPTION]...
-h, --help display this help
")
(exit (or (and usage? 2) 0)))
options)))
(define (tuple< a b)
(cond
((and (null? a) (null? b)) #t)
((null? a) (not (null? b)))
((null? b) #f)
((and (not (< (car a) (car b)))
(not (< (car b) (car a))))
(tuple< (cdr a) (cdr b)))
(else (< (car a) (car b)))))
(define (tuple<= a b)
(or (equal? a b) (tuple< a b)))
(define* ((->string :optional (infix "")) h . t)
(let ((src (if (pair? t) (cons h t) h)))
(match src
((? char?) (make-string 1 src))
((? string?) src)
((? symbol?) (symbol->string src))
((? number?) (number->string src))
((h ... t) (string-join (map (->string) src) ((->string) infix)))
(_ ""))))
(define (version->string version)
((->string '.) version))
(define (string->version string)
(and-let* ((version (string-tokenize string (char-set-adjoin char-set:digit
#\.)))
((pair? version))
(version (car version))
(version (string-tokenize version (char-set-complement (char-set
#\.))))) (map string->number version)))
(define required '())
(define* (check-version command expected :optional (deb #f) (version-option
'--version) (compare tuple<=))
(stderr "checking for ~a~a..." command (if (pair? expected) (format #f "
[~a]" (version->string expected)) ""))
(let* ((actual (gulp-pipe (format #f "~a ~a 2>&1" command version-option)))
(actual (string->version actual))
(pass? (and actual (compare expected actual))))
(stderr "~a ~a\n" (if pass? (if (pair? actual) "" " yes") (if actual " no,
found" "")) (version->string actual))
(if (not pass?)
(set! required (cons (or deb command) required)))
pass?))
(define* (check-pkg-config package expected :optional (deb #f))
(check-version (format #f "pkg-config --modversion ~a" package) expected deb))
(define (check-compile-header-c++ header)
(and (= 0 (system (format #f "echo '#include \"~a\"' | gcc --language=c++
--std=c++11 -E - > /dev/null 2>&1" header)))
'yes))
(define* (check-header-c++ header deb :optional (check
check-compile-header-c++))
(stderr "checking for ~a..." header)
(let ((result (check header)))
(stderr " ~a\n" (if result result "no"))
(if (not result)
(set! required (cons deb required)))))
(define (main args)
(let* ((verum? (file-exists? "/verum"))
(options (parse-opts args)))
(check-version 'gcc '(4 8))
(check-version 'g++ '(4 8))
(check-version 'bison '())
(check-version 'flex '())
(check-version 'guile '(2 0) 'guile-2.0)
(check-version 'guild '(2 0) 'guile-2.0-dev)
(check-version 'java '(1 8) 'openjdk-8-jre-headless '-version)
(check-version 'javac '(1 8) 'openjdk-8-jdk '-version)
(check-version 'mcs '(3) 'mono-mcs)
(check-version 'npm '())
(check-version 'pkg-config '(0 25))
(check-pkg-config 'gtk+-3.0 '())
(check-pkg-config 'gtkmm-3.0 '())
(check-version 'psql '(9 3) 'postgresql)
(check-header-c++ 'boost/algorithm/string.hpp 'libboost-dev))
(when (pair? required)
(stderr "\nMissing dependencies, run\n\n")
(stderr " sudo apt-get install ~a\n" ((->string " ") required))
(exit 1))
(stdout "\nRun:
make to build Dezyne
make help for help on other targets\n"))
--
Jan Nieuwenhuizen <jann...@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.nl
