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

pkg/pnr-db: add `get-pkgs-without-modules'

Browse Source 
Also, by default, clear out information for old checksums when
setting a package's information.
This commit is contained in:
Matthew Flatt 2013-04-22 06:59:06 -06:00
parent ccc7438d41
commit 4cc320e49d
2 changed files with 95 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
collects/pkg/pnr-db.rkt
View File

@ -13,15 +13,19 @@
[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?
. -> .
[set-pkg! ((string? string? string? string? string? string?)
(#:clear-other-checksums? boolean?)
. ->* .
void?)]
[get-pkg-modules (string? string? string?
@ -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))

29
collects/pkg/scribblings/pnr-db.scrbl
View File

@ -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[""].}