dropbox#files:get pasted by andyjpb on Wed Oct 9 00:02:53 2013

(define-method (files:get root path #!key rev) "https://api-content.dropbox.com/1/files"
	       #f
	       (lambda (in-port) ; Based on copy-port from spiffy-cgi-handlers.
		 (let ((bufsize 65536)
		       (total 0))
		   (let loop ((data (read-string bufsize in-port)))
		     (unless (string-null? data)
		       (display data)
		       (if (callback)
			 (begin
			   (set! total (+ total (string-length data)))
			   (if (port? (old-output-port))
			     (with-output-to-port
			       (old-output-port)
			       (lambda () ((callback) total)))
			     ((callback) total))))
		       (loop (read-string bufsize in-port))))))
	       (lambda (headers) ; read-headers
		 (let ((metadata (header-value 'x-dropbox-metadata headers)))
		   (if metadata
		     (read-json metadata)
		     #f))))

hi-level pasted by andyjpb on Wed Oct 9 00:04:13 2013

(define (download source #!optional destination latest-rev progress-callback)
  (let ((proc (lambda ()
		(parameterize ((callback progress-callback))
			      (files:get (alist-ref 'root source)
					 (alist-ref 'path-key source)
					 rev: (if latest-rev #f (alist-ref 'rev source)))))))
    (old-output-port (current-output-port))
    (cond
      ((port? destination)
       (with-output-to-port destination proc))
      ((string? destination)
       (with-output-to-file destination proc))
      (else (proc)))))

silly and slow added by C-Keen on Wed Oct 9 00:14:52 2013

(define (read/write filename length outport #!optional (bs (* 1024 2)))
  (print "Length : " length ", blocksize " bs )
  (let ((bar (make-progress-bar frame: (string-append filename ": [~a~a~a~a|~a]") width: 40 max: length)))
    (let loop ((size length))
      (let* ((bytes (min bs size)))
        (if (zero? size) #t
            (let ((input (read-string bytes)))
              (if input
                  (write-string input bytes outport)
                  (when (> bytes 0)
                    (error "Missing ~a from input" (pretty-filesize bytes))))
              (advance-progress-bar! bar bytes)
              (loop (- size bytes))))))
    (finish-progress-bar! bar)))