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,18 +2720,7 @@
#:quiet? quiet? #:quiet? quiet?
#:from-command-line? from-command-line?)])) #:from-command-line? from-command-line?)]))
(define (pkg-catalog-copy srcs dest (define (src->url-or-path src)
#:from-config? [from-config? #f]
#:merge? [merge? #f]
#:force? [force? #f]
#:override? [override? #f]
#:relative-sources? [relative-sources? #f])
(define src-paths
(for/list ([src (in-list (append srcs
(if from-config?
(pkg-config-catalogs)
null)))])
(define src-path
(cond (cond
[(path? src) (path->complete-path src)] [(path? src) (path->complete-path src)]
[(regexp-match? #rx"^https?://" src) [(regexp-match? #rx"^https?://" src)
@ -2743,6 +2732,24 @@
" URL: ~a") " URL: ~a")
src)] src)]
[else (path->complete-path 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
#:from-config? [from-config? #f]
#:merge? [merge? #f]
#:force? [force? #f]
#:override? [override? #f]
#:relative-sources? [relative-sources? #f])
(define src-paths
(for/list ([src (in-list (append srcs
(if from-config?
(pkg-config-catalogs)
null)))])
(define src-path (src->url-or-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))