ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-27 14:52:05 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu-maintenance: Extract url->links procedure.

Browse source 
* guix/gnu-maintenance.scm (url->links): New procedure.
(import-html-release): Use it.
This commit is contained in:
Maxim Cournoyer 2023-08-09 22:40:01 -04:00
parent 610d0e30e0
commit f6cfc993ac
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 12 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
guix/gnu-maintenance.scm
View file

@ -483,6 +483,14 @@ (define (html-links sxml)
(_
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 @@ (define* (import-html-release base-url package
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)
(let* ((url (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))))
(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 @@ (define (url->release url)
(define candidates
(filter-map url->release links))
(close-port port)
(match candidates
(() #f)
((first . _)