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

pkg/lib: add #:package-exn-handler to pkg-catalog-archive

Browse Source
This commit is contained in:
Matthew Flatt 2014-06-30 09:18:38 +01:00
parent 646b836183
commit 22f90ce8fe
2 changed files with 68 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl
View File

@ -368,15 +368,24 @@ for extracting existing catalog information.
[#:from-config? from-config? boolean? #f] [#:from-config? from-config? boolean? #f]
[#:state-catalog state-catalog (or/c #f path-string?) #f] [#:state-catalog state-catalog (or/c #f path-string?) #f]
[#:relative-sources? relative-sources? boolean? #f] [#:relative-sources? relative-sources? boolean? #f]
[#:quiet? quiet? boolean? #f]) [#:quiet? quiet? boolean? #f]
[#:package-exn-handler package-exn-handler (string? exn:fail? . -> . any) (lambda (_pkg-name _exn) (raise _exn))])
void?]{ void?]{
Implements @racket[pkg-catalog-archive-command]. Implements @racket[pkg-catalog-archive-command].
The @racket[package-exn-handler] argument handles any exception that
is raised while trying to archive an individual package; the first
argument is the package name, and the second is the exception. The
default re-@racket[raise]s the exception, which aborts the archiving
process, while a function that logs the exception message and returns
would allow archiving to continue for other packages.
The @racket[current-pkg-lookup-version] parameter determines the version The @racket[current-pkg-lookup-version] parameter determines the version
for extracting existing catalog information. for extracting existing catalog information.
@history[#:added "6.0.1.7"]} @history[#:added "6.0.1.7"
#:changed "6.0.1.13" @elem{Added the @racket[#:package-exn-handler] argument.}]}
@defproc[(pkg-catalog-update-local [#:catalogs catalogs (listof string?) (pkg-config-catalogs)] @defproc[(pkg-catalog-update-local [#:catalogs catalogs (listof string?) (pkg-config-catalogs)]

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

@ -3175,7 +3175,8 @@
#:set-catalogs? [set-catalogs? #t] #:set-catalogs? [set-catalogs? #t]
#:catalog-file [catalog-file (db:current-pkg-catalog-file)] #:catalog-file [catalog-file (db:current-pkg-catalog-file)]
#:quiet? [quiet? #f] #:quiet? [quiet? #f]
#:consult-packages? [consult-packages? #f]) #:consult-packages? [consult-packages? #f]
#:skip-download-failures? [skip-download-failures? #f])
(parameterize ([db:current-pkg-catalog-file catalog-file]) (parameterize ([db:current-pkg-catalog-file catalog-file])
(define current-catalogs (db:get-catalogs)) (define current-catalogs (db:get-catalogs))
(cond (cond
@ -3242,7 +3243,8 @@
#:from-config? [from-config? #f] #:from-config? [from-config? #f]
#:state-catalog [state-catalog #f] #:state-catalog [state-catalog #f]
#:relative-sources? [relative-sources? #f] #:relative-sources? [relative-sources? #f]
#:quiet? [quiet? #f]) #:quiet? [quiet? #f]
#:package-exn-handler [package-exn-handler (lambda (name exn) (raise exn))])
(when (and state-catalog (when (and state-catalog
(not (db-path? (if (path? state-catalog) (not (db-path? (if (path? state-catalog)
state-catalog state-catalog
@ -3281,56 +3283,58 @@
;; Check on each new package: ;; Check on each new package:
(for ([pkg (in-list (sort pkgs string<? #:key db:pkg-name))]) (for ([pkg (in-list (sort pkgs string<? #:key db:pkg-name))])
(define name (db:pkg-name pkg)) (define name (db:pkg-name pkg))
(define current-checksum (and state-catalog (with-handlers ([exn:fail? (lambda (exn)
(parameterize ([db:current-pkg-catalog-file state-catalog]) (package-exn-handler name exn))])
(define l (db:get-pkgs #:name (db:pkg-name pkg))) (define current-checksum (and state-catalog
(and (= 1 (length l)) (parameterize ([db:current-pkg-catalog-file state-catalog])
(db:pkg-checksum (car l)))))) (define l (db:get-pkgs #:name (db:pkg-name pkg)))
(unless (and current-checksum (and (= 1 (length l))
(equal? current-checksum (db:pkg-checksum pkg))) (db:pkg-checksum (car l))))))
(unless quiet? (unless (and current-checksum
(printf/flush "== Archiving ~a ==\nchecksum: ~a\n" (db:pkg-name pkg) (db:pkg-checksum pkg))) (equal? current-checksum (db:pkg-checksum pkg)))
;; Download/unpack existing package: (unless quiet?
(define-values (staged-name staged-dir staged-checksum clean? staged-mods) (printf/flush "== Archiving ~a ==\nchecksum: ~a\n" (db:pkg-name pkg) (db:pkg-checksum pkg)))
(pkg-stage ;; Download/unpack existing package:
(pkg-desc (db:pkg-source pkg) #f (db:pkg-name pkg) (db:pkg-checksum pkg) #f) (define-values (staged-name staged-dir staged-checksum clean? staged-mods)
#:in-place? #t (pkg-stage
#:use-cache? #t (pkg-desc (db:pkg-source pkg) #f (db:pkg-name pkg) (db:pkg-checksum pkg) #f)
#:quiet? quiet?)) #:in-place? #t
(make-directory* (build-path dest-dir "pkgs")) #:use-cache? #t
;; Repack: #:quiet? quiet?))
(pkg-create 'zip (make-directory* (build-path dest-dir "pkgs"))
staged-dir ;; Repack:
#:pkg-name name (pkg-create 'zip
#:dest (build-path dest-dir "pkgs") staged-dir
#:quiet? quiet?) #:pkg-name name
(when clean? (delete-directory/files staged-dir)) #:dest (build-path dest-dir "pkgs")
#:quiet? quiet?)
(when clean? (delete-directory/files staged-dir))
;; Record packed result:
(when state-catalog
(parameterize ([db:current-pkg-catalog-file state-catalog])
(db:set-pkg! name "local"
(db:pkg-author pkg)
(db:pkg-source pkg)
staged-checksum
(db:pkg-desc pkg)))))
;; Record packed result: ;; Record packed result:
(when state-catalog (define pkg-file (build-path dest-dir "pkgs" (format "~a.zip" name)))
(parameterize ([db:current-pkg-catalog-file state-catalog]) (define new-checksum
(db:set-pkg! name "local" (file->string (path-replace-suffix pkg-file #".zip.CHECKSUM")))
(db:pkg-author pkg) (parameterize ([db:current-pkg-catalog-file temp-catalog-file])
(db:pkg-source pkg) (define modules (db:get-pkg-modules name (db:pkg-catalog pkg) (or current-checksum "")))
staged-checksum (define dependencies (db:get-pkg-dependencies name (db:pkg-catalog pkg) (or current-checksum "")))
(db:pkg-desc pkg))))) (db:set-pkg! name (db:pkg-catalog pkg)
;; Record packed result: (db:pkg-author pkg)
(define pkg-file (build-path dest-dir "pkgs" (format "~a.zip" name))) (path->string (path->complete-path pkg-file))
(define new-checksum new-checksum
(file->string (path-replace-suffix pkg-file #".zip.CHECKSUM"))) (db:pkg-desc pkg))
(parameterize ([db:current-pkg-catalog-file temp-catalog-file]) (db:set-pkg-modules! name (db:pkg-catalog pkg)
(define modules (db:get-pkg-modules name (db:pkg-catalog pkg) (or current-checksum ""))) new-checksum
(define dependencies (db:get-pkg-dependencies name (db:pkg-catalog pkg) (or current-checksum ""))) modules)
(db:set-pkg! name (db:pkg-catalog pkg) (db:set-pkg-dependencies! name (db:pkg-catalog pkg)
(db:pkg-author pkg) new-checksum
(path->string (path->complete-path pkg-file)) dependencies))))
new-checksum
(db:pkg-desc pkg))
(db:set-pkg-modules! name (db:pkg-catalog pkg)
new-checksum
modules)
(db:set-pkg-dependencies! name (db:pkg-catalog pkg)
new-checksum
dependencies)))
(define dest-catalog (build-path dest-dir "catalog")) (define dest-catalog (build-path dest-dir "catalog"))
(unless quiet? (unless quiet?
(printf/flush "Creating catalog ~a\n" dest-catalog)) (printf/flush "Creating catalog ~a\n" dest-catalog))
@ -3495,7 +3499,8 @@
(#:from-config? boolean? (#:from-config? boolean?
#:state-catalog (or/c path-string? #f) #:state-catalog (or/c path-string? #f)
#:relative-sources? boolean? #:relative-sources? boolean?
#:quiet? boolean?) #:quiet? boolean?
#:package-exn-handler (string? exn:fail? . -> . any))
void?)] void?)]
[default-pkg-scope [default-pkg-scope
(-> package-scope/c)] (-> package-scope/c)]