01/03: guix: Add download-multi-svn-to-store.

[guix-commits]

rekado pushed a commit to branch master
in repository guix.

commit 3e5749fc331243e9d29baa73a569dc6b6de25f33
Author: Ricardo Wurmus <rekado@elephly.net>
AuthorDate: Mon Nov 15 16:37:17 2021 +0000

    guix: Add download-multi-svn-to-store.
    
    * guix/svn-download.scm (download-multi-svn-to-store): New procedure.
---
 guix/svn-download.scm | 31 +++++++++++++++++++++++++++++--
 1 file changed, 29 insertions(+), 2 deletions(-)

diff --git a/guix/svn-download.scm b/guix/svn-download.scm
index b961512..e5fe8f1 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
-;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2019, 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,7 +26,9 @@
   #:use-module (guix packages)
   #:use-module (guix utils)
   #:use-module ((guix build svn) #:prefix build:)
+  #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:export (svn-reference
             svn-reference?
             svn-reference-url
@@ -41,7 +43,8 @@
             svn-multi-reference-revision
             svn-multi-reference-locations
             svn-multi-reference-recursive?
-            svn-multi-fetch))
+            svn-multi-fetch
+            download-multi-svn-to-store))
 
 ;;; Commentary:
 ;;;
@@ -166,4 +169,28 @@ reports to LOG."
             (add-to-store store name #t "sha256"
                           (string-append temp "/svn")))))))
 
+(define* (download-multi-svn-to-store store ref
+                                      #:optional (name (basename 
(svn-multi-reference-url ref)))
+                                      #:key (log (current-error-port)))
+  "Download from REF, a <svn-multi-reference> object to STORE.  Write progress
+reports to LOG."
+  (call-with-temporary-directory
+   (lambda (temp)
+     (and (every (lambda (location)
+                   (let ((dir (string-append temp "/" (dirname location))))
+                     (mkdir-p dir))
+                   (parameterize ((current-output-port log))
+                     (build:svn-fetch (string-append (svn-multi-reference-url 
ref)
+                                                     "/" location)
+                                      (svn-multi-reference-revision ref)
+                                      (if (string-suffix? "/" location)
+                                          (string-append temp "/" location)
+                                          (string-append temp "/" (dirname 
location)))
+                                      #:recursive?
+                                      (svn-multi-reference-recursive? ref)
+                                      #:user-name 
(svn-multi-reference-user-name ref)
+                                      #:password (svn-multi-reference-password 
ref))))
+                 (svn-multi-reference-locations ref))
+          (add-to-store store name #t "sha256" temp)))))
+
 ;;; svn-download.scm ends here