;; -----------------
;; Utility functions
;; -----------------

(defun make-temporary-filename (directory)
  (unless (probe-directory directory)
    (error "The directory ~S does not exist." directory))
  (dotimes (i 10)
    (let ((pathname (merge-pathnames (make-pathname :name (symbol-name (gensym))
						    :type nil)
				     directory)))
      (unless (probe-file pathname)
	(return-from make-temporary-filename pathname))))
  (error "Unable to create a temporary filename in ~S" directory))

(defun join-string-list (strings &optional (delimiter " "))
  (let ((result ""))
    (dolist (string strings result)
      (setf result (concatenate 'string
  				result
  				(unless (string= result "") delimiter)
  				string)))))

(defun construct-curl-header-arguments (headers)
  (let ((result ""))
    (dolist (pair headers result)
      (setf result (concatenate 'string result (format nil 
  						       " -H \"~A:~A\""
  						       (car pair)
  						       (cdr pair)))))))

(defun construct-curl-variable-argument (variables)
  (let ((result ""))
    (dolist (pair variables result)
      (setf result (concatenate 'string 
  				result 
  				(unless (string= result "") "&")
  				(car pair)
  				"="
  				(cdr pair))))))

(defun parse-response (header-path body-path)
  (let* ((lines (file-lines header-path))
  	 (status-line (string-parse (car lines)))
  	 (version (string-trim '(#\Space #\Tab) (car status-line)))
  	 (status (parse-integer (cadr status-line) :junk-allowed t))
  	 (phrase (string-trim '(#\Space #\Tab) (join-string-list (cddr status-line))))
  	 (headers nil))
    
    ;; process response headers
    (when (cdr lines)
      (dolist (line (cdr lines))
      	(let ((parts (string-parse line #\Colon)))
  	  (unless (string= "" (car parts))
  	    (setf headers (acons (string-trim '(#\Space #\Tab) (car parts)) 
  				 (string-trim '(#\Space #\Tab) (join-string-list (cdr parts) 
  										 ":"))  
  				 headers))))))
    
    `((response-status . ,status)
      (response-phrase . ,phrase)
      (response-version . ,version)
      (response-file . ,body-path)
      (response-headers . (,headers)))))

(defun sftp-protocol-prefix (string)
  (if (string= "sftp://" (subseq string 0 7))
      string
    (concatenate 'string "sftp://" string)))

(defun make-path-end-with-slash (string)
  (let ((len (length string)))
    (if (= len 0)
	"/"
      (if (string= (subseq string (- len 1) len) "/")
	  string
	(concatenate 'string string "/")))))

(defun remove-trailing-slash (string)
  (if (string= string "") string
    (let ((len (length string)))
      (if (string= (subseq string (- len 1) len) "/")
	  (subseq string 0 (- len 1))
	string))))

;; ---------
;; STOLEN :)
;; ---------

;; Stolen from:
;; http://www.cl-user.net/asp/KnT01/sdataQGCmSSEgZ0WxDQ3YNypX8yBX8yBXnMq=/sdataQu3F$sSHnB==
(defun read-file-to-string (path)
  (with-open-file (s path)
		  (let* ((len (file-length s))
			 (data (make-string len)))
		    (read-sequence data s)
		    data)))

;; Stolen from:
;; http://www.cl-user.net/asp/l8G$/sdataQ1rRCIcT9u9DDQ3YNypX8yBX8yBXnMq=/sdataQu3F$sSHnB==
(defun file-lines (path)
  "Sucks up an entire file from PATH into a list of freshly-allocated
   strings, returning two values: the list of strings and the number of
   lines read."
  (with-open-file (s path)
		  (loop for line = (read-line s nil nil)
			while line
			collect line into lines
			counting t into line-count
			finally (return (values lines line-count)))))


;; stolen from 
;; http://coding.derkeiler.com/Archive/Lisp/comp.lang.lisp/2003-10/0016.html
(defun string-parse (string &optional (token #\space)) 
  " 
string-parse 
FUNCTION 
--------------------------------------------------------------------- 
DESCRIPTION: 
  Parse a string into a list of strings using using a token 
  character. 
SYNTAX: 
  string-parse STR [TKN] 
PARAMETERS: 
  STR ::= <string> 
  TKN ::= <character> Default is #\space. 
EVALUATES-TO: 
  If none of the members of :token are found, a list 
  containing the input string is returned. The default for :token 
  is the space character. 
" 
  (labels ((cons-list (p str list-out) 
		      (if p (cons (subseq str 0 p) list-out) list-out))) 
    (do* ((str string (subseq str (1+ p))) 
          (p (position token str) (position token str)) 
          (list-out (cons-list p str nil) (cons-list p str list-out))) 
        ((null p) (nreverse (cons str list-out)))))) 

