suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco pkg catalog-archive: parse sources like catalog-copy

Browse Source
This commit is contained in:
Matthew Flatt 2014-05-29 11:45:42 +01:00
parent 11aca05fb5
commit ab4172fbf2
1 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
racket/collects/pkg/lib.rkt
View File

@ -2720,6 +2720,24 @@
#:quiet? quiet? #:quiet? quiet?
#:from-command-line? from-command-line?)])) #:from-command-line? from-command-line?)]))
(define (src->url-or-path src)
(cond
[(path? src) (path->complete-path src)]
[(regexp-match? #rx"^https?://" src)
(string->url src)]
[(regexp-match? #rx"^file://" src)
(url->path (string->url src))]
[(regexp-match? #rx"^[a-zA-Z]*://" src)
(pkg-error (~a "unrecognized URL scheme for a catalog\n"
" URL: ~a")
src)]
[else (path->complete-path src)]))
(define (url-or-path->url-string p)
(url->string (if (url? p)
p
(path->url p))))
(define (pkg-catalog-copy srcs dest (define (pkg-catalog-copy srcs dest
#:from-config? [from-config? #f] #:from-config? [from-config? #f]
#:merge? [merge? #f] #:merge? [merge? #f]
@ -2731,18 +2749,7 @@
(if from-config? (if from-config?
(pkg-config-catalogs) (pkg-config-catalogs)
null)))]) null)))])
(define src-path (define src-path (src->url-or-path src))
(cond
[(path? src) (path->complete-path src)]
[(regexp-match? #rx"^https?://" src)
(string->url src)]
[(regexp-match? #rx"^file://" src)
(url->path (string->url src))]
[(regexp-match? #rx"^[a-zA-Z]*://" src)
(pkg-error (~a "unrecognized URL scheme for a catalog\n"
" URL: ~a")
src)]
[else (path->complete-path src)]))
(when (path? src-path) (when (path? src-path)
(cond (cond
[(db-path? src-path) [(db-path? src-path)
@ -3205,7 +3212,8 @@
state-catalog)) state-catalog))
;; Take a snapshot of the source catalog: ;; Take a snapshot of the source catalog:
(define temp-catalog-file (make-temporary-file "pkg~a.sqlite")) (define temp-catalog-file (make-temporary-file "pkg~a.sqlite"))
(pkg-catalog-update-local #:catalogs (append src-catalogs (pkg-catalog-update-local #:catalogs (append (map url-or-path->url-string
(map src->url-or-path src-catalogs))
(if from-config? (if from-config?
(pkg-config-catalogs) (pkg-config-catalogs)
null)) null))