2 files changed, 19 insertions(+), 1 deletions(-)

M guix/store.scm
M tests/utils.scm

@@ 29,6 29,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 regex)
   #:export (nix-server?
             nix-server-major-version
             nix-server-minor-version


@@ 55,7 56,8 @@
 
             %store-prefix
             store-path?
-            derivation-path?))
+            derivation-path?
+            store-path-package-name))
 
 (define %protocol-version #x10b)
 


@@ 446,3 448,12 @@ file name.  Return #t on success."
 (define (derivation-path? path)
   "Return #t if PATH is a derivation path."
   (and (store-path? path) (string-suffix? ".drv" path)))
+
+(define (store-path-package-name path)
+  "Return the package name part of PATH, a file name in the store."
+  (define store-path-rx
+    (make-regexp (string-append "^.*" (regexp-quote (%store-prefix))
+                                "/[^-]+-(.+)$")))
+
+  (and=> (regexp-exec store-path-rx path)
+         (cut match:substring <> 1)))

@@ 19,6 19,7 @@
 
 (define-module (test-utils)
   #:use-module (guix utils)
+  #:use-module ((guix store) #:select (store-path-package-name))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)


@@ 162,6 163,12 @@
           (match b (($ <foo> 1 2) #t))
           (equal? b c)))))
 
+;; This is actually in (guix store).
+(test-equal "store-path-package-name"
+  "bash-4.2-p24"
+  (store-path-package-name
+   "/nix/store/qvs2rj2ia5vci3wsdb7qvydrmacig4pg-bash-4.2-p24"))
+
 (test-end)