raco pkg catalog-archive: add a --pkg-fail option

Relevant to #1032
This commit is contained in:
Matthew Flatt 2015-09-11 16:20:14 -06:00
parent c15d2f71d4
commit c7fac6e98e
2 changed files with 32 additions and 1 deletions

View File

@ -1026,6 +1026,15 @@ for @nonterm{key}.
@item{@DFlag{version} @nonterm{version} or @Flag{v} @nonterm{version} --- Copies catalog
results specific to @nonterm{version}
(for catalogs that make a distinction), instead of the installation's Racket version.}
@item{@DFlag{pkg-fail} @nonterm{mode} --- Determines handling of failure for an individual
package, such as when a @nonterm{src-catalog} contains a bad package source. The
following @nonterm{mode}s are available:
@itemlist[
@item{@exec{fail} (the default) --- archiving stops and fails;}
@item{@exec{skip} --- the package is skipped and omitted from the archive catalog; or}
@item{@exec{continue} --- like @exec{skip}, but @exec{raco pkg catalog-archive}
exits with a status code of @exec{5} if any package was skipped.}
]}
]
@history[#:added "6.0.17"]

View File

@ -581,15 +581,37 @@
[(#:str state-database #f) state () "Read/write <state-database> as state of <dest-dir>"]
[(#:str vers #f) version ("-v") "Copy information suitable for Racket <vers>"]
[#:bool relative () "Make source paths relative when possible"]
[(#:sym mode [fail ignore continue] 'fail) pkg-fail ()
("Select handling of package-download failure;"
"<mode>s: fail (the default), skip, continue (but with exit status of 5)")]
#:args (dest-dir . src-catalog)
(parameterize ([current-pkg-error (pkg-error 'catalog-archive)]
[current-pkg-lookup-version (or version
(current-pkg-lookup-version))])
(define fail-at-end? #f)
(pkg-catalog-archive dest-dir
src-catalog
#:from-config? from-config
#:state-catalog state
#:relative-sources? relative))]
#:relative-sources? relative
#:package-exn-handler (case pkg-fail
[(fail) (lambda (name exn) (raise exn))]
[(skip continue)
(lambda (name exn)
(log-error (~a "archiving failed for package; ~a\n"
" package name: ~a\n"
" original error:\n~a")
(if (eq? pkg-fail 'continue)
"continuing"
"skipping")
name
(regexp-replace* #rx"(?m:^)"
(exn-message exn)
" "))
(when (eq? pkg-fail 'continue)
(set! fail-at-end? #t)))]))
(when fail-at-end?
(exit 5)))]
;; ----------------------------------------
[archive
"Create catalog from installed packages"