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

A bug fix, an error-message improvement, and new docs.

Browse Source 
svn: r1947
This commit is contained in:
Jacob Matthews 2006-01-24 20:15:37 +00:00
parent 114a4dab65
commit 879307289b
3 changed files with 97 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
collects/planet/doc.txt
View File

@ -42,6 +42,15 @@ VER-SPEC is provided, the most recent version is assumed. If no
owner-name/path ... clause is provided, the default package is
assumed.
For example,
(require (planet "test-connection.ss" ("planet" "test-connection.plt" 1 0)))
requires the file "test-connection.ss" from the package owned by
"planet" called "test-connection.plt", and says that any package with
major version 1 and any minor version greater than or equal to 0 will
do.
_config.ss_: client configuration
This file provides several parameters useful for configuring how
@ -147,6 +156,25 @@ numbers and major-version must be greater than zero.
Removes the entire linkage table from the system, which will force all
modules to relink themselves to PLaneT modules the next time they run.
> (add-hard-link owner name major-version minor-version directory) -> void
Adds a development link between the specified package and the given
directory; once a link is established, PLaneT will treat the cache as
having a package with the given owner, name, and version whose files
are located in the given path. This is intended for package
development; users only interested in using PLaneT packages
available online should not need to create any development links.
owner and name must be strings, major-version and minor-version must
be natural numbers, and directory must be a path (not a string)
indicating a directory.
If the specified package already has a development link, this function
first removes the old link and then adds the new one.
> (remove-hard-link owner name major-version minor-version) -> void
Removes any hard link that may be associated with the given package.
_The PLaneT search order_
-------------------------
@ -365,13 +393,25 @@ the name (without path) of the main Scheme source file of your
package. PLaneT will direct casual users of your library to require
this file.
The _'required-core-version field_
If present, the required-core-version field should be a string with
the same syntax as the output of mzscheme's built-in (version)
function. Defining this field indicates that PLaneT should only allow
users of a version of mzscheme equal to or more recent than the
version specified by this field. This allows you finer-grained control
of your package's core-language requirements than its inclusion in a
particular repository; for instance, setting this field to "300.2"
would cause the PLaneT server not to serve it to MzScheme v300
clients.
The _'version field_
If present, the version field should describe the version number
of this code that should be presented to users (e.g., "0.15 alpha").
This field does not override or in any way interact with your package's
package version number, which is assigned by PLaneT, but may be useful
to users.
If present, the version field should describe the version number of
this code that should be presented to users (e.g., "0.15 alpha").
This field does not override or in any way interact with your
package's package version number, which is assigned by PLaneT, but may
be useful to users.
In addition, PLaneT uses the setup-plt installer to install packages

86
collects/planet/private/planet-shared.ss
View File

@ -22,7 +22,7 @@ Various common pieces of code that both the client and server need to access
; CACHE LOGIC
; Handles checking the cache for an appropriate module
; ==========================================================================================
; language-version->repository : string -> string | #f
; finds the appropriate language version for the given repository
(define (language-version->repository ver)
@ -93,8 +93,8 @@ Various common pieces of code that both the client and server need to access
(tree-apply
tree-stuff->row-or-false
(directory->tree path (λ (x) #t) 2 (λ (x) x))))
empty-table))
empty-table))
; the link table format:
; (listof (list string[name] (listof string[path]) num num bytes[directory])
@ -125,7 +125,7 @@ Various common pieces of code that both the client and server need to access
(lambda (item) (update-element 4 bytes->path item))
(with-input-from-file (HARD-LINK-FILE) read-all))
'()))
;; row-for-package? : row string (listof string) num num -> boolean
;; determines if the row associates the given package with a dir
(define (points-to? row name path maj min)
@ -164,14 +164,14 @@ Various common pieces of code that both the client and server need to access
;; removes all rows from the link table that don't match the given predicate
(define (filter-link-table! f)
(save-hard-link-table (filter f (get-hard-link-table))))
;; update-element : number (x -> y) (listof any [x in position number]) -> (listof any [y in position number])
(define (update-element n f l)
(cond
[(null? l) (error 'update-element "Index too large")]
[(zero? n) (cons (f (car l)) (cdr l))]
[else (cons (car l) (update-element (sub1 n) f (cdr l)))]))
; add-to-table assoc-table (listof assoc-table-row) -> assoc-table
(define add-to-table append)
@ -198,7 +198,7 @@ Various common pieces of code that both the client and server need to access
(list name path maj min dir required-version))
(define-struct mz-version (major minor))
;; string->mz-version : string -> mz-version | #f
(define (string->mz-version str)
(let ((ver (regexp-match #rx"^([0-9]+)(\\.([0-9]+))?$" str)))
@ -218,7 +218,7 @@ Various common pieces of code that both the client and server need to access
(or (<= (mz-version-major a) (mz-version-major b))
(and (= (mz-version-major a) (mz-version-major b))
(<= (mz-version-minor a) (mz-version-minor b)))))
;; compatible-version? : assoc-table-row FULL-PKG-SPEC -> boolean
;; determines if the given package constrint verstr can support the given package
(define (compatible-version? row spec)
@ -229,39 +229,41 @@ Various common pieces of code that both the client and server need to access
(or (not required)
(not provided)
(version<= required provided))))))
; get-best-match : assoc-table FULL-PKG-SPEC -> PKG | #f
; return the best on-disk match for the given package spec
(define (get-best-match table spec)
(let* ((target-maj
(or (pkg-spec-maj spec)
(apply max (map assoc-table-row->maj table))))
(lo (pkg-spec-minor-lo spec))
(hi (pkg-spec-minor-hi spec))
(matches
(filter
(λ (x)
(let ((n (assoc-table-row->min x)))
(and
(equal? target-maj (assoc-table-row->maj x))
(or (not lo) (>= n lo))
(or (not hi) (<= n hi))
(compatible-version? x spec))))
table)))
(if (null? matches)
#f
(let ((best-row
(car
(quicksort
matches
(λ (a b) (> (assoc-table-row->min a) (assoc-table-row->min b)))))))
(make-pkg
(pkg-spec-name spec)
(pkg-spec-path spec)
(assoc-table-row->maj best-row)
(assoc-table-row->min best-row)
(assoc-table-row->dir best-row))))))
(if (null? table)
#f
(let* ((target-maj
(or (pkg-spec-maj spec)
(apply max (map assoc-table-row->maj table))))
(lo (pkg-spec-minor-lo spec))
(hi (pkg-spec-minor-hi spec))
(matches
(filter
(λ (x)
(let ((n (assoc-table-row->min x)))
(and
(equal? target-maj (assoc-table-row->maj x))
(or (not lo) (>= n lo))
(or (not hi) (<= n hi))
(compatible-version? x spec))))
table)))
(if (null? matches)
#f
(let ((best-row
(car
(quicksort
matches
(λ (a b) (> (assoc-table-row->min a) (assoc-table-row->min b)))))))
(make-pkg
(pkg-spec-name spec)
(pkg-spec-path spec)
(assoc-table-row->maj best-row)
(assoc-table-row->min best-row)
(assoc-table-row->dir best-row)))))))
; FULL-PKG-SPEC : (make-pkg-spec string (Nat | #f) (Nat | #f) (Nat | #f) (listof string) (syntax | #f)) string
(define-struct pkg-spec (name maj minor-lo minor-hi path stx core-version) (make-inspector))
; PKG : string Nat Nat path
@ -295,8 +297,8 @@ Various common pieces of code that both the client and server need to access
(begin
(set! to-read (- to-read bytes-read))
bytes-read)))]))
#f
void))))
#f
void))))
; write-line : X output-port -> void
; writes the given value followed by a newline to the given port
@ -364,7 +366,7 @@ Various common pieces of code that both the client and server need to access
(hash-table-put! ht key (cons i (hash-table-get ht key (lambda () '()))))))
l)
(hash-table-map ht cons)))
(define (drop-last l) (reverse (cdr (reverse l))))
;; note: this can be done faster by reading a copy-port'ed port with
@ -418,7 +420,7 @@ Various common pieces of code that both the client and server need to access
'()
(let ((next-depth (if max-depth (sub1 max-depth) #f)))
(map (lambda (d) (directory->tree d valid-dir? next-depth)) files))))))))
;; filter-pattern : (listof pattern-term)
;; pattern-term : (x -> y) | (make-star (tst -> bool) (x -> y))
(define-struct star (pred fun))

8
collects/planet/resolver.ss
View File

@ -471,6 +471,14 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
(list #f (format "Server had no matching package: ~a" (read-line ip)))]
[(400)
(abort (format "Internal error (malformed request): ~a" (read-line ip)))]
[(500)
(abort (format "Server internal error: ~a"
(apply string-append
(let loop ()
(let ((line (read-line ip)))
(cond
[(eof-object? line) '()]
[else (list* line "\n" (loop))]))))))]
[else
(abort (format "Internal error (unknown HTTP response code ~a)" response-code))])))