bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

[Arun Isaac]

* guix/build/perl-build-system.scm (wrap): New procedure.
(%standard-phases): Add it.
---
 guix/build/perl-build-system.scm | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm
index 8f480eae1..32ef86b65 100644
--- a/guix/build/perl-build-system.scm
+++ b/guix/build/perl-build-system.scm
@@ -19,7 +19,10 @@
 (define-module (guix build perl-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build utils)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:export (%standard-phases
             perl-build))
 
@@ -68,6 +71,31 @@
 (define-w/gnu-fallback* (install)
   (zero? (system* "./Build" "install")))
 
+(define* (wrap #:key inputs outputs #:allow-other-keys)
+  (define (list-of-files dir)
+    (map (cut string-append dir "/" <>)
+         (or (scandir dir (lambda (f)
+                            (let ((s (stat (string-append dir "/" f))))
+                              (eq? 'regular (stat:type s)))))
+             '())))
+
+  (define bindirs
+    (append-map (match-lambda
+                  ((_ . dir)
+                   (list (string-append dir "/bin")
+                         (string-append dir "/sbin"))))
+                outputs))
+
+  (let* ((out  (assoc-ref outputs "out"))
+         (var `("PERL5LIB" prefix
+                ,(search-path-as-string->list
+                  (or (getenv "PERL5LIB") "")))))
+    (for-each (lambda (dir)
+                (let ((files (list-of-files dir)))
+                  (for-each (cut wrap-program <> var)
+                            files)))
+              bindirs)))
+
 (define %standard-phases
   ;; Everything is as with the GNU Build System except for the `configure',
   ;; `build', `check', and `install' phases.
@@ -75,6 +103,7 @@
     (replace 'install install)
     (replace 'check check)
     (replace 'build build)
+    (add-after 'install 'wrap wrap)
     (replace 'configure configure)))
 
 (define* (perl-build #:key inputs (phases %standard-phases)
-- 
2.11.0

bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

[Marius Bakke]

[-- Attachment #1: Type: text/plain, Size: 2669 bytes --]

Hello!

I can't study the code right now, but at a glance it looks like this
will also include native-inputs in PERL5LIB. Can you try to filter them
out?

Doing that will effectively also solve
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25235 . Patch welcome! :)

Arun Isaac <arunisaac@systemreboot.net> writes:

> * guix/build/perl-build-system.scm (wrap): New procedure.
> (%standard-phases): Add it.
> ---
>  guix/build/perl-build-system.scm | 29 +++++++++++++++++++++++++++++
>  1 file changed, 29 insertions(+)
>
> diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm
> index 8f480eae1..32ef86b65 100644
> --- a/guix/build/perl-build-system.scm
> +++ b/guix/build/perl-build-system.scm
> @@ -19,7 +19,10 @@
>  (define-module (guix build perl-build-system)
>    #:use-module ((guix build gnu-build-system) #:prefix gnu:)
>    #:use-module (guix build utils)
> +  #:use-module (ice-9 ftw)
>    #:use-module (ice-9 match)
> +  #:use-module (srfi srfi-1)
> +  #:use-module (srfi srfi-26)
>    #:export (%standard-phases
>              perl-build))
>  
> @@ -68,6 +71,31 @@
>  (define-w/gnu-fallback* (install)
>    (zero? (system* "./Build" "install")))
>  
> +(define* (wrap #:key inputs outputs #:allow-other-keys)
> +  (define (list-of-files dir)
> +    (map (cut string-append dir "/" <>)
> +         (or (scandir dir (lambda (f)
> +                            (let ((s (stat (string-append dir "/" f))))
> +                              (eq? 'regular (stat:type s)))))
> +             '())))
> +
> +  (define bindirs
> +    (append-map (match-lambda
> +                  ((_ . dir)
> +                   (list (string-append dir "/bin")
> +                         (string-append dir "/sbin"))))
> +                outputs))
> +
> +  (let* ((out  (assoc-ref outputs "out"))
> +         (var `("PERL5LIB" prefix
> +                ,(search-path-as-string->list
> +                  (or (getenv "PERL5LIB") "")))))
> +    (for-each (lambda (dir)
> +                (let ((files (list-of-files dir)))
> +                  (for-each (cut wrap-program <> var)
> +                            files)))
> +              bindirs)))
> +
>  (define %standard-phases
>    ;; Everything is as with the GNU Build System except for the `configure',
>    ;; `build', `check', and `install' phases.
> @@ -75,6 +103,7 @@
>      (replace 'install install)
>      (replace 'check check)
>      (replace 'build build)
> +    (add-after 'install 'wrap wrap)
>      (replace 'configure configure)))
>  
>  (define* (perl-build #:key inputs (phases %standard-phases)
> -- 
> 2.11.0

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

[Arun Isaac]

> I can't study the code right now, but at a glance it looks like this
> will also include native-inputs in PERL5LIB. Can you try to filter them
> out?
>
> Doing that will effectively also solve
> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25235 . Patch welcome! :)

Yes, I'll do this! :-) I'll first send a patch for bug 25235, we'll
close that, and then come back here.

bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

[Ludovic Courtès]

Hi Arun,

Arun Isaac <arunisaac@systemreboot.net> skribis:

>> I can't study the code right now, but at a glance it looks like this
>> will also include native-inputs in PERL5LIB. Can you try to filter them
>> out?
>>
>> Doing that will effectively also solve
>> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25235 . Patch welcome! :)
>
> Yes, I'll do this! :-) I'll first send a patch for bug 25235, we'll
> close that, and then come back here.

What’s the status of this patch?  It might still be time for
‘core-updates’ if it’s ready…

Ludo’.

bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

[Arun Isaac]

> What’s the status of this patch?  It might still be time for
> ‘core-updates’ if it’s ready…

I don't have a solution for the native-inputs being included in the
wrap. Without that, I can deliver a patch. I've just been waiting for
someone to figure out the native-inputs problem. This problem is shared
with the python wrap phase as well.

https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25235

But, Alex Sassmannshausen has a generalized wrap phase for python and
perl ready at https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27003 . So,
I think we should close this bug report and bug 25235 to use his
patches. He too does not have a solution for the native-inputs problem.

bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

[Jonathan Brielmaier]

Functionality was added in 0fb9a8df429a7b9f40610ff15baaff0d8e31e8cf by
Ricardo.

bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

[Arun Isaac]

As discussed earlier at bug 26203
(https://debbugs.gnu.org/cgi/bugreport.cgi?bug=26203), I have added a
`wrap' phase to the perl-build-system. Please consider this a first
iteration and provide feedback.

bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

[Arun Isaac]

> +(define* (wrap #:key inputs outputs #:allow-other-keys)
> +  (define (list-of-files dir)
> +    (map (cut string-append dir "/" <>)
> +         (or (scandir dir (lambda (f)
> +                            (let ((s (stat (string-append dir "/" f))))
> +                              (eq? 'regular (stat:type s)))))
> +             '())))
> +
> +  (define bindirs
> +    (append-map (match-lambda
> +                  ((_ . dir)
> +                   (list (string-append dir "/bin")
> +                         (string-append dir "/sbin"))))
> +                outputs))
> +
> +  (let* ((out  (assoc-ref outputs "out"))
> +         (var `("PERL5LIB" prefix
> +                ,(search-path-as-string->list
> +                  (or (getenv "PERL5LIB") "")))))
> +    (for-each (lambda (dir)
> +                (let ((files (list-of-files dir)))
> +                  (for-each (cut wrap-program <> var)
> +                            files)))
> +              bindirs)))

I copied this wrap function from the python build system, and modified
it a little to suite perl. Is there any reason `list-of-files' and
`bindirs' are initialized using `define' rather than a `let' binding?
This is probably a very basic Guile question, but still...

Thanks,
Arun Isaac.

bug#26275: [PATCH] build: perl-build-system: Add `wrap' phase.

[Ludovic Courtès]

Hi,

And sorry for the delay.

Arun Isaac <arunisaac@systemreboot.net> skribis:

>> +(define* (wrap #:key inputs outputs #:allow-other-keys)
>> +  (define (list-of-files dir)
>> +    (map (cut string-append dir "/" <>)
>> +         (or (scandir dir (lambda (f)
>> +                            (let ((s (stat (string-append dir "/" f))))
>> +                              (eq? 'regular (stat:type s)))))
>> +             '())))
>> +
>> +  (define bindirs
>> +    (append-map (match-lambda
>> +                  ((_ . dir)
>> +                   (list (string-append dir "/bin")
>> +                         (string-append dir "/sbin"))))
>> +                outputs))
>> +
>> +  (let* ((out  (assoc-ref outputs "out"))
>> +         (var `("PERL5LIB" prefix
>> +                ,(search-path-as-string->list
>> +                  (or (getenv "PERL5LIB") "")))))
>> +    (for-each (lambda (dir)
>> +                (let ((files (list-of-files dir)))
>> +                  (for-each (cut wrap-program <> var)
>> +                            files)))
>> +              bindirs)))
>
> I copied this wrap function from the python build system, and modified
> it a little to suite perl. Is there any reason `list-of-files' and
> `bindirs' are initialized using `define' rather than a `let' binding?
> This is probably a very basic Guile question, but still...

It’s purely cosmetic in this case: it makes them more visible and fits
within the 80-column limit.  :-)

Technically:

  (define (proc x y)
    (define a …)
    (define b …)
    body …)

is equivalent to:

  (define (proc x y)
    (letrec ((a …)
             (b …))
      body …))

See <https://gnu.org/software/guile/manual/html_node/Local-Bindings.html>.

HTH!

Ludo’.