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

Fix metadata post pkgs

Browse Source
This commit is contained in:
Jay McCarthy 2013-06-23 21:06:34 -06:00
parent 80953c1aa3
commit dfde2212cc
1 changed files with 14 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
pkgs/plt-services/meta/drdr/metadata.rkt
View File

@ -18,13 +18,18 @@
[(rktl) '(racket "-f" *)] [(rktl) '(racket "-f" *)]
[else #f]))) [else #f])))
(define (replace-* s) (define (replace-* s)
(if (eq? '* s) (cond
(path->string* a-path) [(eq? '* s)
s)) (path->string* a-path)]
[(not (string? s))
(format "~a" s)]
[else
s]))
(match (get-prop a-path 'drdr:command-line default-cmd) (match (get-prop a-path 'drdr:command-line default-cmd)
[#f #f] [#f #f]
[(? list? l) [(? list? l)
(map replace-* l)])) (cons (first l)
(map replace-* (rest l)))]))
(define (path-timeout a-path) (define (path-timeout a-path)
(get-prop a-path 'drdr:timeout #f)) (get-prop a-path 'drdr:timeout #f))
@ -46,15 +51,7 @@
;;; Property lookup ;;; Property lookup
(provide props-cache) (provide props-cache)
(define props-cache (make-hasheq)) (define props-cache (make-hasheq))
(define (get-prop og-a-fs-path prop [def #f] #:as-string? [as-string? #f]) (define (get-prop a-fs-path prop [def #f] #:as-string? [as-string? #f])
(define a-fs-path
(match (explode-path og-a-fs-path)
[(list* "racket" "lib" (and cp (list* "collects" _)))
(apply build-path cp)]
[(list* "pkgs" _ cp)
(apply build-path (list* "collects" cp))]
[_
og-a-fs-path]))
(define rev (current-rev)) (define rev (current-rev))
(define a-path (define a-path
(substring (substring
@ -66,21 +63,19 @@
(lambda () (lambda ()
(define tmp-file (make-temporary-file "props~a.rkt" #f (current-temporary-directory))) (define tmp-file (make-temporary-file "props~a.rkt" #f (current-temporary-directory)))
(and (and
; Checkout the props file ;; Checkout the props file
(scm-export-file (scm-export-file
rev rev
(plt-repository) (plt-repository)
"collects/meta/props" "pkgs/plt-services/meta/props"
tmp-file) tmp-file)
; Dynamic require it ;; Dynamic require it
(begin0 (begin0
(with-handlers ([exn? (λ (x) #f)]) (with-handlers ([exn? (λ (x) #f)])
(dynamic-require `(file ,(path->string tmp-file)) (dynamic-require `(file ,(path->string tmp-file))
'get-prop)) 'get-prop))
(delete-file tmp-file)))))) (delete-file tmp-file))))))
#;(unless props:get-prop ;; XXX get-prop is stupid and errors when a-path is invalid rather than returning def
(error 'get-prop "Could not load props file for ~e" (current-rev)))
; XXX get-prop is stupid and errors when a-path is invalid rather than returning def
(with-handlers ([exn? (lambda (x) def)]) (with-handlers ([exn? (lambda (x) def)])
(props:get-prop a-path prop def (props:get-prop a-path prop def
#:as-string? as-string?))) #:as-string? as-string?)))