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

pkg/dirs-catalog added

Browse Source 
This utility that is needed by `make` turns out to be useful in other
scripts.
This commit is contained in:
Matthew Flatt 2014-12-07 11:19:29 -07:00
parent 25023835b9
commit d6b4523336
5 changed files with 224 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@ -99,7 +99,7 @@ error-need-prefix:
LOC_CATALOG = build/local/pkgs-catalog
local-catalog:
"$(DESTDIR)$(PREFIX)/bin/racket" racket/src/pkgs-catalog.rkt $(LOC_CATALOG) pkgs
"$(DESTDIR)$(PREFIX)/bin/racket" -l- pkg/dirs-catalog --check-metadata $(LOC_CATALOG) pkgs
"$(DESTDIR)$(PREFIX)/bin/raco" pkg catalog-copy --force --from-config $(LOC_CATALOG) $(UNIX_CATALOG)
# ------------------------------------------------------------
@ -287,7 +287,7 @@ WIN32_BUNDLE_RACO = bundle\racket\racket $(BUNDLE_RACO_FLAGS)
# ------------------------------------------------------------
# Linking all packages (development mode; not an installer build)
PKGS_CATALOG = -U -G build/config racket/src/pkgs-catalog.rkt --link
PKGS_CATALOG = -U -G build/config -l- pkg/dirs-catalog --link --check-metadata
PKGS_CONFIG = -U -G build/config racket/src/pkgs-config.rkt
pkgs-catalog:

1
pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl
View File

@ -50,3 +50,4 @@ to the @exec{raco pkg} sub-subcommands.
@include-section["path.scrbl"]
@include-section["name.scrbl"]
@include-section["db.scrbl"]
@include-section["dirs-catalog.scrbl"]

59
pkgs/racket-pkgs/racket-doc/pkg/scribblings/dirs-catalog.scrbl Normal file
View File

@ -0,0 +1,59 @@
#lang scribble/manual
@(require "common.rkt"
scribble/bnf
(for-label pkg/dirs-catalog
racket/base
racket/contract/base))
@title[#:tag "dirs-catalog"]{Package Directories Catalog}
@defmodule[pkg/dirs-catalog]{The @racketmodname[pkg/dirs-catalog] module
provides @racket[create-dirs-catalog], which generates a @tech{package
catalog} (as a directory) that refers to a set of packages that are
found in a given set of directories. Packages are discovered in the
given directory as subdirectories that have an @filepath{info.rkt}
file.}
For example, the main Racket development repository includes a
@filepath{pkgs} directory that holds packages such as @pkgname{base},
and @racket[create-dirs-catalog] constructs a catalog to be used to
install those packages.
When run directly as a program, @racketmodname[pkg/dirs-catalog] expects a
destination catalog followed by any number paths for directories that
hold packages:
@commandline{racket -l- pkg/dirs-catalog @nonterm{dest-catalog} @nonterm{dir} ...}
The @DFlag{link}, @DFlag{merge}, @DFlag{check-metadata}, and
@DFlag{quiet} flags correspond to optional keyword arguments of
@racket[create-dirs-catalog].
@history[#:added "6.1.1.6"]
@defproc[(create-dirs-catalog [catalog-path path-string?]
[dirs (listof path-string?)]
[#:link? link? any/c #f]
[#:merge? merge? any/c #f]
[#:check-metadata? check-metadata? any/c #f]
[#:status-printf status-printf (string? any/c ... -> void?) void])
void?]{
Creates or modifies @racket[catalog-path] as a directory that works as
a catalog (see @secref["catalog-protocol"]) to list the packages that
are contained in each directory specified by @racket[dirs]. Packages
are discovered in @racket[dirs] as subdirectories that have an
@filepath{info.rkt} file.
If @racket[link?] is true, then the catalog specifies that the package
should be installed as a directory link, as opposed to copies.
If @racket[merge?] is true, then existing catalog entries in
@racket[catalog-path] are preserved, otherwise old catalog entries are
removed.
To create author and description information for each package in the
catalog, @racket[create-dirs-catalog] looks for a @racket[pkg-authors]
and @racket[pkg-desc] definition in each package's @filepath{info.rkt}
file. If either definition is missing and @racket[check-metadata?] is
true, an error is reported.}

162
racket/collects/pkg/dirs-catalog.rkt Normal file
View File

@ -0,0 +1,162 @@
#lang racket/base
(require racket/cmdline
racket/file
racket/format
racket/string
racket/path
setup/getinfo
pkg/lib)
;; Find packages in a directory tree, where "info.rkt" indicates a
;; package, and create a catalog that points to those packages --- to
;; be installed as links if `--link` is specified.
(provide create-dirs-catalog)
(module+ main
(define link? #f)
(define merge? #f)
(define check-metadata? #f)
(define quiet? #f)
(command-line
#:once-each
["--link" "Install packages as links"
(set! link? #t)]
["--merge" "Preserve existing packages in catalog"
(set! merge? #t)]
["--check-metadata" "Complain if metadata (author and description) is missing"
(set! check-metadata? #t)]
[("--quiet" "-q") "Avoid status printouts"
(set! quiet? #t)]
#:args
(catalog-path . dir)
(create-dirs-catalog catalog-path
;; a list:
dir
#:status-printf (if quiet? void printf)
#:link? link?
#:merge? merge?
#:check-metadata? check-metadata?)))
(define (create-dirs-catalog catalog-path
dirs
#:status-printf [status-printf void]
#:link? [link? #f]
#:merge? [merge? #f]
#:check-metadata? [check-metadata? #f])
;; found: maps each available package name to a directory
(define found (make-hash))
(status-printf "Finding packages\n")
;; Recur through directory tree, and treat each directory
;; that has an "info.rkt" file as a package (and don't recur
;; further into the package)
(for ([src-dir (in-list dirs)])
(when (directory-exists? src-dir)
(let loop ([src-dir src-dir])
(for ([f (in-list (directory-list src-dir))])
(define src-f (build-path src-dir f))
(cond
[(file-exists? (build-path src-f "info.rkt"))
(define f-name (path->string f))
(when (hash-ref found f-name #f)
(error 'pack-local
"found package ~a multiple times: ~a and ~a"
f-name
(hash-ref found f-name)
src-f))
(hash-set! found f-name src-f)]
[(directory-exists? src-f)
(loop src-f)])))))
(unless merge?
(when (directory-exists? (build-path catalog-path "pkg"))
(for ([l (directory-list (build-path catalog-path "pkg"))])
(unless (hash-ref found (path->string l) #f)
(status-printf " Uncataloging package ~a\n" (path->string l))
(delete-directory/files (build-path catalog-path "pkg" l))))))
(define metadata-ns (make-base-namespace))
(define (get-pkg-info pkg-dir)
(get-info/full pkg-dir
#:namespace metadata-ns
#:bootstrap? #t))
(define missing-desc null)
(define missing-authors null)
(define (relative-path->relative-url p)
(apply ~a #:separator "/"
(map (lambda (e)
(case e
[(up) ".."]
[(same) "."]
[else (path-element->string e) e]))
(explode-path p))))
(for ([(pkg-name dir) (in-hash found)])
(define i (get-pkg-info dir))
(define deps
(extract-pkg-dependencies i))
(define desc (i 'pkg-desc (lambda _ #f)))
(unless (string? desc)
(set! missing-desc (cons pkg-name missing-desc)))
(define authors (i 'pkg-authors (lambda _ null)))
(unless (and (list? authors)
((length authors) . >= . 1))
(set! missing-authors (cons pkg-name missing-authors)))
(define pkg
`#hash((name . ,pkg-name)
(source . ,(string-append
(relative-path->relative-url
(find-relative-path (simple-form-path
(path->complete-path catalog-path))
(simple-form-path
(path->complete-path dir))))
(if link?
"?type=static-link"
"")))
(author . ,(string-join (for/list ([r authors])
(if (symbol? r)
(format "~a@racket-lang.org" r)
r))
" "))
(checksum . "")
(description . ,(or desc "???"))
(tags . ())
(dependencies . ,deps)
(modules . ,(pkg-directory->module-paths
dir
pkg-name
#:namespace metadata-ns))))
(define pkg-file (build-path catalog-path "pkg" pkg-name))
(define exists? (file-exists? pkg-file))
(cond
[(and exists?
(equal? (with-handlers ([exn:fail:read? void])
(call-with-input-file* pkg-file read))
pkg))
;; No change
(void)]
[else
(status-printf " ~aataloging package ~a\n"
(if exists? "Rec" "C")
pkg-name)
(make-directory* (build-path catalog-path "pkg"))
(call-with-output-file*
pkg-file
#:exists 'truncate/replace
(lambda (o)
(write pkg o)
(newline o)))]))
(for ([p (in-list missing-desc)])
(status-printf "Missing package description for ~a\n" p))
(for ([p (in-list missing-authors)])
(status-printf "Missing package authors for ~a\n" p))
(when check-metadata?
(unless (and (null? missing-authors) (null? missing-desc))
(error 'link-all "not all packages have description and authors."))))

139
racket/src/pkgs-catalog.rkt
View File

@ -1,139 +0,0 @@
#lang racket/base
(require racket/cmdline
racket/file
racket/format
racket/string
racket/path
setup/getinfo
pkg/lib)
;; Find packages in a directory tree ("info.rkt" indicates a package),
;; create a catalog that points to those packages --- to be installed as
;; links if `--link` is specified.
;; Used by the top-level Makefile in the main Racket repository.
(define link? #f)
(define-values (catalog-path dirs)
(command-line
#:once-each
["--link" "Install packages as links"
(set! link? #t)]
#:args
(catalog-path . dir)
(values catalog-path dir)))
;; found: maps each available package name to a directory
(define found (make-hash))
(printf "Finding packages\n")
;; Recur through directory tree, and treat each directory
;; that has an "info.rkt" file as a package (and don't recur
;; further into the package)
(for ([src-dir (in-list dirs)])
(when (directory-exists? src-dir)
(let loop ([src-dir src-dir])
(for ([f (in-list (directory-list src-dir))])
(define src-f (build-path src-dir f))
(cond
[(file-exists? (build-path src-f "info.rkt"))
(define f-name (path->string f))
(when (hash-ref found f-name #f)
(error 'pack-local
"found package ~a multiple times: ~a and ~a"
f-name
(hash-ref found f-name)
src-f))
(hash-set! found f-name src-f)]
[(directory-exists? src-f)
(loop src-f)])))))
(when (directory-exists? (build-path catalog-path "pkg"))
(for ([l (directory-list (build-path catalog-path "pkg"))])
(unless (hash-ref found (path->string l) #f)
(printf " Uncataloging package ~a\n" (path->string l))
(delete-directory/files (build-path catalog-path "pkg" l)))))
(define metadata-ns (make-base-namespace))
(define (get-pkg-info pkg-dir)
(get-info/full pkg-dir
#:namespace metadata-ns
#:bootstrap? #t))
(define missing-desc null)
(define missing-authors null)
(define (relative-path->relative-url p)
(apply ~a #:separator "/"
(map (lambda (e)
(case e
[(up) ".."]
[(same) "."]
[else (path-element->string e) e]))
(explode-path p))))
(for ([(pkg-name dir) (in-hash found)])
(define i (get-pkg-info dir))
(define deps
(extract-pkg-dependencies i))
(define desc (i 'pkg-desc (lambda _ #f)))
(unless (string? desc)
(set! missing-desc (cons pkg-name missing-desc)))
(define authors (i 'pkg-authors (lambda _ null)))
(unless (and (list? authors)
((length authors) . >= . 1))
(set! missing-authors (cons pkg-name missing-authors)))
(define pkg
`#hash((name . ,pkg-name)
(source . ,(string-append
(relative-path->relative-url
(find-relative-path (simple-form-path
(path->complete-path catalog-path))
(simple-form-path
(path->complete-path dir))))
(if link?
"?type=static-link"
"")))
(author . ,(string-join (for/list ([r authors])
(if (symbol? r)
(format "~a@racket-lang.org" r)
r))
" "))
(checksum . "")
(description . ,(or desc "???"))
(tags . ())
(dependencies . ,deps)
(modules . ,(pkg-directory->module-paths
dir
pkg-name
#:namespace metadata-ns))))
(define pkg-file (build-path catalog-path "pkg" pkg-name))
(define exists? (file-exists? pkg-file))
(cond
[(and exists?
(equal? (with-handlers ([exn:fail:read? void])
(call-with-input-file* pkg-file read))
pkg))
;; No change
(void)]
[else
(printf " ~aataloging package ~a\n"
(if exists? "Rec" "C")
pkg-name)
(make-directory* (build-path catalog-path "pkg"))
(call-with-output-file*
pkg-file
#:exists 'truncate/replace
(lambda (o)
(write pkg o)
(newline o)))]))
(for ([p (in-list missing-desc)])
(printf "Missing package description for ~a\n" p))
(for ([p (in-list missing-authors)])
(printf "Missing package authors for ~a\n" p))
(unless (and (null? missing-authors) (null? missing-desc))
(error 'link-all "not all packages have description and authors."))