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

raco pkg update: add --skip-uninstalled flag

Browse Source
This commit is contained in:
Matthew Flatt 2015-02-17 15:43:15 -07:00
parent cc621124c1
commit b37eab0621
7 changed files with 108 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -299,7 +299,8 @@ The package lock must be held; see @racket[with-pkg-lock].
[#:force? force? boolean? #f] [#:force? force? boolean? #f]
[#:ignore-checksums? ignore-checksums? boolean? #f] [#:ignore-checksums? ignore-checksums? boolean? #f]
[#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f] [#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f]
[#:use-cache? use-cache? quiet? #t] [#:use-cache? use-cache? boolean? #t]
[#:skip-uninstalled? skip-uninstalled? boolean? #t]
[#:quiet? quiet? boolean? #f] [#:quiet? quiet? boolean? #f]
[#:use-trash? boolean? use-trash? #f] [#:use-trash? boolean? use-trash? #f]
[#:from-command-line? from-command-line? boolean? #f] [#:from-command-line? from-command-line? boolean? #f]
@ -344,7 +345,7 @@ The package lock must be held; see @racket[with-pkg-lock].
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode] @history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode]
and @racket[#:infer-clone-from-dir?] arguments.} and @racket[#:infer-clone-from-dir?] arguments.}
#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.} #:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}
#:changed "6.1.1.8" @elem{Added the @racket[#:pull-mode] argument.}]} #:changed "6.1.1.8" @elem{Added the @racket[#:skip-uninstalled?] and @racket[#:pull-mode] arguments.}]}
@defproc[(pkg-remove [names (listof string?)] @defproc[(pkg-remove [names (listof string?)]

3
pkgs/racket-doc/pkg/scribblings/pkg.scrbl
View File

@ -701,6 +701,7 @@ the given @nonterm{pkg-source}s.
@item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.} @item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.}
@item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.} @item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.}
@item{@DFlag{catalog} @nonterm{catalog} --- Same as for @command-ref{install}.} @item{@DFlag{catalog} @nonterm{catalog} --- Same as for @command-ref{install}.}
@item{@DFlag{skip-uninstalled} --- Ignores any @nonterm{pkg-source} that does not correspond to an installed package.}
@item{@DFlag{all-platforms} --- Same as for @command-ref{install}.} @item{@DFlag{all-platforms} --- Same as for @command-ref{install}.}
@item{@DFlag{force} --- Same as for @command-ref{install}.} @item{@DFlag{force} --- Same as for @command-ref{install}.}
@item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.} @item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.}
@ -726,7 +727,7 @@ the given @nonterm{pkg-source}s.
when no arguments are provided.} when no arguments are provided.}
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag, and changed #:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag, and changed
the @DFlag{deps} default to depend only on interactive mode.} the @DFlag{deps} default to depend only on interactive mode.}
#:changed "6.1.1.8" @elem{Added the @DFlag{pull} flag.}]} #:changed "6.1.1.8" @elem{Added the @DFlag{skip-uninstalled} and @DFlag{pull} flags.}]}
@subcommand{@command/toc{remove} @nonterm{option} ... @nonterm{pkg} ... @subcommand{@command/toc{remove} @nonterm{option} ... @nonterm{pkg} ...
--- Attempts to remove the given packages. By default, if a package is the dependency --- Attempts to remove the given packages. By default, if a package is the dependency

2
pkgs/racket-test/tests/pkg/tests-update.rkt
View File

@ -26,6 +26,8 @@
(shelly-install "local packages can't be updated (file)" (shelly-install "local packages can't be updated (file)"
"test-pkgs/pkg-test1.zip" "test-pkgs/pkg-test1.zip"
$ "raco pkg update pkg-test1" =exit> 1) $ "raco pkg update pkg-test1" =exit> 1)
(shelly-case "update of uninstalled with --skip-uninstalled"
$ "raco pkg update --skip-uninstalled nosuchpackage")
(define tmp-dir (path->directory-path (make-temporary-file "pkg~a" 'directory))) (define tmp-dir (path->directory-path (make-temporary-file "pkg~a" 'directory)))
(shelly-wind (shelly-wind

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

@ -109,6 +109,7 @@
#:force? boolean? #:force? boolean?
#:ignore-checksums? boolean? #:ignore-checksums? boolean?
#:strict-doc-conflicts? boolean? #:strict-doc-conflicts? boolean?
#:skip-uninstalled? boolean?
#:use-cache? boolean? #:use-cache? boolean?
#:strip (or/c #f 'source 'binary 'binary-lib) #:strip (or/c #f 'source 'binary 'binary-lib)
#:force-strip? boolean? #:force-strip? boolean?

5
racket/collects/pkg/main.rkt
View File

@ -86,7 +86,8 @@
msg s)))])) msg s)))]))
(define scope (find-pkg-installation-scope pkg-name)) (define scope (find-pkg-installation-scope pkg-name))
(cond (cond
[(not prev-pkg) (values pkg scope)] [(or (not prev-pkg) (not prev-scope)) (values pkg scope)]
[(not scope) (values prev-pkg prev-scope)]
[(equal? scope prev-scope) (values prev-pkg prev-scope)] [(equal? scope prev-scope) (values prev-pkg prev-scope)]
[else [else
((current-pkg-error) ((current-pkg-error)
@ -292,6 +293,7 @@
scope-flags ... scope-flags ...
#:once-each #:once-each
catalog-flags ... catalog-flags ...
[#:bool skip-uninstalled () ("Skip a given <pkg-source> if not installed")]
install-force-flags ... install-force-flags ...
install-clone-flags ... install-clone-flags ...
job-flags ... job-flags ...
@ -350,6 +352,7 @@
#:ignore-checksums? ignore-checksums #:ignore-checksums? ignore-checksums
#:strict-doc-conflicts? strict-doc-conflicts #:strict-doc-conflicts? strict-doc-conflicts
#:use-cache? (not no-cache) #:use-cache? (not no-cache)
#:skip-uninstalled? skip-uninstalled
#:update-deps? (or update-deps auto) #:update-deps? (or update-deps auto)
#:update-implies? (not ignore-implies) #:update-implies? (not ignore-implies)
#:strip (or (and source 'source) #:strip (or (and source 'source)

74
racket/collects/pkg/private/clone-path.rkt
View File

@ -264,7 +264,10 @@
;; If `pkg-name` is a description with the type 'clone, but its syntax ;; If `pkg-name` is a description with the type 'clone, but its syntax
;; matches a package name, then infer a repo from the current package ;; matches a package name, then infer a repo from the current package
;; installation and return an alternate description. ;; installation and return an alternate description.
(define ((convert-clone-name-to-clone-repo/update db from-command-line?) pkg-name) (define ((convert-clone-name-to-clone-repo/update db
skip-uninstalled?
from-command-line?)
pkg-name)
(cond (cond
[(and (pkg-desc? pkg-name) [(and (pkg-desc? pkg-name)
(eq? 'clone (pkg-desc-type pkg-name)) (eq? 'clone (pkg-desc-type pkg-name))
@ -272,39 +275,40 @@
name)) name))
=> (lambda (name) => (lambda (name)
;; Infer or complain ;; Infer or complain
(define info (package-info name #:db db)) (define info (package-info name #:db db (not skip-uninstalled?)))
(unless info (cond
(pkg-error (~a "package is not currently installed\n" [(not info)
" package: ~a") ;; Skipping uninstalled packages
name)) #f]
(define new-pkg-name [else
(pkg-info->clone-desc name info (define new-pkg-name
#:checksum (pkg-desc-checksum pkg-name) (pkg-info->clone-desc name info
#:auto? (pkg-desc-auto? pkg-name) #:checksum (pkg-desc-checksum pkg-name)
#:extra-path (pkg-desc-extra-path pkg-name) #:auto? (pkg-desc-auto? pkg-name)
#:reject-existing-clone? #t)) #:extra-path (pkg-desc-extra-path pkg-name)
(define current-orig-pkg (pkg-info-orig-pkg info)) #:reject-existing-clone? #t))
(unless new-pkg-name (define current-orig-pkg (pkg-info-orig-pkg info))
(pkg-error (~a "package is not currently installed from a repository\n" (unless new-pkg-name
" package: ~a\n" (pkg-error (~a "package is not currently installed from a repository\n"
" current installation: ~a" " package: ~a\n"
(cond " current installation: ~a"
[from-command-line? (cond
(case (car current-orig-pkg) [from-command-line?
[(link static-link) (case (car current-orig-pkg)
(~a "\n extra advice:\n" [(link static-link)
" Your current installation is a directory link, and the directory might\n" (~a "\n extra advice:\n"
" be a Git repostory checkout, but the package system doesn't know that.\n" " Your current installation is a directory link, and the directory might\n"
" If so, try\n" " be a Git repostory checkout, but the package system doesn't know that.\n"
" cd " (simplify-path " If so, try\n"
(path->complete-path (cadr current-orig-pkg) (pkg-installed-dir))) " cd " (simplify-path
"\n" (path->complete-path (cadr current-orig-pkg) (pkg-installed-dir)))
" raco pkg update --clone . <repository-URL>")] "\n"
[else ""])] " raco pkg update --clone . <repository-URL>")]
[else ""])) [else ""])]
name [else ""]))
current-orig-pkg)) name
new-pkg-name)] current-orig-pkg))
new-pkg-name]))]
[else pkg-name])) [else pkg-name]))
(define ((convert-directory-to-installed-clone db) d) (define ((convert-directory-to-installed-clone db) d)
@ -317,7 +321,7 @@
(case type (case type
[(dir) [(dir)
(define pkg-name (or (pkg-desc-name d) name)) (define pkg-name (or (pkg-desc-name d) name))
(define info (package-info pkg-name #:db db)) (define info (package-info pkg-name #:db db #f))
(case (and info (case (and info
(car (pkg-info-orig-pkg info))) (car (pkg-info-orig-pkg info)))
[(clone) [(clone)

100
racket/collects/pkg/private/install.rkt
View File

@ -966,6 +966,7 @@
#:use-cache? use-cache? #:use-cache? use-cache?
#:from-command-line? from-command-line? #:from-command-line? from-command-line?
#:link-dirs? link-dirs? #:link-dirs? link-dirs?
#:skip-uninstalled? [skip-uninstalled? #f]
#:all-mode? [all-mode? #f] #:all-mode? [all-mode? #f]
#:force-update? [force-update? #f]) #:force-update? [force-update? #f])
pkg-name) pkg-name)
@ -985,58 +986,64 @@
(define name (or (pkg-desc-name pkg-name) (define name (or (pkg-desc-name pkg-name)
inferred-name)) inferred-name))
;; Check that the package is installed, and get current checksum: ;; Check that the package is installed, and get current checksum:
(define info (package-info name #:db db)) (define info (package-info name #:db db (not skip-uninstalled?)))
(define new-checksum (checksum-for-pkg-source (pkg-desc-source pkg-name) (cond
type [(not info)
name ;; Not installed, and we're skipping uninstalled
(pkg-desc-checksum pkg-name) null]
download-printf [else
#:catalog-lookup-cache catalog-lookup-cache (define new-checksum (checksum-for-pkg-source (pkg-desc-source pkg-name)
#:remote-checksum-cache remote-checksum-cache)) type
(hash-set! update-cache name new-checksum) ; record downloaded checksum name
(unless (or ignore-checksums? (not (pkg-desc-checksum pkg-name))) (pkg-desc-checksum pkg-name)
(unless (equal? (pkg-desc-checksum pkg-name) new-checksum) download-printf
(pkg-error (~a "incorrect checksum on package\n" #:catalog-lookup-cache catalog-lookup-cache
" package source: ~a\n" #:remote-checksum-cache remote-checksum-cache))
" expected: ~e\n" (hash-set! update-cache name new-checksum) ; record downloaded checksum
" got: ~e") (unless (or ignore-checksums? (not (pkg-desc-checksum pkg-name)))
(pkg-desc-source pkg-name) (unless (equal? (pkg-desc-checksum pkg-name) new-checksum)
(pkg-desc-checksum pkg-name) (pkg-error (~a "incorrect checksum on package\n"
new-checksum))) " package source: ~a\n"
" expected: ~e\n"
" got: ~e")
(pkg-desc-source pkg-name)
(pkg-desc-checksum pkg-name)
new-checksum)))
(if (or force-update? (if (or force-update?
(not (equal? (pkg-info-checksum info) (not (equal? (pkg-info-checksum info)
new-checksum)) new-checksum))
;; No checksum available => always update ;; No checksum available => always update
(not new-checksum) (not new-checksum)
;; Different source => always update ;; Different source => always update
(not (same-orig-pkg? (pkg-info-orig-pkg info) (not (same-orig-pkg? (pkg-info-orig-pkg info)
(desc->orig-pkg type (desc->orig-pkg type
(pkg-desc-source pkg-name) (pkg-desc-source pkg-name)
(pkg-desc-extra-path pkg-name))))) (pkg-desc-extra-path pkg-name)))))
;; Update: ;; Update:
(begin (begin
(hash-set! update-cache (box name) #t) (hash-set! update-cache (box name) #t)
(list (pkg-desc (pkg-desc-source pkg-name) (list (pkg-desc (pkg-desc-source pkg-name)
(pkg-desc-type pkg-name) (pkg-desc-type pkg-name)
name name
(pkg-desc-checksum pkg-name) (pkg-desc-checksum pkg-name)
(pkg-desc-auto? pkg-name) (pkg-desc-auto? pkg-name)
(or (pkg-desc-extra-path pkg-name) (or (pkg-desc-extra-path pkg-name)
(and (eq? type 'clone) (and (eq? type 'clone)
(current-directory)))))) (current-directory))))))
;; No update needed, but maybe check dependencies: ;; No update needed, but maybe check dependencies:
(if (or deps? (if (or deps?
implies?) implies?)
(update-loop name #f #f #f) (update-loop name #f #f #f)
null))] null))])]
[(hash-ref update-cache (box pkg-name) #f) [(hash-ref update-cache (box pkg-name) #f)
;; package is already being updated ;; package is already being updated
null] null]
;; A string indicates that package source that should be ;; A string indicates that package source that should be
;; looked up in the installed packages to get the old source ;; looked up in the installed packages to get the old source
;; for getting the checksum: ;; for getting the checksum:
[(package-info pkg-name #:db db must-update?) [(package-info pkg-name #:db db (and must-update?
(not skip-uninstalled?)))
=> =>
(lambda (info) (lambda (info)
(match-define (pkg-info orig-pkg checksum auto?) info) (match-define (pkg-info orig-pkg checksum auto?) info)
@ -1150,6 +1157,7 @@
#:force? [force? #f] #:force? [force? #f]
#:ignore-checksums? [ignore-checksums? #f] #:ignore-checksums? [ignore-checksums? #f]
#:strict-doc-conflicts? [strict-doc-conflicts? #f] #:strict-doc-conflicts? [strict-doc-conflicts? #f]
#:skip-uninstalled? [skip-uninstalled? #f]
#:use-cache? [use-cache? #t] #:use-cache? [use-cache? #t]
#:update-deps? [update-deps? #f] #:update-deps? [update-deps? #f]
#:update-implies? [update-implies? #t] #:update-implies? [update-implies? #t]
@ -1187,6 +1195,7 @@
#:ignore-checksums? ignore-checksums? #:ignore-checksums? ignore-checksums?
#:use-cache? use-cache? #:use-cache? use-cache?
#:from-command-line? from-command-line? #:from-command-line? from-command-line?
#:skip-uninstalled? skip-uninstalled?
#:link-dirs? link-dirs? #:link-dirs? link-dirs?
#:all-mode? all-mode?) #:all-mode? all-mode?)
(map (compose (map (compose
@ -1197,6 +1206,7 @@
(convert-clone-name-to-clone-repo/install catalog-lookup-cache (convert-clone-name-to-clone-repo/install catalog-lookup-cache
download-printf) download-printf)
(convert-clone-name-to-clone-repo/update db (convert-clone-name-to-clone-repo/update db
skip-uninstalled?
from-command-line?))) from-command-line?)))
pkgs))) pkgs)))
(cond (cond