aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-11-01 01:39:23 +0100
committerLudovic Courtès <ludo@gnu.org>2012-11-01 01:39:23 +0100
commite3d741065e29b6f0d050592da853b641205c21bc (patch)
tree9356839f14e4239361b0f83bdd23298f4160cfcd
parent07d18f39cc8c547e4ea893b18d5a5dbc755e0287 (diff)
downloadguix-e3d741065e29b6f0d050592da853b641205c21bc.tar.gz
guix-e3d741065e29b6f0d050592da853b641205c21bc.zip
store: Add `store-path-package-name'.
* guix/store.scm (store-path-package-name): New procedure. * tests/utils.scm ("store-path-package-name"): New test.
-rw-r--r--guix/store.scm13
-rw-r--r--tests/utils.scm7
2 files changed, 19 insertions, 1 deletions
diff --git a/guix/store.scm b/guix/store.scm
index 5ac98d80bb..0bebe8a564 100644
--- a/guix/store.scm
+++ b/guix/store.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)))
diff --git a/tests/utils.scm b/tests/utils.scm
index a0b42052ad..7dd248fae2 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -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)