store: Add `store-path-hash-part'.

* guix/store.scm (store-path-hash-part): New procedure.
* tests/store.scm ("store-path-hash-part", "store-path-hash-part #f"):
  New tests.
This commit is contained in:
Ludovic Courtès 2013-04-01 16:08:31 +02:00
parent ef8c03407d
commit 2c6ab6ccd4
2 changed files with 23 additions and 1 deletions

View File

@ -83,7 +83,8 @@
%store-prefix
store-path?
derivation-path?
store-path-package-name))
store-path-package-name
store-path-hash-part))
(define %protocol-version #x10c)
@ -751,3 +752,12 @@ collected, and the number of bytes freed."
(and=> (regexp-exec store-path-rx path)
(cut match:substring <> 1)))
(define (store-path-hash-part path)
"Return the hash part of PATH as a base32 string, or #f if PATH is not a
syntactically valid store path."
(let ((path-rx (make-regexp
(string-append"^" (regexp-quote (%store-prefix))
"/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
(and=> (regexp-exec path-rx path)
(cut match:substring <> 1))))

View File

@ -48,6 +48,18 @@
(test-begin "store")
(test-equal "store-path-hash-part"
"283gqy39v3g9dxjy26rynl0zls82fmcg"
(store-path-hash-part
(string-append (%store-prefix)
"/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
(test-equal "store-path-hash-part #f"
#f
(store-path-hash-part
(string-append (%store-prefix)
"/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
(test-skip (if %store 0 10))
(test-assert "dead-paths"