www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs

pack-built.rkt (2673B)

      1 #lang racket/base
      2 (require pkg
      3          pkg/lib
      4          racket/format
      5          net/url
      6          racket/set
      7          racket/file
      8          racket/path
      9          openssl/sha1
     10          racket/cmdline
     11          setup/getinfo)
     12 
     13 (module test racket/base)
     14 
     15 (define create-mode 'built)
     16 
     17 (define pkg-info-file
     18   (command-line
     19    #:once-each
     20    [("--mode") mode "Create package archives for <mode>"
     21     (set! create-mode (string->symbol mode))]
     22    #:args (pkg-info-file)
     23    pkg-info-file))
     24 
     25 (define build-dir "build")
     26 (define dest-dir (build-path build-dir (~a create-mode)))
     27 (define pkg-dest-dir (path->complete-path (build-path dest-dir "pkgs")))
     28 (define catalog-dir (build-path dest-dir "catalog"))
     29 (define catalog-pkg-dir (build-path catalog-dir "pkg"))
     30 (make-directory* pkg-dest-dir)
     31 (make-directory* catalog-pkg-dir)
     32 
     33 (define pkg-details (call-with-input-file* pkg-info-file read))
     34 
     35 (define pkg-cache (make-hash))
     36 
     37 (define (prefer-binary? pkg)
     38   (define dir (pkg-directory pkg #:cache pkg-cache))
     39   (define i (get-info/full dir))
     40   (define mode (and i (i 'distribution-preference (lambda () #f))))
     41   (or (eq? mode 'binary)
     42       (and
     43        ;; Any ".rkt" or ".scrbl" other than "info.rkt"?
     44        (not (for/or ([f (in-directory dir)])
     45               (and (regexp-match? #rx"[.](scrbl|rkt)$" f)
     46                    (not (let-values ([(base name dir?) (split-path f)])
     47                           (equal? #"info.rkt" (path->bytes name)))))))
     48        ;; Any native library?
     49        (for/or ([f (in-directory dir)])
     50          (regexp-match? #rx"[.](dll|so(|[.][-.0-9]+)|dylib|framework)$" f)))))
     51    
     52 (for ([pkg (in-list (installed-pkg-names))])
     53   (define ht (hash-ref pkg-details pkg (hash)))
     54   (define dest-zip (build-path pkg-dest-dir (~a pkg ".zip")))
     55   (pkg-create 'zip pkg
     56               #:source 'name
     57               #:dest pkg-dest-dir
     58               #:mode (if (prefer-binary? pkg)
     59                          'binary
     60                          create-mode))
     61   (call-with-output-file*
     62    (build-path catalog-pkg-dir pkg)
     63    #:exists 'truncate
     64    (lambda (o)
     65      (write (hash 'source (path->string (find-relative-path
     66                                          (simple-form-path catalog-dir)
     67                                          (simple-form-path dest-zip)))
     68                   'checksum (call-with-input-file* dest-zip sha1)
     69                   'name pkg
     70                   'author (hash-ref ht 'author "plt@racket-lang.org")
     71                   'description (hash-ref ht 'author "library")
     72                   'tags (hash-ref ht 'tags '())
     73                   'dependencies (hash-ref ht 'dependencies '())
     74                   'modules (hash-ref ht 'modules '()))
     75             o)
     76      (newline o))))