ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

build-system: Add ‘composer-build-system’.

Browse source 
* guix/build-system/composer.scm: New file.
* guix/build/composer-build-system.scm: New file.
* gnu/packages/aux-files/findclass.php: New file.
* Makefile.am: Add them.
* doc/guix.texi (Build Systems): Document it.

Co-authored-by: Julien Lepiller <julien@lepiller.eu>
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Change-Id: Ie6a05b42ff04d3ad774a0a20278a77e4820bb8f6
This commit is contained in:
Nicolas Graves 2023-11-02 16:16:50 +01:00 committed by Ludovic Courtès
parent e8fd78d54e
commit 9dab758791
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 608 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile.am
View file

@ -154,6 +154,7 @@ MODULES = \
guix/build-system/clojure.scm \
guix/build-system/cmake.scm \
guix/build-system/copy.scm \
guix/build-system/composer.scm \
guix/build-system/dub.scm \
guix/build-system/dune.scm \
guix/build-system/elm.scm \
@ -212,6 +213,7 @@ MODULES = \
guix/build/cargo-utils.scm \
guix/build/chicken-build-system.scm \
guix/build/cmake-build-system.scm \
guix/build/composer-build-system.scm \
guix/build/dub-build-system.scm \
guix/build/dune-build-system.scm \
guix/build/elm-build-system.scm \
@ -420,6 +422,7 @@ dist_noinst_DATA = \
AUX_FILES = \
gnu/packages/aux-files/chromium/master-preferences.json \
gnu/packages/aux-files/emacs/guix-emacs.el \
gnu/packages/aux-files/findclass.php \
gnu/packages/aux-files/guix.vim \
gnu/packages/aux-files/linux-libre/6.6-arm.conf \
gnu/packages/aux-files/linux-libre/6.6-arm64.conf \

14
doc/guix.texi
View file

@ -9598,6 +9598,20 @@ debugging information''), which roughly means that code is compiled with
@code{-O2 -g}, as is the case for Autoconf-based packages by default.
@end defvar
@defvar composer-build-system
This variable is exported by @code{(guix build-system composer)}. It
implements the build procedure for packages using
@url{https://getcomposer.org/, Composer}, the PHP package manager.
It automatically adds the @code{php} package to the set of inputs. Which
package is used can be specified with the @code{#:php} parameter.
The @code{#:test-target} parameter is used to control which script is run
for the tests. By default, the @code{test} script is run if it exists. If
the script does not exist, the build system will run @code{phpunit} from the
source directory, assuming there is a @file{phpunit.xml} file.
@end defvar
@defvar dune-build-system
This variable is exported by @code{(guix build-system dune)}. It
supports builds of packages using @uref{https://dune.build/, Dune}, a build

125
gnu/packages/aux-files/findclass.php Normal file
View file

@ -0,0 +1,125 @@
<?php
/**
* The content of this file is copied from composer's src/Composer/Autoload/ClassMapGenerator.php
* the findClasses method was extracted, to prevent using any dependency.
*
* Composer (and thus this file) is distributed under the expat license, and
* ClassMapGenerator.php also contains this notice:
*
* This file is part of Composer.
*
* (c) Nils Adermann <naderman@naderman.de>
* Jordi Boggiano <j.boggiano@seld.be>
*
* For the full copyright and license information, please view the LICENSE
* file that was distributed with this source code.
*
* This file is copied from the Symfony package.
*
* (c) Fabien Potencier <fabien@symfony.com>
*
* To the extent to wich it makes sense, as the author of the extract:
* Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
*/
/**
* Extract the classes in the given file
*
* @param string $path The file to check
* @throws \RuntimeException
* @return array The found classes
*/
function findClasses($path)
{
$extraTypes = PHP_VERSION_ID < 50400 ? '' : '|trait';
if (defined('HHVM_VERSION') && version_compare(HHVM_VERSION, '3.3', '>=')) {
$extraTypes .= '|enum';
}
// Use @ here instead of Silencer to actively suppress 'unhelpful' output
// @link https://github.com/composer/composer/pull/4886
$contents = @php_strip_whitespace($path);
if (!$contents) {
if (!file_exists($path)) {
$message = 'File at "%s" does not exist, check your classmap definitions';
} elseif (!is_readable($path)) {
$message = 'File at "%s" is not readable, check its permissions';
} elseif ('' === trim(file_get_contents($path))) {
// The input file was really empty and thus contains no classes
return array();
} else {
$message = 'File at "%s" could not be parsed as PHP, it may be binary or corrupted';
}
$error = error_get_last();
if (isset($error['message'])) {
$message .= PHP_EOL . 'The following message may be helpful:' . PHP_EOL . $error['message'];
}
throw new \RuntimeException(sprintf($message, $path));
}
// return early if there is no chance of matching anything in this file
if (!preg_match('{\b(?:class|interface'.$extraTypes.')\s}i', $contents)) {
return array();
}
// strip heredocs/nowdocs
$contents = preg_replace('{<<<[ \t]*([\'"]?)(\w+)\\1(?:\r\n|\n|\r)(?:.*?)(?:\r\n|\n|\r)(?:\s*)\\2(?=\s+|[;,.)])}s', 'null', $contents);
// strip strings
$contents = preg_replace('{"[^"\\\\]*+(\\\\.[^"\\\\]*+)*+"|\'[^\'\\\\]*+(\\\\.[^\'\\\\]*+)*+\'}s', 'null', $contents);
// strip leading non-php code if needed
if (substr($contents, 0, 2) !== '<?') {
$contents = preg_replace('{^.+?<\?}s', '<?', $contents, 1, $replacements);
if ($replacements === 0) {
return array();
}
}
// strip non-php blocks in the file
$contents = preg_replace('{\?>(?:[^<]++|<(?!\?))*+<\?}s', '?><?', $contents);
// strip trailing non-php code if needed
$pos = strrpos($contents, '?>');
if (false !== $pos && false === strpos(substr($contents, $pos), '<?')) {
$contents = substr($contents, 0, $pos);
}
// strip comments if short open tags are in the file
if (preg_match('{(<\?)(?!(php|hh))}i', $contents)) {
$contents = preg_replace('{//.* | /\*(?:[^*]++|\*(?!/))*\*/}x', '', $contents);
}
preg_match_all('{
(?:
\b(?<![\$:>])(?P<type>class|interface'.$extraTypes.') \s++ (?P<name>[a-zA-Z_\x7f-\xff:][a-zA-Z0-9_\x7f-\xff:\-]*+)
| \b(?<![\$:>])(?P<ns>namespace) (?P<nsname>\s++[a-zA-Z_\x7f-\xff][a-zA-Z0-9_\x7f-\xff]*+(?:\s*+\\\\\s*+[a-zA-Z_\x7f-\xff][a-zA-Z0-9_\x7f-\xff]*+)*+)? \s*+ [\{;]
)
}ix', $contents, $matches);
$classes = array();
$namespace = '';
for ($i = 0, $len = count($matches['type']); $i < $len; $i++) {
if (!empty($matches['ns'][$i])) {
$namespace = str_replace(array(' ', "\t", "\r", "\n"), '', $matches['nsname'][$i]) . '\\';
} else {
$name = $matches['name'][$i];
// skip anon classes extending/implementing
if ($name === 'extends' || $name === 'implements') {
continue;
}
if ($name[0] === ':') {
// This is an XHP class, https://github.com/facebook/xhp
$name = 'xhp'.substr(str_replace(array('-', ':'), array('_', '__'), $name), 1);
} elseif ($matches['type'][$i] === 'enum') {
// In Hack, something like:
// enum Foo: int { HERP = '123'; }
// The regex above captures the colon, which isn't part of
// the class name.
$name = rtrim($name, ':');
}
$classes[] = ltrim($namespace . $name, '\\');
}
}
return $classes;
}
$options = getopt('i:f:', []);
$file = $options["f"];
$input = $options["i"];
$classes = findClasses($file);
foreach($classes as $class) {
echo '$classmap[\''.$class.'\'] = \''.$input.'/'.$file.'\';';
echo "\n";
}

165
guix/build-system/composer.scm Normal file
View file

@ -0,0 +1,165 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
;;;
;;; 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/>.
(define-module (guix build-system composer)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (%composer-build-system-modules
lower
composer-build
composer-build-system))
;; Commentary:
;;
;; Standard build procedure for PHP packages using Composer. This is implemented
;; as an extension of `gnu-build-system'.
;;
;; Code:
(define (default-php)
"Return the default PHP package."
;; Do not use `@' to avoid introducing circular dependencies.
(let ((module (resolve-interface '(gnu packages php))))
(module-ref module 'php)))
(define (default-findclass)
"Return the default findclass script."
(search-auxiliary-file "findclass.php"))
(define (default-composer-classloader)
"Return the default composer-classloader package."
;; Do not use `@' to avoid introducing circular dependencies.
(let ((module (resolve-interface '(gnu packages php-xyz))))
(module-ref module 'composer-classloader)))
(define %composer-build-system-modules
;; Build-side modules imported by default.
`((guix build composer-build-system)
(guix build union)
(json)
(json builder)
(json parser)
(json record)
,@%gnu-build-system-modules))
(define* (lower name
#:key source inputs native-inputs outputs system target
(php (default-php))
(composer-classloader (default-composer-classloader))
(findclass (default-findclass))
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:target #:php #:composer-classloader #:findclass #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
(name name)
(system system)
(host-inputs `(,@(if source
`(("source" ,source))
'())
,@inputs
;; Keep the standard inputs of 'gnu-build-system'.
,@(standard-packages)))
(build-inputs `(("php" ,php)
("findclass.php" ,findclass)
("composer-classloader" ,composer-classloader)
,@native-inputs))
(outputs outputs)
(build composer-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(define* (composer-build name inputs
#:key
guile source
(outputs '("out"))
(configure-flags ''())
(search-paths '())
(out-of-source? #t)
(composer-file "composer.json")
(tests? #t)
(test-target "test")
(test-flags ''())
(install-target "install")
(validate-runpath? #t)
(patch-shebangs? #t)
(strip-binaries? #t)
(strip-flags #~'("--strip-debug"))
(strip-directories #~'("lib" "lib64" "libexec"
"bin" "sbin"))
(phases '(@ (guix build composer-build-system)
%standard-phases))
(system (%current-system))
(imported-modules %composer-build-system-modules)
(modules '((guix build composer-build-system)
(guix build utils))))
"Build SOURCE using PHP, and with INPUTS. This assumes that SOURCE provides
a 'composer.json' file as its build system."
(define builder
(with-imported-modules imported-modules
#~(begin
(use-modules #$@(sexp->gexp modules))
#$(with-build-variables inputs outputs
#~(composer-build
#:source #$source
#:system #$system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths '#$(map search-path-specification->sexp
search-paths)
#:phases #$phases
#:out-of-source? #$out-of-source?
#:composer-file #$composer-file
#:tests? #$tests?
#:test-target #$test-target
#:test-flags #$test-flags
#:install-target #$install-target
#:validate-runpath? #$validate-runpath?
#:patch-shebangs? #$patch-shebangs?
#:strip-binaries? #$strip-binaries?
#:strip-flags #$strip-flags
#:strip-directories #$strip-directories)))))
(gexp->derivation name builder
#:system system
#:target #f
#:graft? #f
#:guile-for-build guile))
(define composer-build-system
(build-system
(name 'composer)
(description "The standard Composer build system")
(lower lower)))
;;; composer.scm ends here

301
guix/build/composer-build-system.scm Normal file
View file

@ -0,0 +1,301 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
;;;
;;; 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/>.
(define-module (guix build composer-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module (guix build utils)
#:use-module (ice-9 match)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%standard-phases
composer-build))
;; Commentary:
;;
;; Builder-side code of the standard composer build procedure.
;;
;; Code:
(define (json->require dict)
(if dict
(let loop ((result '()) (require dict))
(match require
(() result)
((((? (cut string-contains <> "/") name) . _)
require ...)
(loop (cons name result) require))
((_ require ...) (loop result require))
(_ result)))
'()))
(define (if-specified-to-list fn)
(match-lambda
((? unspecified?) '())
(arg (fn arg))
(_ '())))
(define-json-mapping <composer-autoload> make-composer-autoload
composer-autoload?
json->composer-autoload
(psr-4 composer-autoload-psr-4 "psr-4"
(match-lambda
((? unspecified?) '())
((? (lambda (al)
(and (list? al) (pair? (car al)) (vector? (cdar al)))) al)
(append-map
(lambda (vect-el)
(list (cons (caar al) vect-el)))
(vector->list (cdar al))))
((? list? l) l)
(_ '())))
(psr-0 composer-autoload-psr-0 "psr-0" (if-specified-to-list identity))
(classmap composer-autoload-classmap "classmap"
(if-specified-to-list vector->list))
(files composer-autoload-files "files"
(if-specified-to-list vector->list)))
(define-json-mapping <composer-package> make-composer-package composer-package?
json->composer-package
(name composer-package-name)
(autoload composer-package-autoload "autoload"
(if-specified-to-list json->composer-autoload))
(autoload-dev composer-package-autoload-dev "autoload-dev"
(if-specified-to-list json->composer-autoload))
(require composer-package-require "require" json->require)
(dev-require composer-package-dev-require "require-dev" json->require)
(scripts composer-package-scripts "scripts"
(if-specified-to-list identity))
(binaries composer-package-binaries "bin"
(if-specified-to-list vector->list)))
(define* (read-package-data #:key (filename "composer.json"))
(call-with-input-file filename
(lambda (port)
(json->composer-package (json->scm port)))))
(define* (create-test-autoload #:key composer-file inputs outputs tests?
#:allow-other-keys)
"Create the autoload.php file for tests. This is a standalone phase so that
the autoload.php file can be edited before the check phase."
(when tests?
(mkdir-p "vendor")
(create-autoload (string-append (getcwd) "/vendor") composer-file
inputs #:dev-dependencies? #t)))
(define (find-bin script inputs)
(search-input-file inputs
(string-append
"bin/"
(string-drop script (string-length "vendor/bin/")))))
(define* (check #:key composer-file inputs
tests? test-target test-flags #:allow-other-keys)
"Test the given package.
Please note that none of the PHP packages at the time of the rewrite of the
build-system did use the test-script field. This means that the @code{match
test-script} part is not tested on a real example and relies on the original
implementation."
(if tests?
(let* ((package-data (read-package-data #:filename composer-file))
(scripts (composer-package-scripts package-data))
(test-script (assoc-ref scripts test-target)))
(match test-script
((? string? bin)
(let ((command (find-bin bin inputs)))
(unless (zero? (apply system command test-flags))
(throw 'failed-command command))))
(('@ (? string? bins) ...)
(for-each
(lambda (c)
(let ((command (find-bin c inputs)))
(unless (zero? (apply system command test-flags))
(throw 'failed-command command))))
bins))
(_ (if (file-exists? "phpunit.xml.dist")
(apply invoke
(with-exception-handler
(lambda (exn)
(if (search-error? exn)
(error "\
Missing php-phpunit-phpunit native input.~%")
(raise exn)))
(lambda ()
(search-input-file (or inputs '()) "bin/phpunit")))
test-flags))
(format #t "No test suite found.~%"))))
(format #t "Test suite not run.~%")))
(define* (create-autoload vendor composer-file inputs #:key dev-dependencies?)
"creates an autoload.php file that sets up the class locations for this package,
so it can be autoloaded by PHP when the package classes are required."
(with-output-to-file (string-append vendor "/autoload.php")
(lambda _
(display (string-append
"<?php
// autoload.php @generated by Guix
$psr4map = $classmap = array();
require_once '" vendor "/autoload_conf.php';
require_once '" (assoc-ref inputs "composer-classloader") "/share/web/composer/ClassLoader.php';
$loader = new \\Composer\\Autoload\\ClassLoader();
foreach ($psr4map as $namespace => $paths) {
foreach ($paths as $path) {
$loader->addPsr4($namespace, $path);
}
}
$loader->addClassMap($classmap);
$loader->register();
"))))
;; Now, create autoload_conf.php that contains the actual data, as a set
;; of arrays
(let* ((package-data (read-package-data #:filename composer-file))
(autoload (composer-package-autoload package-data))
(autoload-dev (composer-package-autoload-dev package-data))
(dependencies (composer-package-require package-data))
(dependencies-dev (composer-package-dev-require package-data)))
(with-output-to-file (string-append vendor "/autoload_conf.php")
(lambda _
(format #t "<?php~%")
(format #t "// autoload_conf.php @generated by Guix~%")
(force-output)
(for-each
(match-lambda
((key . value)
(let ((vals (if (list? value)
(reverse value)
(list value))))
(apply
format
#t
(string-append
"$psr4map['~a'][] = ["
(string-join
(make-list (length vals) "'~a/../~a'") ",")
"];~%")
(cons* (string-join (string-split key #\\) "\\\\")
(append-map (lambda (v) (list vendor v)) vals)))))
(_ (format #t "")))
(delete-duplicates
(append
(composer-autoload-psr-4 autoload)
(if (and dev-dependencies? (not (null? autoload-dev)))
(composer-autoload-psr-4 autoload-dev)
'()))
'()))
(for-each
(lambda (psr0)
(match psr0
((key . value)
(format #t "$psr4map['~a'][] = ['~a/../~a/~a'];~%"
(string-join (string-split key #\\) "\\\\")
vendor
value
(string-join (string-split key #\\) "/")))
(_ (format #t ""))))
(append
(composer-autoload-psr-0 autoload)
(if (and dev-dependencies? (not (null? autoload-dev)))
(composer-autoload-psr-0 autoload-dev)
'())))
(for-each
(lambda (classmap)
(for-each
(lambda (file)
(invoke "php" (assoc-ref inputs "findclass.php")
"-i" (string-append vendor "/..") "-f" file))
(find-files classmap ".(php|hh|inc)$")))
(append
(composer-autoload-classmap autoload)
(if (and dev-dependencies? (not (null? autoload-dev)))
(composer-autoload-classmap autoload-dev)
'())))
(for-each
(lambda (file)
(format #t "require_once '~a/../~a';~%" vendor file))
(append
(composer-autoload-files autoload)
(if (and dev-dependencies? (not (null? autoload-dev)))
(composer-autoload-files autoload-dev)
'())))
(for-each
(lambda (dep)
(format
#t "require_once '~a';~%"
(search-input-file
inputs
(string-append "/share/web/" dep "/vendor/autoload_conf.php"))))
dependencies)
;; Also add native-inputs that are not necessarily given in the
;; composer.json. This allows to simply add a package in tests by
;; adding it in native-inputs, without the need to patch composer.json.
(for-each
(match-lambda
((name . loc)
(match (find-files loc "autoload_conf\\.php$")
(() #t)
(((? string? conf) . ())
(format #t "require_once '~a';~%" conf))
(_ #t)))
(_ #t))
(or inputs '()))))))
(define* (install #:key inputs outputs composer-file #:allow-other-keys)
"Install the given package."
(let* ((out (assoc-ref outputs "out"))
(package-data (read-package-data #:filename composer-file))
(name (composer-package-name package-data))
(php-dir (string-append out "/share/web/" name))
(bin-dir (string-append php-dir "/vendor/bin"))
(bin (string-append out "/bin"))
(binaries (composer-package-binaries package-data)))
(mkdir-p php-dir)
(copy-recursively "." php-dir)
(mkdir-p (string-append php-dir "/vendor"))
(when binaries
(mkdir-p bin-dir)
(mkdir-p bin)
(for-each
(lambda (file)
(let ((installed-file (string-append bin-dir "/" (basename file)))
(bin-file (string-append bin "/" (basename file)))
(original-file (string-append php-dir "/" file)))
(symlink original-file installed-file)
(symlink original-file bin-file)))
binaries))
(create-autoload (string-append php-dir "/vendor")
composer-file inputs)))
(define %standard-phases
;; Everything is as with the GNU Build System except for the `configure'
;; , `build', `check' and `install' phases.
(modify-phases gnu:%standard-phases
(delete 'bootstrap)
(delete 'configure)
(delete 'build)
(delete 'check)
(replace 'install install)
(add-after 'install 'check check)
(add-after 'install 'create-test-autoload create-test-autoload)))
(define* (composer-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
"Build the given package, applying all of PHASES in order."
(apply gnu:gnu-build #:inputs inputs #:phases phases args))
;;; composer-build-system.scm ends here