http-client版、xyttrで画像アップロード

tweet-with-photo.l

;;; -*- mode:lisp; package:xyttr -*-

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "oauth")
  (require "http-client")
  (require "xl-winhttp")
  (require "xyttr")
  (use-package :http-client :xyttr)
  )

(in-package "xyttr")

(defvar *upload-url* "https://upload.twitter.com")

(defun api-update-with-media (&key status image-path oncomplete)
  (interactive)
  (let* ((path "/1/statuses/update_with_media.json")
	 (url (concat *upload-url* path))
	 (cred (list :consumer-key *consumer-key*
		     :consumer-secret *consumer-secret*
		     :token *token*
		     :token-secret *token-secret*))
	 (auth (oauth:auth-header cred 'POST url nil)))
    (http-post url
	       `((status ,status)
		 (media[] :file ,image-path
			  :content-type ,(format nil "image/~A" (pathname-type image-path))
			  :content-transfer-encoding "binary"))
	       :headers `(:Authorization ,auth)
	       :encoding *encoding-utf8n*
	       :oncomplete #'(lambda (body status headers uri)
			       (let ((res (json:json-decode body)))
				 (if (json-value res error)
				     (error 'request-error
					    :host *upload-url* :path path :method 'POST
					    :status status :response res)
				   (funcall oncomplete res))))
	       :onprogress #'(lambda (progress)
			       (message "~A" progress))
	       :onerror #'(lambda (err)
			    (msgbox "Error: ~A" err))
	       )))


(defvar *photo-directory* (merge-pathnames "Pictures" (si:getenv "USERPROFILE")))

(defun tweet-with-photo ()
  (interactive)
  (multiple-value-bind (path ok)
      (filer *photo-directory* nil "画像ファイル" nil nil)
    (unless ok (quit))
    (let ((status (read-status "tweet: ")))
      (api-update-with-media :status status :image-path path
			     :oncomplete #'(lambda (res)
					     (when res
					       (message "Uploaded: ~A" path)))
			     ))))