Revision: 3912 Author: hans URL: http://bknr.net/trac/changeset/3912

Add automatic Twitter status updates when uploading. Remove upgrade stuff, we're live!

U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/packages.lisp U trunk/projects/quickhoney/src/quickhoney.asd U trunk/projects/quickhoney/src/twitter.lisp D trunk/projects/quickhoney/upgrade-stuff/ U trunk/projects/quickhoney/website/static/javascript.js

Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 11:47:43 UTC (rev 3912) @@ -293,9 +293,10 @@ (with-image-from-upload* (uploaded-file) (let* ((width (cl-gd:image-width)) (height (cl-gd:image-height)) - (ratio (/ 1 (max (/ width 300) (/ height 200))))) + (ratio (/ 1 (max (/ width 300) (/ height 200)))) + (image-name (pathname-name (upload-original-filename uploaded-file)))) (maybe-convert-to-palette) - (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) + (let* ((image (make-store-image :name image-name :class-name 'quickhoney-image :keywords (cons :upload (image-keywords-from-request-parameters)) :initargs (list :owner (bknr-session-user) @@ -304,6 +305,9 @@ :spider-keywords spider-keywords)))) (with-http-response () (with-http-body () + (twitter:update-status (bknr-session-user) + (format nil "Uploaded new image ~A: http://quickhoney.com~A/~A" + image-name (handler-path handler) image-name)) (html (:html (:head (:title "Upload successful") @@ -355,16 +359,19 @@ :dest-width +news-image-width+ :dest-height scaled-height) (cl-gd:destroy-image uploaded-image) (setf uploaded-image scaled-image))) - (let ((item (make-store-image :name (normalize-news-title title) - :image uploaded-image - :type (if (cl-gd:true-color-p uploaded-image) :jpg :png) - :class-name 'quickhoney-news-item - :keywords (list :upload) - :initargs (list :cat-sub (list :news) - :title title - :text text - :owner (bknr-session-user))))) + (let* ((title (normalize-news-title title)) + (item (make-store-image :name title + :image uploaded-image + :type (if (cl-gd:true-color-p uploaded-image) :jpg :png) + :class-name 'quickhoney-news-item + :keywords (list :upload) + :initargs (list :cat-sub (list :news) + :title title + :text text + :owner (bknr-session-user))))) (declare (ignore item)) ; for now + (twitter:update-status (bknr-session-user) + (format nil "Posted news item: http://quickhoney.com/news/~A" title)) (with-http-response () (with-http-body () (html (:html

Modified: trunk/projects/quickhoney/src/packages.lisp =================================================================== --- trunk/projects/quickhoney/src/packages.lisp 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/packages.lisp 2008-09-17 11:47:43 UTC (rev 3912) @@ -77,5 +77,5 @@ (:use :cl))

(defpackage :twitter - (:use :cl) + (:use :cl :bknr.datastore) (:export #:update-status)) \ No newline at end of file

Modified: trunk/projects/quickhoney/src/quickhoney.asd =================================================================== --- trunk/projects/quickhoney/src/quickhoney.asd 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/quickhoney.asd 2008-09-17 11:47:43 UTC (rev 3912) @@ -33,6 +33,7 @@ (:file "layout" :depends-on ("config")) (:file "imageproc" :depends-on ("config")) (:file "json" :depends-on ("packages")) + (:file "twitter" :depends-on ("packages")) (:file "handlers" :depends-on ("json" "layout" "config" "image" "news")) (:file "tags" :depends-on ("image")) (:file "webserver" :depends-on ("handlers"))

Modified: trunk/projects/quickhoney/src/twitter.lisp =================================================================== --- trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 11:47:43 UTC (rev 3912) @@ -1,12 +1,33 @@ (in-package :twitter)

-(defparameter *authorization* '("QuickHoneyTest" "autotwitter") - "Authorization (USER PASSWORD) to use to identify to twitter") +(define-persistent-class account () + ((user :read + :type bknr.user:user + :documentation "USER that this Twitter account belongs to") + (authorization :update + :documentation "List of username and password for this account")))

-(defun update-status (status-string) - (babel:octets-to-string - (drakma:http-request "http://twitter.com/statuses/update.xml" - :method :post - :content (format nil "status=~A" status-string) - :content-type "application/x-www-form-urlencoded" - :basic-authorization *authorization*))) \ No newline at end of file +(define-condition cannot-update-status (error) + ((result :initarg :result :reader result))) + +(define-condition no-account-for-user (error) + ((user :initarg :user :reader user))) + +(defgeneric update-status (who status-string &key) + + (:method ((account account) status-string &key) + (let ((result (babel:octets-to-string + (drakma:http-request "http://twitter.com/statuses/update.xml" + :method :post + :content (format nil "status=~A" status-string) + :content-type "application/x-www-form-urlencoded" + :basic-authorization (account-authorization account))))) + (when (cl-ppcre:scan "<error>" result) + (error 'cannot-update-status :result result)))) + + (:method ((user bknr.user:user) status-string &key errorp) + (let ((account (find user (class-instances 'account) :key #'account-user))) + (if account + (update-status account status-string) + (when errorp + (error 'no-account-for-user :user user)))))) \ No newline at end of file

Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 11:47:43 UTC (rev 3912) @@ -1,5 +1,8 @@ -// -*- Java -*- +// This may look like -*- Java -*-, but it really is JavaScript

+// Copyright 2005-2008 Hans Huebner, hans.huebner@gmail.com +// All rights reserved. + /* configuration */

var max_news_items = 50; /* maximum number of news items to display */