[bknr-cvs] hans changed trunk/projects/quickhoney/
BKNR Commits
bknr at bknr.net
Wed Sep 17 11:47:43 UTC 2008
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 at gmail.com
+// All rights reserved.
+
/* configuration */
var max_news_items = 50; /* maximum number of news items to display */
More information about the Bknr-cvs
mailing list