From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jan Nieuwenhuizen Newsgroups: gmane.lisp.guile.user Subject: Re: Pipes and processes, stdin, stdout and stderr -- ./configure in Guile Date: Sun, 17 May 2015 14:14:03 +0200 Organization: AvatarAcademy.nl Message-ID: <87382vxuyc.fsf_-_@drakenvlieg.flower> References: <873842yahs.fsf@earlgrey.lan> <87r3rhphjv.fsf@netris.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: ger.gmane.org 1431864877 2654 80.91.229.3 (17 May 2015 12:14:37 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 17 May 2015 12:14:37 +0000 (UTC) Cc: guile-user To: Mark H Weaver Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Sun May 17 14:14:26 2015 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YtxSb-0006rr-IN for guile-user@m.gmane.org; Sun, 17 May 2015 14:14:25 +0200 Original-Received: from localhost ([::1]:36922 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YtxSa-00081S-Qg for guile-user@m.gmane.org; Sun, 17 May 2015 08:14:24 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:54078) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YtxSS-00081M-9j for guile-user@gnu.org; Sun, 17 May 2015 08:14:17 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YtxSO-0006an-8g for guile-user@gnu.org; Sun, 17 May 2015 08:14:16 -0400 Original-Received: from lb3-smtp-cloud2.xs4all.net ([194.109.24.29]:39014) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YtxSO-0006ad-07 for guile-user@gnu.org; Sun, 17 May 2015 08:14:12 -0400 Original-Received: from drakenvlieg.flower.peder.onsbrabantnet.nl ([62.140.132.197]) by smtp-cloud2.xs4all.net with ESMTP id V0E31q0084FhfW6010E9KG; Sun, 17 May 2015 14:14:10 +0200 X-Url: http://AvatarAcademy.nl In-Reply-To: <87r3rhphjv.fsf@netris.org> (Mark H. Weaver's message of "Sat, 18 Apr 2015 11:44:36 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.4 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 194.109.24.29 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.user:11825 Archived-At: 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<=3D 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:dig= it #\.))) ((pair? version)) (version (car version)) (version (string-tokenize version (char-set-complement (char-s= et #\.))))) (map string->number version))) (define required '()) (define* (check-version command expected :optional (deb #f) (version-option= '--version) (compare tuple<=3D)) (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 (=3D 0 (system (format #f "echo '#include \"~a\"' | gcc --language= =3Dc++ --std=3Dc++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")) --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.nl= =20=20