Re: Pipes and processes, stdin, stdout and stderr -- ./configure in Guile

[Jan Nieuwenhuizen]

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 <address@hidden> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl