03/10: gnu-maintenance: Extract url->links procedure.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit f6cfc993acef3dad6985d12d8fc2e52334829b25
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Wed Aug 9 22:40:01 2023 -0400

    gnu-maintenance: Extract url->links procedure.
    
    * guix/gnu-maintenance.scm (url->links): New procedure.
    (import-html-release): Use it.
---
 guix/gnu-maintenance.scm | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 6db0dd952c..fc9cf50f29 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -483,6 +483,14 @@ hosted on ftp.gnu.org, or not under that name (this is the 
case for
       (_
        links))))
 
+(define (url->links url)
+  "Return the unique links on the HTML page accessible at URL."
+  (let* ((uri   (string->uri url))
+         (port  (http-fetch/cached uri #:ttl 3600))
+         (sxml  (html->sxml port)))
+    (close-port port)
+    (delete-duplicates (html-links sxml))))
+
 (define* (import-html-release base-url package
                               #:key
                               (version #f)
@@ -499,12 +507,10 @@ When FILE->SIGNATURE is omitted or #f, guess the detached 
signature file name,
 if any.  Otherwise, FILE->SIGNATURE must be a procedure; it is passed a source
 file URL and must return the corresponding signature URL, or #f it signatures
 are unavailable."
-  (let* ((uri   (string->uri (if (string-null? directory)
-                                 base-url
-                                 (string-append base-url directory "/"))))
-         (port  (http-fetch/cached uri #:ttl 3600))
-         (sxml  (html->sxml port))
-         (links (delete-duplicates (html-links sxml))))
+  (let* ((url (if (string-null? directory)
+                  base-url
+                  (string-append base-url directory "/")))
+         (links (url->links url)))
     (define (file->signature/guess url)
       (let ((base (basename url)))
         (any (lambda (link)
@@ -562,7 +568,6 @@ are unavailable."
     (define candidates
       (filter-map url->release links))
 
-    (close-port port)
     (match candidates
       (() #f)
       ((first . _)