/
/commands.lisp
  1 (in-package :twitter)
  2 
  3 (defvar *command-map* (make-hash-table)
  4   "Table of all the command records")
  5 
  6 (defstruct (twitter-command (:conc-name "COMMAND-")) 
  7   name method return-type base-url description argmap)
  8 
  9 (defmethod print-object ((cmd twitter-command) stream)
 10   (format stream "#<TWITTER-CMD '~A'>" (command-name cmd)))
 11 
 12 ;;
 13 ;; Command definition macro
 14 ;;
 15 
 16 
 17 (defmacro define-command (command (method return-type) base-url description &body args)
 18   "Capture all the key syntax for Twitter commands:
 19    command name | method | arguments | return-type | base-url 
 20 
 21    method = { :get | :post | :get-id | :post-id }
 22    return-type = { :status | (:status) | :user-basic | 
 23                    :user-ext | :message | (:message) |
 24                    :id | (:id) | :value"
 25   (let ((cmd-sym (intern (symbol-name command) :keyword)))
 26     `(progn
 27        (setf (gethash ,cmd-sym *command-map*)
 28 	     (make-twitter-command
 29 	      :name ,cmd-sym
 30 	      :method ,method
 31 	      :return-type ',return-type
 32 	      :base-url ,base-url
 33 	      :description ,description
 34 	      :argmap ',(plist->alist args))))))
 35 
 36 ;;
 37 ;; Command API
 38 ;;
 39 
 40 (defun get-command (command-ref)
 41   "Take a command or keyword reference and return command object"
 42   (if (twitter-command-p command-ref) command-ref
 43       (gethash command-ref *command-map*)))
 44 
 45 (defun list-commands ()
 46   (format t "Twitter API Commands (command-help command-name) provides help:~%")
 47   (maphash (lambda (k v)
 48 	     (format t ":~A -> ~A~%    ~A~%"
 49 		     k (command-return-type v)
 50 		     (command-description v)))
 51            *command-map*))
 52 
 53 (defun command-help (&optional command-name)
 54   "Interactive printing of command arguments"
 55   (if (null command-name)
 56       (list-commands)
 57       (let* ((command (get-command command-name)))
 58 	(if command
 59 	    (progn
 60 	      (format t "~A~%~A~%~%Arguments:~%" command-name (command-description command))
 61 	      (mapcar #'argument-help (command-argmap command))
 62 	      t)
 63 	    (format t "Command ~A not found~%" command-name)))))
 64 
 65 (defun argument-help (argument)
 66   (format t "  ~A: ~A~%" (car argument) (cdr argument)))
 67 
 68 (defun command-request-arguments (command args)
 69   "A command reference and a plist of arguments.
 70    Returns multiple values: url auth post-params parse-type"
 71   (let ((cmd (get-command command)))
 72     (check-arguments cmd args)
 73     (let ((newargs (lisp->twitter-plist args)))
 74       (case (command-method cmd)
 75 	(:get (get-command-request cmd newargs))
 76 	(:post (post-command-request cmd newargs))
 77 	(:get-id (get-id-command-request cmd newargs))
 78 	(:post-id (post-id-command-request cmd newargs))))))
 79 
 80 ;;
 81 ;; URI generators
 82 ;;
 83 
 84 (defun get-command-request (cmd args)
 85   (values 
 86    :get
 87    (generate-get-url cmd (strip-keyword :user args))
 88    (user-http-auth (get-user (getf args :user nil)))
 89    nil))
 90 
 91 (defun get-id-command-request (cmd args)
 92   (multiple-value-bind (method url auth)
 93       (get-command-request cmd (strip-keyword :id args))
 94     (values method (inject-url-id cmd url args)
 95 	    auth nil)))
 96 
 97 (defun post-command-request (cmd args)
 98   (values
 99    :post
100    (command-base-url cmd)
101    (user-http-auth (get-user (getf args :user nil)))
102    (plist->uri-params (append (when *twitter-client-source-param*
103 				`("source" ,*twitter-client-source-param*))
104 			      (strip-keyword :user args)))))
105 
106 (defun post-id-command-request (cmd args)
107   (multiple-value-bind (method url auth post)
108       (post-command-request cmd (strip-keyword :id args))
109     (values method (inject-url-id cmd url args)
110 	    auth post)))
111 
112 ;;
113 ;; Helpers
114 ;;		       
115 
116 (defun check-arguments (cmd args)
117   (let ((argmap (command-argmap cmd))
118 	(name (command-name cmd)))
119     (loop for arg in (plist-keywords args)
120        unless (or (member arg argmap :key #'car) (eq arg :user))
121        do (error "Unknown argument ~A to command ~A" arg name)
122        finally (return t))))
123 
124 (defun get-request-argument (args keyword)
125   (to-uri-param (getf args keyword) nil))
126 
127 (defun get-required-request-argument (cmd args keyword)
128   (let ((value (getf args keyword)))
129     (unless value
130       (error ":~A argument missing for command ~A" keyword (command-name cmd)))
131     (to-uri-param value nil)))
132 
133 (defun inject-url-id (cmd url args)
134   (declare (ignorable cmd))
135   (ppcre:regex-replace "<id>" url 
136 		       (or (get-request-argument args :id) "show")))
137 
138 (defun generate-get-url (cmd args)
139   (format nil "~A?~{~A=~A~^&~}" (command-base-url cmd)
140 	  (plist->uri-params args t)))