Commits

Anonymous committed c7e5018

doddle

Comments (0)

Files changed (2)

dropbox-lolevel.scm

 	  fileops/copy
 	  fileops/create_folder
 	  fileops/delete
-	  fileops/move)
+	  fileops/move
+	  callback
+	  old-output-port)
 
 (import chicken scheme)
 
-(use rest-bind oauth-client intarweb uri-common medea)
+(use ports)
+(use rest-bind oauth-client intarweb uri-common medea srfi-13 extras)
 
 ; Definition of the Dropbox OAuth service.
 (define dropbox (make-oauth-service-provider
   (make-oauth-service service: dropbox client-credential: client-credential))
 
 
+(define callback (make-parameter #f))
+(define old-output-port (make-parameter #f))
+
+
 
 ; /account/info : https://www.dropbox.com/developers/reference/api#account-info
 ; Description   : Retrieves information about the user's account.
 ;                The HTTP response contains the content metadata in JSON format
 ;                within an x-dropbox-metadata header.
 ;
-(define-method (files:get root path #!key rev) "https://api-content.dropbox.com/1/files/<root>/<path>"
+(define-method (files:get root path #!key rev) "https://api-content.dropbox.com/1/files"
 	       #f
-	       #f;read-file
-	       read-header)
+	       (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))))
 
 
 
 	  metadata-cache-table
 	  table-scope
 	  db-state-change-callback
+	  local-state-refresh-interval
 	  update-local-state!
 	  add-account-info!
 	  ls
+	  download
 	  )
 
 (import chicken scheme)
 
 ; Units - http://api.call-cc.org/doc/chicken/language
-(use data-structures posix srfi-1 files srfi-13)
+(use data-structures posix srfi-1 files srfi-13 ports)
 
 ; Eggs - http://wiki.call-cc.org/chicken-projects/egg-index-4.html
 (use dropbox-lolevel ssql vector-lib sql-de-lite)
 (define account-info-table   (make-parameter #f))
 (define metadata-cache-table (make-parameter #f))
 (define db-state-change-callback (make-parameter #f))
+(define local-state-refresh-interval (* 5 60))
 
 
 ; https://www.dropbox.com/developers/reference/api#date-format
 	  (from ,(metadata-cache-table))
 	  (where (and (or (= (col ,(metadata-cache-table) path-key) ,path-key)
 			  ,@(if recursive
-			      `((like (col ,(metadata-cache-table) path-key) ,(make-absolute-pathname path-key "%")))))
+			      `((like (col ,(metadata-cache-table) path-key) ,(string-append path-key "/%")))
+			      '()))
 		      ,(where-terms (metadata-cache-table))))))
 
 (define (select-directory-metadata path-key)
-  (let ((path-key (make-absolute-pathname path-key "%")))
+  (let ((path-key (string-append path-key "/%")))
     `(select (columns (col ,(metadata-cache-table)
 			   path-key revision rev thumb_exists bytes modified path
 			   is_dir icon root size is_deleted hash client_mtime))
 	(if (and
 	      (= 1 accounts)
 	      (or
-		(> (- now account-info-last-complete) (* 5 60))
+		(> (- now account-info-last-complete) local-state-refresh-interval)
 		force-account-info))
 	  (update-account-info! account-info))
 	(if (or
 	      (< metadata-cache-last-complete metadata-cache-last-modified) ; we know the metadata is not complete
-	      (> (- now metadata-cache-last-complete) (* 5 60)) ; or we last checked it more than five minutes ago
+	      (> (- now metadata-cache-last-complete) local-state-refresh-interval) ; or we last checked it more than five minutes ago
 	      force-metadata)
 	  (update-metadata! cursor))
 	#t)
 
 
 (define (canonicalise-path path)
- (string-chomp (string-downcase path) "/"))
+  (let ((path (string-chomp (string-downcase path) "/")))
+    (if (> (string-length path) 0)
+      (if (equal? #\/ (string-ref path 0))
+	path
+	(string-append "/" path))
+      "")))
 
 ; returns a list files
 ; if path is a file the list is of length 1
 (define (ls path #!optional directory)
   ; TODO: update-local-state! (conditional on some parameter flag)
   (let* ((path (canonicalise-path path))
-	 (path-meta (perform-read (select-metadata path)))
-	 )
+	 (path-meta (if (equal? "" path)
+		      '(((path-key . "")
+			 (revision . #f)
+			 (rev . #f)
+			 (thumb_exists . #f)
+			 (bytes . 0)
+			 (modified . #f)
+			 (path . "")
+			 (is_dir . 1)
+			 (icon . "folder_public")
+			 (root . "dropbox")
+			 (size . "0 bytes")
+			 (is_deleted) (hash) (client_mtime)))
+		      (perform-read (select-metadata path)))))
     (cond
       ((and directory
 	    (= 1 (length path-meta))
       (else ; ls <file>
 	path-meta))))
 
+; Downloads a file.
+; Downloads the file specified in source to the local path name specified in
+; destination.
+; destination is a string representing the path name into the local filesystem.
+; 	if dest is a port then we pipe the contents to that port.
+; 	if dest is a string then we pipe the contents into that file on the fs.
+; source is an alist that describes the file and can be obtained with a call to
+; 'ls'.
+; If latest-rev is #f then the revision specified in the metadata will be
+; fetched. Otherwise, the lateset revision will be fetched.
+(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)))))
+
 
 
 )