guix: Let texlive importer handle linked scripts.

* guix/import/texlive.scm (tlpdb): Also retrieve so-called binfiles.
(formats):
(linked-scripts): New functions.
(tlpdb->package): Use new functions to set #:LINK-SCRIPTS argument and
possibly INPUTS.
* tests/texlive.scm (%fake-tlpdb): Add test data.
("texlive->guix-package, single script, no extension"):
("texlive->guix-package, multiple scripts, with extensions"):
("texlive->guix-package, script with associated input"):  New tests.

2 files changed, 215 insertions, 20 deletions

diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm
index 5458a43456..554258f20d 100644
--- a/guix/import/texlive.scm
+++ b/guix/import/texlive.scm
@@ -183,6 +183,7 @@ When TEXLIVE-ONLY is true, only TeX Live packages are returned."
               (srcfiles . list)
               (runfiles . list)
               (docfiles . list)
+              (binfiles . list)
               (depend   . simple-list)
               (execute  . simple-list)))
            (record
@@ -264,6 +265,46 @@ When TEXLIVE-ONLY is true, only TeX Live packages are returned."
                              packages)
                  (append packages deps)))))))
 
+(define (formats package-data)
+  "Return a list of formats to build according to PACKAGE-DATA."
+  (and=> (assoc-ref package-data 'execute)
+         (lambda (actions)
+           (delete-duplicates
+            (filter-map
+             (lambda (action)
+               (match (string-split action #\space)
+                 (("AddFormat" fmt . _)
+                  (string-drop fmt (string-length "name=")))
+                 (_ #f)))
+             ;; Get the right (alphabetic) order.
+             (reverse actions))))))
+
+(define (linked-scripts name package-database)
+  "Return a list of script names to symlink from \"bin/\" directory for
+package NAME according to PACKAGE-DATABASE.  Consider as scripts files with
+\".lua\", \".pl\", \".py\", \".sh\" extensions, and files without extension."
+  (and-let* ((data (assoc-ref package-database name))
+             ;; Check if binaries are associated to the package.
+             (depend (assoc-ref data 'depend))
+             ((member (string-append name ".ARCH") depend))
+             ;; List those binaries.
+             (bin-data (assoc-ref package-database
+                                  ;; Any *nix-like architecture will do.
+                                  (string-append name ".x86_64-linux")))
+             (binaries (map basename (assoc-ref bin-data 'binfiles)))
+             ;; List scripts candidates.  Bail out if there are none.
+             (runfiles (assoc-ref data 'runfiles))
+             (scripts (filter (cut string-prefix? "texmf-dist/scripts/" <>)
+                              runfiles))
+             ((pair? scripts)))
+    (filter-map (lambda (script)
+                  (and (any (lambda (ext)
+                              (member (basename script ext) binaries))
+                            '(".lua" ".pl" ".py" ".sh"))
+                       (basename script)))
+                ;; Get the right (alphabetic) order.
+                (reverse scripts))))
+
 (define* (files-differ? directory package-name
                         #:key
                         (package-database tlpdb)
@@ -348,7 +389,9 @@ of those files are returned that are unexpectedly installed."
              (source (with-store store
                        (download-multi-svn-to-store
                         store ref (string-append name "-svn-multi-checkout")))))
-    (let ((meta-package? (null? locs)))
+    (let* ((meta-package? (null? locs))
+           (scripts (and (not meta-package?)
+                         (linked-scripts texlive-name package-database))))
       (values
        `(package
           (name ,name)
@@ -369,25 +412,10 @@ of those files are returned that are unexpectedly installed."
           (build-system ,(if meta-package?
                              'trivial-build-system
                              'texlive-build-system))
+          ;; Generate arguments field.
           ,@(if meta-package?
                 '((arguments (list #:builder #~(mkdir #$output))))
-                (let* ((formats
-                        ;; Translate AddFormat execute actions into
-                        ;; a #:create-formats argument.
-                        (and-let*
-                            ((actions (assoc-ref data 'execute))
-                             (formats
-                              (delete-duplicates
-                               (filter-map
-                                (lambda (action)
-                                  (match (string-split action #\space)
-                                    (("AddFormat" fmt . _)
-                                     (string-drop fmt (string-length "name=")))
-                                    (_ #f)))
-                                actions)))
-                             ((pair? formats)))
-                          (reverse formats)))
-                       ;; Check if setting #:texlive-latex-bin? is appropriate.
+                (let* ((formats (formats data))
                        (latex-bin-dependency?
                         (member texlive-name
                                 (latex-bin-dependency-tree package-database)))
@@ -395,14 +423,20 @@ of those files are returned that are unexpectedly installed."
                         (append (if latex-bin-dependency?
                                     '(#:texlive-latex-bin? #f)
                                     '())
-                                (if formats
+                                (if (pair? scripts)
+                                    `(#:link-scripts #~(list ,@scripts))
+                                    '())
+                                (if (pair? formats)
                                     `(#:create-formats #~(list ,@formats))
                                     '()))))
                   (if (pair? arguments)
                       `((arguments (list ,@arguments)))
                       '())))
+          ;; Native inputs.
+          ;;
           ;; Texlive build system generates font metrics whenever a font
-          ;; metrics file has the same base name as a Metafont file.
+          ;; metrics file has the same base name as a Metafont file.  In this
+          ;; case, provide `texlive-metafont'.
           ,@(or (and-let* ((runfiles (assoc-ref data 'runfiles))
                            (metrics
                             (filter-map (lambda (f)
@@ -416,6 +450,15 @@ of those files are returned that are unexpectedly installed."
                                  runfiles)))
                   '((native-inputs (list texlive-metafont))))
                 '())
+          ;; Inputs.
+          ,@(match (filter-map (lambda (s)
+                                 (cond ((string-suffix? ".pl" s) 'perl)
+                                       ((string-suffix? ".py" s) 'python)
+                                       (else #f)))
+                               (or scripts '()))
+              (() '())
+              (inputs `((inputs (list ,@inputs)))))
+          ;; Propagated inputs.
           ,@(match (translate-depends depends)
               (() '())
               (inputs
diff --git a/tests/texlive.scm b/tests/texlive.scm
index 063cde6465..98461f7e51 100644
--- a/tests/texlive.scm
+++ b/tests/texlive.scm
@@ -69,6 +69,19 @@
       "texmf-dist/tex/latex/adforn/adforn.sty"
       "texmf-dist/tex/latex/adforn/uornementsadf.fd")
      (catalogue-license . "lppl gpl2"))
+    ("authorindex"
+     (name . "authorindex")
+     (shortdesc . "Index citations by author names")
+     (longdesc . "This package allows the user to...")
+     (depend "authorindex.ARCH")
+     (docfiles "texmf-dist/doc/latex/authorindex/COPYING")
+     (runfiles
+      "texmf-dist/scripts/authorindex/authorindex"
+      "texmf-dist/tex/latex/authorindex/authorindex.sty")
+     (catalogue-license . "lppl"))
+    ("authorindex.x86_64-linux"
+     (name . "authorindex.x86_64-linux")
+     (binfiles "bin/amd64-netbsd/authorindex"))
     ("chs-physics-report"
      . ((name . "ch-physics-report")
         (shortdesc . "Physics lab reports...")
@@ -92,6 +105,22 @@
      (shortdesc . "TeXworks editor...")
      (longdesc . "See http...")
      (depend "texworks" "collection-basic"))
+    ("cyrillic-bin"
+     (name . "cyrillic-bin")
+     (shortdesc . "Cyrillic bibtex and makeindex")
+     (depend "cyrillic-bin.ARCH")
+     (docfiles
+      "texmf-dist/doc/man/man1/rubibtex.1"
+      "texmf-dist/doc/man/man1/rubibtex.man1.pdf")
+     (runfiles
+      "texmf-dist/scripts/texlive-extra/rumakeindex.sh"
+      "texmf-dist/scripts/texlive-extra/rubibtex.sh"))
+    ("cyrillic-bin.x86_64-linux"
+     (name . "cyrillic-bin.x86_64-linux")
+     (shortdesc . "x86_64-linux files of cyrillic-bin")
+     (binfiles
+      "bin/x86_64-linux/rubibtex"
+      "bin/x86_64-linux/rumakeindex"))
     ("example"
      . ((name . "example")
         (shortdesc . "Typeset examples...")
@@ -133,6 +162,24 @@
       "texmf-dist/tex/lollipop/lollipop.ini"
       "texmf-dist/tex/lollipop/lollipop.tex")
      (catalogue-license . "gpl3"))
+    ("pax"
+     (name . "pax")
+     (shortdesc . "Extract and reinsert PDF...")
+     (longdesc . "If PDF files are...")
+     (depend "pax.ARCH")
+     (docfiles
+      "texmf-dist/doc/latex/pax/README")
+     (srcfiles
+      "texmf-dist/source/latex/pax/Makefile"
+      "texmf-dist/source/latex/pax/build.xml")
+     (runfiles
+      "texmf-dist/scripts/pax/pdfannotextractor.pl")
+     (catalogue-license . "lppl gpl"))
+    ("pax.x86_64-linux"
+     (name . "pax.x86_64-linux")
+     (shortdesc . "x86_64-linux files of pax")
+     (binfiles
+      "bin/x86_64-linux/pdfannotextractor"))
     ("stricttex"
      . ((name
          . "stricttex")
@@ -646,4 +693,109 @@ completely compatible with Plain TeX.")
                (format #t "~s~%" result)
                (pk 'fail result #f)))))))
 
+(test-assert "texlive->guix-package, single script, no extension"
+  ;; Replace network resources with sample data.
+  (mock ((guix build svn) svn-fetch
+         (lambda* (url revision directory
+                       #:key (svn-command "svn")
+                       (user-name #f)
+                       (password #f)
+                       (recursive? #t))
+           (mkdir-p directory)
+           (with-output-to-file (string-append directory "/foo")
+             (lambda ()
+               (display "source")))))
+        (let ((result (texlive->guix-package "authorindex"
+                                             #:package-database
+                                             (lambda _ %fake-tlpdb))))
+          (match result
+            (('package
+               ('name "texlive-authorindex")
+               ('version _)
+               ('source _)
+               ('outputs _)
+               ('build-system 'texlive-build-system)
+               ('arguments
+                ('list '#:link-scripts ('gexp ('list "authorindex"))))
+               ('home-page (? string?))
+               ('synopsis (? string?))
+               ('description (? string?))
+               ('license _))
+             #true)
+            (_
+             (begin
+               (format #t "~s~%" result)
+               (pk 'fail result #f)))))))
+
+(test-assert "texlive->guix-package, multiple scripts, with extensions"
+  ;; Replace network resources with sample data.
+  (mock ((guix build svn) svn-fetch
+         (lambda* (url revision directory
+                       #:key (svn-command "svn")
+                       (user-name #f)
+                       (password #f)
+                       (recursive? #t))
+           (mkdir-p directory)
+           (with-output-to-file (string-append directory "/foo")
+             (lambda ()
+               (display "source")))))
+        (let ((result (texlive->guix-package "cyrillic-bin"
+                                             #:package-database
+                                             (lambda _ %fake-tlpdb))))
+          (match result
+            (('package
+               ('name "texlive-cyrillic-bin")
+               ('version _)
+               ('source _)
+               ('outputs _)
+               ('build-system 'texlive-build-system)
+               ('arguments
+                ('list '#:link-scripts
+                       ('gexp ('list "rubibtex.sh" "rumakeindex.sh"))))
+               ('home-page _)
+               ('synopsis _)
+               ('description _)
+               ('license _))
+             #true)
+            (_
+             (begin
+               (format #t "~s~%" result)
+               (pk 'fail result #f)))))))
+
+(test-assert "texlive->guix-package, script with associated input"
+  ;; Replace network resources with sample data.
+  (mock ((guix build svn) svn-fetch
+         (lambda* (url revision directory
+                       #:key (svn-command "svn")
+                       (user-name #f)
+                       (password #f)
+                       (recursive? #t))
+           (mkdir-p directory)
+           (with-output-to-file (string-append directory "/foo")
+             (lambda ()
+               (display "source")))))
+        (let ((result (texlive->guix-package "pax"
+                                             #:package-database
+                                             (lambda _ %fake-tlpdb))))
+          (match result
+            (('package
+               ('name "texlive-pax")
+               ('version _)
+               ('source _)
+               ('outputs _)
+               ('build-system 'texlive-build-system)
+               ('arguments
+                ('list '#:link-scripts ('gexp ('list "pdfannotextractor.pl"))))
+               ('inputs
+                ('list 'perl))
+               ('home-page _)
+               ('synopsis _)
+               ('description _)
+               ('license _))
+             #true)
+            (_
+             (begin
+               (format #t "~s~%" result)
+               (pk 'fail result #f)))))))
+
 (test-end "texlive")