;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013 David Thompson ;;; Copyright © 2014 Sree Harsha Totakura ;;; Copyright © 2014 Mark H Weaver ;;; Copyright © 2015 Paul van der Walt ;;; Copyright © 2015, 2016, 2017, 2019 Efraim Flashner ;;; Copyright © 2017, 2018 Marius Bakke ;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; Copyright © 2018 Leo Famulari ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed
aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (ice-9 format)
             (ice-9 match)
             (ice-9 threads)
             (srfi srfi-1)
             (guix build compile)
             (guix build utils))

(define host (getenv "host"))
(define srcdir (getenv "srcdir"))

(define (relative-file file)
  (if (string-prefix? (string-append srcdir "/") file)
      (string-drop file (+ 1 (string-length srcdir)))
      file))

(define (file-mtime<? f1 f2)
  (< (stat:mtime (stat f1))
     (stat:mtime (stat f2))))

(define (scm->go file)
  (let* ((relative (relative-file file))
         (without-extension (string-drop-right relative 4)))
    (string-append without-extension ".go")))

(define (file-needs-compilation? file)
  (let ((go (scm->go file)))
    (or (not (file-exists? go))
        (file-mtime<? go file))))

(define* (parallel-job-count #:optional (flags (getenv "MAKEFLAGS")))
  "Return the number of parallel jobs as determined by FLAGS, the flags passed
to 'make'."
  (match flags
    (#f (current-processor-count))
    (flags
     (let ((initial-flags (string-tokenize flags)))
       (let loop ((flags initial-flags))
         (match flags
           (()
            ;; Note: GNU make prior to version 4.2 would hide "-j" flags from
            ;; $MAKEFLAGS.  Thus, check for a "--jobserver" flag here and
            ;; assume we're using all cores if specified.
            (if (any (lambda (flag)
                       (string-prefix? "--jobserver" flag))
                     initial-flags)
                (current-processor-count)         ;GNU make < 4.2
                1))                               ;sequential make
           (("-j" (= string->number count) _ ...)
            (if (integer? count)
                count
                (current-processor-count)))
           ((head tail ...)
            (if (string-prefix? "-j" head)
                (match (string-drop head 2)
                  (""
                   (current-processor-count))
                  ((= string->number count)
                   (if (integer? count)
                       count
                       (current-processor-count))))
                (loop tail)))))))))

(define (parallel-job-count*)
  ;; XXX: Work around memory requirements not sustainable on i686 above '-j4'
  ;; or so: <https://bugs.gnu.org/40522>.
  (let ((count (parallel-job-count)))
    (if (string-prefix? "i686" %host-type)
        (min count 4)
        count)))

(define (% completed total)
  "Return the completion percentage of COMPLETED over TOTAL as an integer."
  (inexact->exact (round (* 100. (/ completed total)))))

;; Install a SIGINT handler to give unwind handlers in 'compile-file' an
;; opportunity to run upon SIGINT and to remove temporary output files.
(sigaction SIGINT
  (lambda args
    (exit 1)))

(match (command-line)
  ((_ "--total" (= string->number grand-total)
      "--completed" (= string->number processed)
      . files)
   ;; GRAND-TOTAL is the total number of .scm files in the project; PROCESSED
   ;; is the total number of .scm files already compiled in previous
   ;; invocations of this script.
   (catch #t
     (lambda ()
       (let* ((to-build  (filter file-needs-compilation? files))
              (processed (+ processed
                            (- (length files) (length to-build)))))
         (compile-files srcdir (getcwd) to-build
                        #:workers (parallel-job-count*)
                        #:host host
                        #:report-load (lambda (file total completed)
                                        (when file
                                          (format #t "[~3d%] LOAD     ~a~%"
                                                  (% (+ 1 completed
                                                          (* 2 processed))
                                                     (* 2 grand-total))
                                                  file)
                                          (force-output)))
                        #:report-compilation (lambda (file total completed)
                                               (when file
                                                 (format #t "[~3d%] GUILEC   ~a~%"
                                                         (% (+ total completed 1
                                                                     (* 2 processed))
                                                            (* 2 grand-total))
                                                         (scm->go file))
                                                 (force-output))))))
     (lambda _
       (primitive-exit 1))
     (lambda args
       ;; Try to report the error in an intelligible way.
       (let* ((stack   (make-stack #t))
              (frame   (if (> (stack-length stack) 1)
                           (stack-ref stack 1)    ;skip the 'throw' frame
                           (stack-ref stack 0)))
              (ui      (false-if-exception
                        (resolve-module '(guix ui))))
              (report  (and ui
                            (false-if-exception
                             (module-ref ui 'report-load-error)))))
         (if report
             (report (or (and=> (current-load-port) port-filename) "?.scm")
                     args frame)
             (begin
               (print-exception (current-error-port) frame
                                (car args) (cdr args))
               (display-backtrace stack (current-error-port)))))))))
generated by cgit
fine flac (package (name "flac") (version "1.3.2") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/flac/flac-" version ".tar.xz")) (sha256 (base32 "0gymm2j3276kr9nz6vmgfwsdfrq6c449n40a0mzz8h6wc7nw7kwi")) (patches (search-patches "flac-CVE-2017-6888.patch")))) (build-system gnu-build-system) (arguments `(#:parallel-tests? #f)) ;; FIXME: configure also looks for xmms, input could be added once it exists (propagated-inputs `(("libogg" ,libogg))) ; required by flac.pc (synopsis "Free lossless audio codec") (description "FLAC stands for Free Lossless Audio Codec, an audio format that is lossless, meaning that audio is compressed in FLAC without any loss in quality.") (license (license:non-copyleft "file://COPYING" "See COPYING in the distribution.")) ; and LGPL and GPL (home-page "https://xiph.org/flac/"))) (define libkate (package (name "libkate") (version "0.4.1") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/kate/" "libkate-" version ".tar.gz")) (sha256 (base32 "0s3vr2nxfxlf1k75iqpp4l78yf4gil3f0v778kvlngbchvaq23n4")))) (build-system gnu-build-system) (native-inputs `(("doxygen" ,doxygen) ("pkg-config" ,pkg-config))) ;; FIXME: Add optional input liboggz (inputs `(("bison" ,bison) ("libogg" ,libogg) ("libpng" ,libpng) ("python" ,python-wrapper) ("zlib" ,zlib))) (synopsis "Karaoke and text codec for embedding in ogg") (description "Kate is an overlay codec, originally designed for karaoke and text, that can be multiplixed in Ogg. Text and images can be carried by a Kate stream, and animated. Most of the time, this would be multiplexed with audio/video to carry subtitles, song lyrics (with or without karaoke data), etc., but doesn't have to be. Series of curves (splines, segments, etc.) may be attached to various properties (text position, font size, etc.) to create animated overlays. This allows scrolling or fading text to be defined. This can even be used to draw arbitrary shapes, so hand drawing can also be represented by a Kate stream.") (license license:bsd-3) (home-page "https://wiki.xiph.org/OggKate"))) (define vorbis-tools (package (name "vorbis-tools") (version "1.4.0") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/vorbis/" "vorbis-tools-" version ".tar.gz")) (sha256 (base32 "1g12bnh5ah08v529y72kfdz5lhvy75iaz7f9jskyby23m9dkk2d3")) (patches (search-patches "vorbis-tools-CVE-2014-9638+CVE-2014-9639.patch" "vorbis-tools-CVE-2014-9640.patch" "vorbis-tools-CVE-2015-6749.patch")))) (build-system gnu-build-system) (inputs `(("ao" ,ao) ("curl" ,curl) ("flac" ,flac) ("libkate" ,libkate) ("libogg" ,libogg) ("libvorbis" ,libvorbis) ("speex" ,speex))) (native-inputs `(("pkg-config" ,pkg-config))) (synopsis "Ogg vorbis tools") (description "Ogg vorbis is a non-proprietary, patent-and-royalty-free, general-purpose compressed audio format. The package vorbis-tools contains ogg123, an ogg vorbis command line audio player; oggenc, the ogg vorbis encoder; oggdec, a simple, portable command line decoder (to wav and raw); ogginfo, to obtain information (tags, bitrate, length, etc.) about an ogg vorbis file.") (license license:gpl2) (home-page "https://xiph.org/vorbis/"))) (define opus (package (name "opus") (version "1.3.1") (source (origin (method url-fetch) (uri (string-append "https://archive.mozilla.org/pub/opus/opus-" version ".tar.gz")) (sha256 (base32 "17gz8kxs4i7icsc1gj713gadiapyklynlwqlf0ai98dj4lg8xdb5")))) (build-system gnu-build-system) (synopsis "Versatile audio codec") (description "Opus is a totally open, royalty-free, highly versatile audio codec. Opus is unmatched for interactive speech and music transmission over the Internet, but is also intended for storage and streaming applications. It is standardized by the Internet Engineering Task Force (IETF) as RFC 6716 which incorporated technology from Skype's SILK codec and Xiph.Org's CELT codec.") (license license:bsd-3) (home-page "https://www.opus-codec.org"))) (define opus-tools (package (name "opus-tools") (version "0.2") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/opus/opus-tools-" version ".tar.gz")) (sha256 (base32 "11pzl27s4vcz4m18ch72nivbhww2zmzn56wspb7rll1y1nq6rrdl")))) (build-system gnu-build-system) (arguments ;; The package developers misuse pkg-config such that it doesn't work ;; when cross compiling. Therefore we avoid it completly and set the ;; necessary flags ourselves. `(#:configure-flags (list (string-append "CFLAGS=-I" (assoc-ref %build-inputs "libogg") "/include -I" (assoc-ref %build-inputs "opus") "/include/opus")))) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("libopusenc" ,libopusenc) ("opusfile" ,opusfile) ("flac" ,flac))) (synopsis "Command line utilities to encode, inspect, and decode .opus files") (description "Opus is a royalty-free, highly versatile audio codec. Opus-tools provide command line utilities for creating, inspecting and decoding .opus files.") (license license:bsd-3) (home-page "https://www.opus-codec.org"))) (define opusfile (package (name "opusfile") (version "0.11") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/opus/opusfile-" version ".tar.gz")) (sha256 (base32 "1gq3aszzl5glgbajw5p1f5a1kdyf23w5vjdmwwrk246syin9pkkl")))) (build-system gnu-build-system) ;; Required by opusfile.pc and opusurl.pc. (propagated-inputs `(("libogg" ,libogg) ("openssl" ,openssl) ("opus" ,opus))) (native-inputs `(("pkg-config" ,pkg-config))) (synopsis "Versatile audio codec") (description "The opusfile library provides seeking, decode, and playback of Opus streams in the Ogg container (.opus files) including over http(s) on posix and windows systems.") (license license:bsd-3) (home-page "https://www.opus-codec.org"))) (define-public libopusenc (package (name "libopusenc") (version "0.2.1") (source (origin (method url-fetch) (uri (string-append "https://archive.mozilla.org/pub/opus/" "libopusenc-" version ".tar.gz")) (sha256 (base32 "1ffb0vhlymlsq70pxsjj0ksz77yfm2x0a1x8q50kxmnkm1hxp642")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) (propagated-inputs `(("opus" ,opus))) (synopsis "Library for encoding Opus audio files and streams ") (description "The libopusenc libraries provide a high-level API for encoding Opus files and streams.") (home-page "https://www.opus-codec.org/") (license license:bsd-3))) (define-public icecast (package (name "icecast") (version "2.4.4") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/icecast/icecast-" version ".tar.gz")) (sha256 (base32 "0i2d9rhav0x6js2qhjf5iy6j2a7f0d11ail0lfv40hb1kygrgda9")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("libxslt" ,libxslt) ("libxml2" ,libxml2) ("openssl" ,openssl) ("curl" ,curl) ("libogg" ,libogg) ("libvorbis" ,libvorbis) ("libtheora" ,libtheora) ("speex" ,speex))) (synopsis "Streaming media server") (description "Icecast is a streaming media server which currently supports Ogg (Vorbis and Theora), Opus, WebM and MP3 audio streams. It can be used to create an Internet radio station or a privately running jukebox and many things in between.") (home-page "https://icecast.org/") (license license:gpl2))) (define-public libshout (package (name "libshout") (version "2.4.1") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/libshout/" name "-" version ".tar.gz")) (sha256 (base32 "0kgjpf8jkgyclw11nilxi8vyjk4s8878x23qyxnvybbgqbgbib7k")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) (propagated-inputs ;; shout.pc refers to all these. `(("libtheora" ,libtheora) ("libvorbis" ,libvorbis) ("speex" ,speex))) (home-page "https://icecast.org/") (synopsis "Audio streaming library for icecast encoders") (description "Libshout is a library for communicating with and sending data to an icecast server. It handles the socket connection, the timing of the data, and prevents bad data from getting to the icecast server.") (license license:gpl2+)))