From 9a95c79e08abe8331b6a50d845378e1be3086d16 Mon Sep 17 00:00:00 2001 From: alfons haffmans Date: Sun, 2 Jan 2011 08:29:08 -0500 Subject: [PATCH] added cl-twit-repl/aliases etc --- .gitignore | 3 +- api/conditions.lisp | 18 +++-- api/package.lisp | 1 + api/twitter-show.lisp | 102 ++++++++++++++++------------- api/twitter-tweet-status.lisp | 15 +++-- api/twitter-vars.lisp | 4 ++ api/utils.lisp | 10 +++ cl-twit-repl.asd | 1 + cl-twit-repl/alias.lisp | 48 ++++++++++++++ cl-twit-repl/cl-twit-repl.lisp | 55 +++++++++++----- cl-twit-repl/package.lisp | 9 ++- cl-twit-repl/serialize-access.lisp | 21 ++++-- cl-twit-repl/twitter.lisp | 18 ++--- cl-twitter.asd | 2 +- 14 files changed, 213 insertions(+), 94 deletions(-) create mode 100644 cl-twit-repl/alias.lisp diff --git a/.gitignore b/.gitignore index 196f1ab..64fbe29 100644 --- a/.gitignore +++ b/.gitignore @@ -4,4 +4,5 @@ *.abcl *.lx64fsl *.fasl -*.ht \ No newline at end of file +*.ht +*.alias diff --git a/api/conditions.lisp b/api/conditions.lisp index d6ddbc7..2c7c134 100644 --- a/api/conditions.lisp +++ b/api/conditions.lisp @@ -1,4 +1,4 @@ -(in-package :twitter) +(in-package :cl-twitter) ;; ;; Errors @@ -6,10 +6,10 @@ (define-condition twitter-api-condition (error) ((return-code :reader return-code :initarg :code) - (short :reader short-message :initarg :short) - (long :reader long-message :initarg :long) - (request :reader request-message :initarg :request) - (uri :reader request-uri :initarg :uri)) + (short :reader short-message :initarg :short) + (long :reader long-message :initarg :long) + (request :reader request-message :initarg :request) + (uri :reader request-uri :initarg :uri)) (:report (lambda (c stream) (format stream "Error code ~A (~A): '~A'~%in request to ~A" (return-code c) (short-message c) @@ -28,3 +28,11 @@ +(defmacro with-error-handler ((&key (verbose nil)) &rest body) + `(progn + (handler-case + ,@body + (twitter-api-condition (c) + (when ,verbose (format t "twitter signaled an error : ~S : ~S ~%" (return-code c) (short-message c)))) + (error (c) + (when ,verbose (format t "an error occured : ~S ~%" c)))))) \ No newline at end of file diff --git a/api/package.lisp b/api/package.lisp index 158949d..a3ecead 100644 --- a/api/package.lisp +++ b/api/package.lisp @@ -44,6 +44,7 @@ #:retweet #:retweets #:retweeted-by + #:@mention ;; Trends resources #:trends diff --git a/api/twitter-show.lisp b/api/twitter-show.lisp index 4e7524c..a9596c4 100644 --- a/api/twitter-show.lisp +++ b/api/twitter-show.lisp @@ -2,70 +2,80 @@ (defvar *seperator* "--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------") -(defgeneric show (obj)) -(defmethod show ( (obj t)) - (format t "~&~1t~S~%" obj)) +(defgeneric show (obj &optional s )) -(defmethod show ((obj cons)) - (length (mapcar #'show obj))) +(defmethod show ( (obj t) &optional (s *standard-output*)) + (format s "~&~1t~S~%" obj)) -(defmethod show ((obj hash-table)) - (maphash (lambda (k v) (show v)) obj)) +(defmethod show ((obj cons) &optional (s *standard-output*)) + (length (mapcar (lambda (el) (show el s)) obj))) -(defmethod show ((tweet tweet)) - (format t "~&~150<~a~; ~a~>" (twitter-user-screen-name (tweet-user tweet)) (tweet-created-at tweet)) - (format t "~&~A" (tweet-text tweet)) - (format t "~&~A" *seperator*)) +(defmethod show ((obj hash-table) &optional (s *standard-output*)) + (maphash (lambda (k v) (declare (ignore k)) (show v s)) obj)) -(defmethod show ((trend-list trend-list)) +(defmethod show ((tweet tweet) &optional (s *standard-output*)) + (format s "~&~150<~a~; ~a~>" (twitter-user-screen-name (tweet-user tweet)) (tweet-created-at tweet)) + (format s "~&~A" (tweet-text tweet)) + (format s "~&~A" *seperator*)) + +(defmethod show ((trend-list trend-list) &optional (s *standard-output*)) (let ((location (car (trend-list-locations trend-list))) (trend-list (trend-list-trends trend-list))) (dolist (trend trend-list) - (format t "~&~1t~A~40t~A~80t~A" (place-name location) (trend-name trend) (trend-url trend)) - (format t "~&~A" *seperator*)))) + (format s "~&~1t~A~40t~A~80t~A" (place-name location) (trend-name trend) (trend-url trend)) + (format s "~&~A" *seperator*)))) -(defmethod show ((trend trend)) - (format t "~&~120<~1t~a~; ~a~>" (trend-name trend) (trend-url trend)) - (format t "~&~A" *seperator*)) +(defmethod show ((trend trend) &optional (s *standard-output*)) + (format s "~&~120<~1t~a~; ~a~>" (trend-name trend) (trend-url trend)) + (format s "~&~A" *seperator*)) -(defmethod show ((search-ref cl-twitter::search-ref)) - (format t "~&~150" (search-ref-from-user search-ref) (or (search-ref-to-user search-ref) "")) - (format t "~&~A" (search-ref-text search-ref)) - (format t "~&~A" (search-ref-created-at search-ref)) - (format t "~&~A" *seperator*)) +(defmethod show ((search-ref cl-twitter::search-ref) &optional (s *standard-output*)) + (format s "~&~150" (search-ref-from-user search-ref) (or (search-ref-to-user search-ref) "")) + (format s "~&~A" (search-ref-text search-ref)) + (format s "~&~A" (search-ref-created-at search-ref)) + (format s "~&~A" *seperator*)) -(defmethod show ((twitter-user twitter-user)) - (format t "~&~1t~A ~30ttimezone : ~A ~70turl : ~A ~140tcreated : ~A" (twitter-user-screen-name twitter-user) (twitter-user-time-zone twitter-user) +(defmethod show ((twitter-user twitter-user) &optional (s *standard-output*)) + (format s "~&~1t~A ~30ttimezone : ~A ~70turl : ~A ~140tcreated : ~A" (twitter-user-screen-name twitter-user) (twitter-user-time-zone twitter-user) (twitter-user-url twitter-user) (twitter-user-created-at twitter-user) ) - (format t "~&~1tname : ~S ~30tstatuses : ~A ~70tfriends : ~A ~120tfollowers : ~A ~140tfollowing : ~A" (twitter-user-name twitter-user) + (format s "~&~1tname : ~S ~30tstatuses : ~A ~70tfriends : ~A ~120tfollowers : ~A ~140tfollowing : ~A" (twitter-user-name twitter-user) (twitter-user-statuses-count twitter-user) (twitter-user-friends-count twitter-user) (twitter-user-followers-count twitter-user) (twitter-user-following twitter-user)) - (format t "~&~1t~A" (twitter-user-description twitter-user)) - (format t "~&~A" *seperator*)) + (format s "~&~1t~A" (twitter-user-description twitter-user)) + (format s "~&~A" *seperator*)) + +(defmethod show ((geo-place geo-place) &optional (s *standard-output*)) + (format s "~&~1t~A~15t~A " (geo-place-place-type geo-place) (geo-place-full-name geo-place)) + (format s "~80t~A" (geo-attribute-street-address (geo-place-attributes geo-place))) + (format s "~120t~A" (geo-place-country geo-place) ) + (format s "~&~A" *seperator*)) -(defmethod show ((geo-place geo-place)) - (format t "~&~1t~A~15t~A " (geo-place-place-type geo-place) (geo-place-full-name geo-place)) - (format t "~80t~A" (geo-attribute-street-address (geo-place-attributes geo-place))) - (format t "~120t~A" (geo-place-country geo-place) ) - (format t "~&~A" *seperator*)) +(defmethod show ((place place) &optional (s *standard-output*)) + (format s "~&~1t~A~30t~A~60t~A" (place-name place) (place-type-name (place-placetype place)) (place-country place) ) + (format s "~90twoeid : ~A~110tcoutry code : ~A" (place-woeid place) (place-countrycode place) ) + (format s "~&~A" *seperator*)) -(defmethod show ((place place)) - (format t "~&~1t~A~30t~A~60t~A" (place-name place) (place-type-name (place-placetype place)) (place-country place) ) - (format t "~90twoeid : ~A~110tcoutry code : ~A" (place-woeid place) (place-countrycode place) ) - (format t "~&~A" *seperator*)) +(defmethod show ((list-type list-type) &optional (s *standard-output*)) + (format s "~&~1t~a~35t~a~90t~a" (list-type-slug list-type) (list-type-full-name list-type) (list-type-description list-type)) + (format s "~&~90tid : ~a~100towner : ~a members : ~a mode :~a " (list-type-id list-type) (twitter-user-screen-name (list-type-user list-type)) (list-type-member-count list-type) (list-type-mode list-type) ) + (format s "~&~A" *seperator*)) -(defmethod show ((list-type list-type)) - (format t "~&~1t~a~35t~a~90t~a" (list-type-slug list-type) (list-type-full-name list-type) (list-type-description list-type)) - (format t "~&~90tid : ~a~100towner : ~a members : ~a mode :~a " (list-type-id list-type) (twitter-user-screen-name (list-type-user list-type)) (list-type-member-count list-type) (list-type-mode list-type) ) - (format t "~&~A" *seperator*)) +(defmethod show ((rate-limit rate-limit) &optional (s *standard-output*)) + (format s "~&~1tremaining : ~A/~A ~20treset : ~A/current time : ~A ~67t[~A seconds]" (rate-limit-remaining-hits rate-limit) (rate-limit-hourly-limit rate-limit) + (rate-limit-reset-time rate-limit) (current-utc nil) (rate-limit-reset-time-in-seconds rate-limit) )) + -(defmethod show ((geo-places geo-places)) - (mapcar #'show (geo-places-places geo-places))) +(defmethod show ((geo-places geo-places) &optional (s *standard-output*)) + (mapcar (lambda (el) (show el s)) (geo-places-places geo-places))) -(defmethod show ((geo-result geo-result)) - (show (geo-result-result geo-result))) +(defmethod show ((geo-result geo-result) &optional (s *standard-output*)) + (show (geo-result-result geo-result) s)) + +(defmethod show ((cursor-user-lists cursor-user-lists) &optional (s *standard-output*)) + (mapcar (lambda (el) (show el s)) (cursor-user-lists-lists cursor-user-lists))) + + -(defmethod show ((cursor-user-lists cursor-user-lists)) - (mapcar #'show (cursor-user-lists-lists cursor-user-lists))) + \ No newline at end of file diff --git a/api/twitter-tweet-status.lisp b/api/twitter-tweet-status.lisp index 04aee72..329adad 100644 --- a/api/twitter-tweet-status.lisp +++ b/api/twitter-tweet-status.lisp @@ -1,4 +1,4 @@ -(in-package :twitter) +(in-package :cl-twitter) ;; @@ -174,12 +174,19 @@ (error "Tweet updates must be less than 140 characters. Length is ~A" (length newtext))))) (defun reply-to (tweet text &key (tiny-url-p t) (lat nil) (long nil) (place-id nil) (display-coordinates nil) (trim-user nil) (include-entities nil)) - (send-tweet text :in-reply-to-status-id (tweet-id tweet) :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates :trim-user trim-user :include-entities include-entities)) + (tweet text :in-reply-to-status-id (tweet-id tweet) :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates + :trim-user trim-user :include-entities include-entities)) (defun @reply-to (tweet text &key (tiny-url-p t) (lat nil) (long nil) (place-id nil) (display-coordinates nil) (trim-user nil) (include-entities nil)) (let ((fmt (format nil "@~A ~A" (twitter-user-screen-name (tweet-user tweet)) text))) - (send-tweet fmt :in-reply-to-status-id (tweet-id tweet) :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates :trim-user trim-user :include-entities include-entities))) - + (tweet fmt :in-reply-to-status-id (tweet-id tweet) :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates + :trim-user trim-user :include-entities include-entities))) + +(defun @mention (name text &key (tiny-url-p t) (lat nil) (long nil) (place-id nil) (display-coordinates nil) (trim-user nil) (include-entities nil)) + (let ((fmt (format nil "@~A ~A" (twitter-user-screen-name (show-user name)) text))) + (tweet fmt :tiny-url-p tiny-url-p :place-id place-id :lat lat :long long :display-coordinates display-coordinates :trim-user trim-user :include-entities include-entities))) + + (defun delete-tweet (tweet &key (trim-user nil) (include-entities nil)) (delete-status (tweet-id tweet) :trim-user trim-user :include-entities include-entities)) diff --git a/api/twitter-vars.lisp b/api/twitter-vars.lisp index e7e18e5..fa97abb 100644 --- a/api/twitter-vars.lisp +++ b/api/twitter-vars.lisp @@ -7,6 +7,10 @@ ;; Main API ;; ;; ("X-Twitter-Client-URL" . "http://common-lisp.net/project/cl-twitter/")) +(defvar *month-strings* '("xx" "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") "translate month to s string") +(defvar *day-of-week-strings* '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") "map day-of-the-week to a string") + + (defvar *twitter-app-uri* "http://api.twitter.com/1/") (defvar *twitter-search-uri* "http://search.twitter.com/") (defvar *twitter-oauth-uri* "http://api.twitter.com/oauth/") diff --git a/api/utils.lisp b/api/utils.lisp index b365a4d..0a6e3c0 100644 --- a/api/utils.lisp +++ b/api/utils.lisp @@ -1,5 +1,15 @@ (in-package :twitter) +(defun day-of-week (i) + (nth i *day-of-week-strings*)) + +(defun month (i) + (nth i *month-strings*)) + +(defun current-utc (stream) + (multiple-value-bind (s m h date month year dow &rest args) (decode-universal-time (get-universal-time) 0) + (format stream "~A ~A ~A ~A:~A:~A ~A" (day-of-week dow) (month month) date h m s year))) + (defun twitter-app-uri (method) (concatenate 'string *twitter-app-uri* method)) diff --git a/cl-twit-repl.asd b/cl-twit-repl.asd index 866a4cf..c5cff3a 100644 --- a/cl-twit-repl.asd +++ b/cl-twit-repl.asd @@ -17,6 +17,7 @@ :serial t :components ((:file "package") (:file "serialize-access") + (:file "alias") (:file "cl-twit-repl") (:file "twitter")))) :depends-on (:cl-twitter)) \ No newline at end of file diff --git a/cl-twit-repl/alias.lisp b/cl-twit-repl/alias.lisp new file mode 100644 index 0000000..7b8e9b4 --- /dev/null +++ b/cl-twit-repl/alias.lisp @@ -0,0 +1,48 @@ +(in-package :cl-twit-repl) + +(defvar *alias-registry* (make-hash-table :test 'equal)) +(defvar *alias-file-name* "cl-twit-repl.alias") + +(defun alias-file () + (default-access-path "alias/" *alias-file-name*)) + +(defmacro testit (x y) + `(destructuring-bind (name (&rest args) &rest body) ',y + (format nil "(defun ~S (&rest args) (apply (~S ~S ~S ) args)) " ',x name args (car body)))) + +(defmacro construct-alias-func (x y) + `(if (listp ,y) + (progn + (if (equal (car ,y) 'lambda) + (destructuring-bind (name (&rest args) &rest body) ,y + (format nil "(defun ~S (&rest args) (apply (~S ~A ~S) args)) " ,x name args (car body))) + (destructuring-bind (fn &rest rest) ,y + (format nil "(defun ~S (&rest args) (apply '~S ~{ ~S ~} args))" ,x fn rest)))) + (format nil "(defun ~S (&rest args) (apply '~S args))" ,x ,y))) + +(defmacro alias (&optional x y) + `(if ',x + (if ',y + (eval (read (make-string-input-stream (cdr (setf (gethash ',x *alias-registry*) (cons ',y (construct-alias-func ',x ',y))))))) + (car (gethash ',x *alias-registry*))) + (maphash (lambda (k v) (format t "~1t~S ~20t=> ~25t~S~%" k (car v))) *alias-registry*))) + +(defmacro unalias (&optional x) + `(if ',x + (progn (remhash ',x *alias-registry*) + (fmakunbound ',x)) + (progn (maphash (lambda (k v) (declare (ignore v)) (fmakunbound k)) *alias-registry*) + (setf *alias-registry* (make-hash-table :test 'equal))))) + +(defun dump-alias () + (with-open-file (stream (alias-file) :direction :output :if-exists :supersede) + (maphash (lambda (key lst) (format stream "~S~%" (list key lst))) *alias-registry*))) + +(defun read-alias () + (when (probe-file (alias-file)) + (with-open-file (stream (alias-file) :direction :input ) + (do ((line (read stream nil) (read stream nil))) + ((null line)) + (eval (read (make-string-input-stream (cdr (setf (gethash (car line) *alias-registry*) (cadr line)))))))))) + + diff --git a/cl-twit-repl/cl-twit-repl.lisp b/cl-twit-repl/cl-twit-repl.lisp index 340f554..c785c3a 100644 --- a/cl-twit-repl/cl-twit-repl.lisp +++ b/cl-twit-repl/cl-twit-repl.lisp @@ -1,22 +1,45 @@ (in-package :cl-twit-repl) -(defun cursor () - (if *twitter-user* - (format t "~&~A> " (twitter-user-screen-name *twitter-user*)) - (format t "~&~A> " "not_authenticated"))) - -(defun cl-twit-read () - (read-from-string (read-line) nil nil)) +(defvar *consumer-key* "9hOStbD2Zf7x0mUoo7cYBg" "The consumer key for cl-twit-repl, as listed on https://twitter.com/apps. Used for OAuth.") +(defvar *consumer-secret* "PWx9ZBZS9BVbesqlkoyiPzXtucmU7jaWe4ECcC30l0" "The consumer secret for cl-twit-repl, as listed on https://twitter.com/apps. Used for OAuth.") +(defvar *saved-print-pprint-dispatch* () "saved version of the dispatch table") +(defvar *saved-pprint-dispatch-cons* (pprint-dispatch 'cons) "saved version of the cons pp") +(defvar *cl-twit-repl-stream* *standard-output* "prefferred output stream for the twitter repl client") -(defun cl-twit-eval (sexp) - (eval sexp)) +(defvar *twitter-types* (list 'tweet 'cl-twitter::geo-places 'cl-twitter::geo-place 'cl-twitter::place 'cl-twitter::list-type 'cl-twitter::geo-result 'twitter-user 'search-ref 'trend-list + 'cl-twitter::rate-limit) "list of types in the twitter api for which we 're going to use the show method instead of the pp") -(defun cl-twit-print (lst) - (format t "~S" (show lst))) +(defun twitterp (obj) + (member (type-of obj) *twitter-types*)) + +(defun pp-show (s o) + (if (or (twitterp o) (and (consp o) (twitterp (car o))) (hash-table-p o)) + (show o (or *cl-twit-repl-stream* s)) + (funcall *saved-pprint-dispatch-cons* s o))) + +(defun install-new-dispatchers () + (mapcar (lambda (type) (set-pprint-dispatch type #'pp-show)) *twitter-types*)) (defun cl-twit-repl () - (cursor) - (let ((cmd (cl-twit-read))) - (unless (and (consp cmd) (eq (car cmd ) 'quit)) - (cl-twit-print (cl-twit-eval cmd)) - (cl-twit-repl)))) \ No newline at end of file + (use-package :cl-twitter) + (unless *alias-registry* (setf *alias-registry* (make-hash-table :test 'equal))) + (read-alias) + (when (null *saved-print-pprint-dispatch*) (setf *saved-print-pprint-dispatch* (copy-pprint-dispatch))) + (set-pprint-dispatch 'cons #'pp-show) + (set-pprint-dispatch 'hash-table #'pp-show) + (install-new-dispatchers) + (unless (probe-file (access-file)) (repl-authenticate-user)) + (cl-twitter::with-error-handler (:verbose nil) + (verify-credentials))) + +(defun done-twittering () + (when *saved-print-pprint-dispatch* + (setf *print-pprint-dispatch* *saved-print-pprint-dispatch*) + (setf *saved-print-pprint-dispatch* nil)) + ;;order is important + (when *alias-registry* (dump-alias)) + (setf *alias-registry* nil) + (cl-twitter::with-error-handler (:verbose nil) + (end-session)) + (setf *twitter-user* nil)) + diff --git a/cl-twit-repl/package.lisp b/cl-twit-repl/package.lisp index 572ade2..8441155 100644 --- a/cl-twit-repl/package.lisp +++ b/cl-twit-repl/package.lisp @@ -8,8 +8,11 @@ ;;-------------------- #:*access-file* + #:alias + #:unalias + #:cl-twit-repl + #:done-twittering - ;; Interactive API #:authenticate-user #:authenticated-user #:*twitter-user* @@ -20,10 +23,6 @@ #:repl-authenticate-user #:get-authenticated-user - ;; I/O - #:print-tweets - #:get-tinyurl - )) diff --git a/cl-twit-repl/serialize-access.lisp b/cl-twit-repl/serialize-access.lisp index 9f7a3bc..db463a7 100644 --- a/cl-twit-repl/serialize-access.lisp +++ b/cl-twit-repl/serialize-access.lisp @@ -10,7 +10,7 @@ #+ccl (directory "*" :directories t) #-(or sbcl ccl) (directory "./")) -(defun default-access-path () +(defun default-access-path (dirname filename) (let ((dirs (mapcar #'namestring (get-dirs)))) (labels ((cl-twitter-root (path) (multiple-value-bind (start end reg1 reg2) (ppcre:scan "/cl-twitter/" path) @@ -18,11 +18,11 @@ (subseq path 0 end)))) (let ((root-dirs (mapcar #'cl-twitter-root dirs))) (if root-dirs - (concatenate 'string (car root-dirs) "access/" *access-file*) + (concatenate 'string (car root-dirs) dirname filename) ()))))) (defun access-file () - (default-access-path)) + (default-access-path "access/" *access-file*)) (defun serialize-user-data (token) (mapcar (lambda (e) (list (car e) (cdr e))) (oauth::token-user-data token))) @@ -55,13 +55,13 @@ (let ((ht (read-access-info)) (lst (serialize-access-token (twitter-user-access-token twitter-user)))) (setf (gethash (car lst) ht) lst) - (with-open-file (stream (access-file) :direction :output :if-exists :supersede) - (maphash (lambda (key lst) (format stream "~S~%" lst)) ht)))) + (with-open-file (stream (access-file) :direction :output :if-exists :supersede :if-does-not-exist :create) + (maphash (lambda (key lst) (declare (ignore key)) (format stream "~S~%" lst)) ht)))) (defun read-access-info() (let ((ht (make-hash-table :test 'equal))) - (with-open-file (stream (access-file) :direction :input ) + (with-open-file (stream (access-file) :direction :input :if-does-not-exist :create) (do ((line (read stream nil) (read stream nil))) ((null line)) (setf (gethash (car line) ht) line))) @@ -94,11 +94,18 @@ (arglist (cadr lst))) (cons fun (reduce (lambda (l r) (append l r)) (mapcar #'unpack arglist) )))) + +(define-condition missing-user-credentials (error) + ((who :initarg :who :initform "??" :reader who)) + (:report (lambda (condition stream) + (format stream "Missing twitter login credentials for ~@(~A~) from access.ht." + (who condition))))) + (defun get-access-token (user) (labels ((check-name (ht) (let ((lst (gethash user ht))) (if lst (cadr lst) - (error (format nil "access credentials for user ~A not found~%" user)))))) + (error 'missing-user-credentials :who user))))) (eval (maker (check-name (read-access-info)))))) diff --git a/cl-twit-repl/twitter.lisp b/cl-twit-repl/twitter.lisp index 93476ce..7a51af1 100644 --- a/cl-twit-repl/twitter.lisp +++ b/cl-twit-repl/twitter.lisp @@ -15,10 +15,6 @@ stored in between when the user is directed to a login URI and when the user is authenticated. Automatically pruned every once in a while (by calls to OAUTH-AUTHENTICATE-USER).") -(defvar *consumer-key* "9hOStbD2Zf7x0mUoo7cYBg" "The consumer key for cl-twit-repl, as listed on https://twitter.com/apps. Used for OAuth.") -(defvar *consumer-secret* "PWx9ZBZS9BVbesqlkoyiPzXtucmU7jaWe4ECcC30l0" "The consumer secret for cl-twit-repl, as listed on https://twitter.com/apps. Used for OAuth.") - - (defun oauth-make-twitter-authorization-uri (&key (consumer-key *consumer-key*) (consumer-secret *consumer-secret*)) "Returns a URL where the user should be directed to authorize the application. Once the user has authorized the user, she will be redirected to the web page specified on the https://twitter.com/apps page for the application." @@ -61,8 +57,7 @@ the user has been logged in to Twitter via OAuth." (format t "enter PIN : ") (let (( pin (read))) (format t "obtaining access tokens for pin : ~S~%" pin) - (unless (oauth:request-token-authorized-p request-token) - (oauth:authorize-request-token request-token)) + (unless (oauth:request-token-authorized-p request-token) (oauth:authorize-request-token request-token)) (setf (oauth:request-token-verification-code request-token) (format nil "~A" pin)) (let* ((access-token (oauth:obtain-access-token (twitter-oauth-uri "access_token") request-token)) (user-id (cdr (assoc "user_id" (oauth:token-user-data access-token) :test #'equal))) @@ -70,15 +65,20 @@ the user has been logged in to Twitter via OAuth." (user (get-user username))) (setf (twitter-user-access-token user) access-token) (setf *twitter-user* user) - (write-access-info *twitter-user*) - (twitter-op :user-show :id user-id :auth (list :oauth access-token)))))) + (write-access-info *twitter-user*) )))) (defun get-authenticated-user (user) + (handler-case (let* ((access-token (get-access-token user)) (username (cdr (assoc "screen_name" (oauth:token-user-data access-token) :test #'equal))) (user (get-user username))) (setf (twitter-user-access-token user) access-token) - (setf *twitter-user* user))) + (setf *twitter-user* user)) + (missing-user-credentials (c) + (format t "We don't have twitter credentials for ~A in ~A ~%" (who c) (access-file)) + (format t "maybe because this is the first time you are using cl-twit-repl on this machine.. ~&") + (format t "No reason to panic; we'll just get new credentials from twitter~%") + (repl-authenticate-user)))) (defun authenticated-user () *twitter-user*) diff --git a/cl-twitter.asd b/cl-twitter.asd index 5678073..6f35613 100644 --- a/cl-twitter.asd +++ b/cl-twitter.asd @@ -27,7 +27,6 @@ (:file "twitter-op") (:file "twitter-user") (:file "twitter-timeline") - (:file "twitter-tweet-status") (:file "twitter-trends") (:file "twitter-social-graph") (:file "twitter-account") @@ -41,6 +40,7 @@ (:file "twitter-list-members") (:file "twitter-list-subscribers") (:file "twitter-miscellaneous") + (:file "twitter-tweet-status") (:file "twitter-geo") (:file "twitter-show")))) :depends-on (:cl-json :trivial-http :drakma :anaphora :cl-ppcre :closer-mop :cl-oauth :url-rewrite))