Changeset 11597 in project


Ignore:
Timestamp:
08/11/08 15:09:02 (13 years ago)
Author:
felix winkelmann
Message:

started with henrietta

Location:
chicken/branches/hygienic
Files:
2 added
2 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/hygienic/TODO

    r11577 r11597  
    5555*** handle needs/depends of builtin extension
    5656*** should cache extension-info
    57 ** integrate into build
    58 *** setup-{api,utils,download}.so
    59 *** chicken-{status,install,uninstall}
    60 ** installation
    61 *** install DEFAULTS (in repo)
    62 *** install setup-{utils,api,download} (make var BUILD_SETUP_TOOLS)
    63 *** install $REPO/setup-tools.setup-info
    64 ** henrietta.cgi
    65 *** extract arguments from QUERY_STRING
    66 **** version=VERSION (optional)
    67 **** egg=NAME
    68 **** prefix=DIRPREFIX (in svn repo, i.e. release branch)
    69 *** retrieve egg using svn method and transmit
    70 *** log to stdout (requests + debug)
     57** test henrietta
    7158** manpages
    7259*** chicken-{status,install,uninstall}
  • chicken/branches/hygienic/setup-download.scm

    r11558 r11597  
    4545          dir)))
    4646
    47   (define (locate-egg/local egg dir #!optional version)
     47  (define (locate-egg/local egg dir #!optional version quiet)
    4848    (let* ((eggdir (make-pathname dir egg))
    4949           (files (directory eggdir))
     
    6666                eggdir)))))
    6767 
    68   (define (locate-egg/svn egg repo #!optional version)
     68  (define (locate-egg/svn egg repo #!optional version quiet)
    6969    (let ((cmd (sprintf "svn ls -R \"~a/~a\"" repo egg)))
    70       (print "checking available versions ...\n  " cmd)
     70      (fprintf (if quiet (current-error-port) (current-output-port))
     71               "checking available versions ...\n  ~a~%" cmd)
    7172      (let* ((files (with-input-from-pipe cmd read-lines))
    7273             (hastrunk (member "trunk/" files))
     
    9293                  ""))
    9394             (tmpdir (get-temporary-directory))
    94              (cmd (sprintf "svn co \"~a/~a/~a\" \"~a\"" repo egg filedir tmpdir)))
    95         (print "  " cmd)
     95             (cmd (sprintf "svn co \"~a/~a/~a\" \"~a\" ~a" repo egg filedir tmpdir
     96                           (if quiet "1>&2" ""))))
     97        (fprintf (if quiet (current-error-port) (current-output-port)) "  ~a~%" cmd)
    9698        (system* cmd)
    9799        tmpdir)) )
    98100
    99   (define (locate-egg/http egg url #!optional version)
     101  (define (locate-egg/http egg url #!optional version quiet)
    100102    (let* ((tmpdir (get-temporary-directory))
    101103           (m (string-match "(http://)?([^/]+)(:([^:/]+))?(/.+)" url))
     
    110112                     (string-append "?version=" version)
    111113                     ""))))
    112       (http-fetch host port loc tmpdir)
     114      (http-fetch host port loc tmpdir quiet)
    113115      tmpdir))
    114116
    115   (define (http-fetch host port loc dest)
     117  (define (http-fetch host port loc dest #!optional quiet)
    116118    (let-values (((in out) (tcp-connect host port)))
    117119      (fprintf out "GET ~a HTTP/1.1\r\nConnection: close\r\nUser-Agent: chicken-install ~a\r\nAccept: */*\r\nContent-length: 0\r\n\r\n"
     
    127129      (let loop ((files '()))
    128130        (let ((name (read in)))
    129           (print name)
     131          (fprintf (if quiet (current-error-port) (current-output-port))
     132                   "  ~a~%" name)
    130133          (cond ((and (pair? name) (eq? 'error (car name)))
    131134                 (apply error (cdr name)))
     
    146149                 (loop (cons name files)))))))))
    147150
    148   (define (retrieve-extension name transport location #!optional version)
     151  (define (retrieve-extension name transport location #!optional version quiet)
    149152    (case transport
    150153      ((local)
    151        (locate-egg/local name location version))
     154       (locate-egg/local name location version quiet))
    152155      ((svn)
    153        (locate-egg/svn name location version))
     156       (locate-egg/svn name location version quiet))
    154157      ((http)
    155        (locate-egg/http name location version))
     158       (locate-egg/http name location version quiet))
    156159      (else (error "unsupported transport" transport))))
    157160
Note: See TracChangeset for help on using the changeset viewer.