From 4cc320e49d6ebc6afbf2288535f0c81cfd4ff865 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 22 Apr 2013 06:59:06 -0600 Subject: [PATCH] pkg/pnr-db: add `get-pkgs-without-modules' Also, by default, clear out information for old checksums when setting a package's information. --- collects/pkg/pnr-db.rkt | 80 +++++++++++++++++++++++---- collects/pkg/scribblings/pnr-db.scrbl | 29 ++++++++-- 2 files changed, 95 insertions(+), 14 deletions(-) diff --git a/collects/pkg/pnr-db.rkt b/collects/pkg/pnr-db.rkt index 16466b54dd..0d7b22fa14 100644 --- a/collects/pkg/pnr-db.rkt +++ b/collects/pkg/pnr-db.rkt @@ -13,16 +13,20 @@ [get-indexes (-> (listof string?))] [set-indexes! ((listof string?) . -> . void?)] - [set-pkgs! (string? (listof (or/c pkg? string?)) . -> . void?)] + [set-pkgs! ((string? (listof (or/c pkg? string?))) + (#:clear-other-checksums? boolean?) + . ->* . + void?)] [get-pkgs (() (#:name (or/c #f string?) #:index (or/c #f string?)) . ->* . (listof pkg?))] - [set-pkg! (string? string? string? string? string? string? - . -> . - void?)] + [set-pkg! ((string? string? string? string? string? string?) + (#:clear-other-checksums? boolean?) + . ->* . + void?)] [get-pkg-modules (string? string? string? . -> . (listof module-path?))] @@ -35,7 +39,12 @@ [set-pkg-tags! (string? string? (listof string?) . -> . void?)] - [get-module-pkgs (module-path? . -> . pkg?)])) + [get-module-pkgs (module-path? . -> . pkg?)] + + [get-pkgs-without-modules (() + (#:index string?) + . ->* . + (listof pkg?))])) (struct pkg (name index author source checksum desc) #:transparent) @@ -124,7 +133,8 @@ (vector-ref row 4) (vector-ref row 5)))))) -(define (set-pkg! name index author source checksum desc) +(define (set-pkg! name index author source checksum desc + #:clear-other-checksums? [clear-other-checksums? (not (equal? checksum ""))]) (call-with-pnr-db (lambda (db) (prepare-pnr-table db) @@ -140,6 +150,13 @@ " AND pnr=$6") author source checksum desc name pnr) + (when clear-other-checksums? + (query-exec db + (~a "DELETE FROM modules" + " WHERE pnr=$1 AND pkg=$2 AND checksum<>$3") + pnr + name + checksum)) (void)))))) (define (get-pkg-tags name index) @@ -241,6 +258,40 @@ (define (mod->string mp) (~s mp)) (define (string->mod str) (read (open-input-string str))) +(define (get-pkgs-without-modules #:index [index #f]) + (call-with-pnr-db + (lambda (db) + (prepare-pnr-table db) + (prepare-pkg-table db) + (prepare-modules-table db) + (define rows + (apply + query-rows + db + (~a "SELECT K.name, N.url, K.checksum" + " FROM pkg K, pnr N" + " WHERE N.id = K.pnr" + (if index + " AND N.url = $1" + "") + " AND NOT EXISTS" + " (SELECT M.name" + " FROM modules M" + " WHERE M.pkg = K.name" + " AND M.pnr = K.pnr" + " AND M.checksum = K.checksum)") + (append + (if index + (list index) + null)))) + (for/list ([row (in-list rows)]) + (pkg (vector-ref row 0) + (vector-ref row 1) + "" + "" + (vector-ref row 2) + ""))))) + (define (get-indexes) (call-with-pnr-db (lambda (db) @@ -301,7 +352,8 @@ "SELECT id FROM pnr WHERE url=$1" url)) -(define (set-pkgs! url pkgs) +(define (set-pkgs! url pkgs + #:clear-other-checksums? [clear-other-checksums? #t]) (call-with-pnr-db (lambda (db) (prepare-pnr-table db) @@ -323,21 +375,29 @@ (for ([old (in-list current-pkgs)]) (unless (set-member? new-pkgs old) (query-exec db - "DELETE FROM pkg WHERE pnr=$1, name=$2" + "DELETE FROM pkg WHERE pnr=$1 AND name=$2" pnr old) (query-exec db - "DELETE FROM tags WHERE pnr=$1, pkg=$2" + "DELETE FROM tags WHERE pnr=$1 AND pkg=$2" pnr old) (query-exec db - "DELETE FROM modules WHERE pnr=$1, pkg=$2" + "DELETE FROM modules WHERE pnr=$1 AND pkg=$2" pnr old))) (for ([new0 (in-list pkgs)]) (define new (if (pkg? new0) new0 (pkg new0 "" "" "" "" ""))) + (when (and clear-other-checksums? + (not (equal? "" (pkg-checksum new)))) + (query-exec db + (~a "DELETE FROM modules" + " WHERE pnr=$1 AND pkg=$2 AND checksum<>$3") + pnr + (pkg-name new) + (pkg-checksum new))) (unless (and (string? new0) (set-member? old-pkgs new0)) (if (set-member? old-pkgs (pkg-name new)) diff --git a/collects/pkg/scribblings/pnr-db.scrbl b/collects/pkg/scribblings/pnr-db.scrbl index ccb26691bf..f24a1db292 100644 --- a/collects/pkg/scribblings/pnr-db.scrbl +++ b/collects/pkg/scribblings/pnr-db.scrbl @@ -69,7 +69,8 @@ The result list is ordered by precedence of the @tech{package name resolver}.} -@defproc[(set-pkgs! [index string?] [pkgs (listof (or/c string? pkg?))]) +@defproc[(set-pkgs! [index string?] [pkgs (listof (or/c string? pkg?))] + [#:clear-other-checksums? clear-other-checksums? #t]) void?]{ Sets the list of all packages that are recognized by the @@ -79,7 +80,12 @@ Information about any other package for @racket[index] is removed from the database. If a string is provided for @racket[pkgs], it is treated as a package name; if additional information is already recorded in the database for the package name, then the additional -information is preserved.} +information is preserved. + +If @racket[clear-other-checksums?] is true, then for each element of +@racket[pkgs] that has a given checksum other than @racket[""], any +information in the database specific to another checksum (such as a +list of module paths) is removed from the database.} @defproc[(set-pkg! [name string?] @@ -87,11 +93,16 @@ information is preserved.} [author string?] [source string?] [checksum string?] - [desc string?]) + [desc string?] + [#:clear-other-checksums? clear-other-checksums? (not (equal? checksum ""))]) void?]{ Sets the information for a specific package @racket[name] as -recognized by the @tech{package name resolver} @racket[index].} +recognized by the @tech{package name resolver} @racket[index]. + +If @racket[clear-other-checksums?] is true, then information (such as +a list of module paths) is removed from the database when it is +specific to a checksum other than @racket[checksum].} @deftogether[( @@ -118,3 +129,13 @@ Gets or sets a list of tags for the package Gets or sets a list of module paths that are provided for the package @racket[name] as recognized by the @tech{package name resolver} @racket[index] and for a specific @tech{checksum}.} + + +@defproc[(get-pkgs-without-modules [#:index index (or/c #f string?) #f]) + (listof pkg?)]{ + +Returns a list of packages (optionally constrained to @racket[index]) +for which the database has no modules recorded. + +Each resulting @racket[pkg] has its @racket[name], @racketidfont{index}, and +@racket[checksum] field set, but other fields may be @racket[""].}